[Dart-dev] [4112] DART/trunk/observations: First stab at a converter from the World Ocean Database format

nancy at ucar.edu nancy at ucar.edu
Wed Oct 21 13:48:01 MDT 2009


Revision: 4112
Author:   nancy
Date:     2009-10-21 13:48:01 -0600 (Wed, 21 Oct 2009)
Log Message:
-----------
First stab at a converter from the World Ocean Database format
for Ocean observations, into DART format.  The files are a packed
ASCII text format.  wodFOR.f is an example reader program which
was the basis for our read routines.  

Added Paths:
-----------
    DART/trunk/observations/WOD/
    DART/trunk/observations/WOD/wodFOR.f
    DART/trunk/observations/WOD/wod_read_routines.f90
    DART/trunk/observations/WOD/wod_to_obs.f90
    DART/trunk/observations/WOD/work/
    DART/trunk/observations/WOD/work/input.nml
    DART/trunk/observations/WOD/work/mkmf_advance_time
    DART/trunk/observations/WOD/work/mkmf_obs_sequence_tool
    DART/trunk/observations/WOD/work/mkmf_preprocess
    DART/trunk/observations/WOD/work/mkmf_wod_to_obs
    DART/trunk/observations/WOD/work/path_names_advance_time
    DART/trunk/observations/WOD/work/path_names_obs_sequence_tool
    DART/trunk/observations/WOD/work/path_names_preprocess
    DART/trunk/observations/WOD/work/path_names_wod_to_obs
    DART/trunk/observations/WOD/work/quickbuild.csh

-------------- next part --------------
Added: DART/trunk/observations/WOD/wodFOR.f
===================================================================
--- DART/trunk/observations/WOD/wodFOR.f	                        (rev 0)
+++ DART/trunk/observations/WOD/wodFOR.f	2009-10-21 19:48:01 UTC (rev 4112)
@@ -0,0 +1,2027 @@
+      PROGRAM wodFOR
+      
+c    This program prints out to the screen data from WOD native format
+c    ASCII file to the screen. This main program (wodFOR)
+c    calls the subroutine WODread (WODread200X if the data file are in WOD05
+c    or WOD01 format or the subroutine WODread1998 if the data are in WOD98
+c    format). These subroutines do the actual reading of the ASCII format,
+c    and load the data into arrays which are passed back to the main program.
+c    The main program then work with these data arrays to print out the
+c    data on the screen.  
+c    
+c    It is intended that the subroutine WODread provides an example of how
+c    to extract the data and variables from the ASCII format,
+c    whereas the main part of the wodFOR program provides an example of how
+c    these data can be made accessible/workable as a series of arrays.
+c    
+c    Comments and suggestions for improving this program would be appreciated.
+c    Updates to the World Ocean Data 2005 data and to this program will be posted
+c    in the NODC/WOD web site at http://www.nodc.noaa.gov
+      
+c***********************************************************
+c    
+c    Missing values used in this dataset = bmiss = -999.99
+c    
+c***********************************************************
+c     
+c   Parameters (constants):
+c     
+c     maxlevel  - maximum number of depth levels, also maximum
+c                   number of all types of variables
+c     maxcalc   - maximum number of measured and calculated
+c                   depth dependent variables
+c     kdim      - number of standard depth levels
+c     bmiss     - binary missing value marker
+c     maxtcode  - maximum number of different taxa variable codes
+c     maxtax    - maximum number of taxa sets
+c     maxpinf   - maximum number of distinct measured variable
+c                 information codes
+c
+c******************************************************************
+      
+      parameter (maxlevel=30000, maxcalc=100)
+      parameter (kdim=40, bmiss=-999.99)
+      parameter (maxtcode=25, maxtax=2000)
+      parameter (maxpinf=25)
+      
+c******************************************************************
+c
+c   Character Arrays:
+c
+c     cc        - NODC country code
+c     chars     - WOD character data: 1. originators cruise code,
+c                                     2. originators station code
+c     filename  - file name
+c
+c*****************************************************************
+      
+      character*2  cc
+      character*15 chars(2)
+      character*80 filename
+ 
+c******************************************************************
+c
+c   Arrays:
+c
+c     isig()    - number of significant figures in (1) latitude, (2) longitude
+c                  and (3) time
+c     iprec()   - precision of (1) latitude, (2) longitude, (3) time
+c     ip2()     - variable codes for variables in cast
+c     ierror()  - whole profile error codes for each variable
+c     
+c     ipi()     - primary investigators information
+c                   1. primary investigators
+c                   2. for which variable
+c
+c     jsig2()   - number of significant figures in each secondary header variable
+c     jprec2()  - precision of each secondary header variable
+c     sechead() - secondary header variables
+c
+c     jsigb()   - number of significant figures in each biological variable
+c     jprecb()  - precision of each biological variable
+c     bio()     - biological data
+c
+c     depth()   - depth of each measurement
+c
+c     jtot2()   - number of bytes in each secondary header variable
+c     jtotb()   - number of bytes in each biological variable
+c
+c     msig()    - number of significant figures in each measured variable at
+c                  each level of measurement
+c     mprec()   - precision of each measured variable at each
+c                  level of measurement
+c
+c     mtot()    - number of digits in each measured variable at
+c                  each level of measurement
+c
+c     temp()    - variable data at each level
+c     iderror() - error flags for each variable at each depth level
+c     iorigflag()- originators flags for each variable and depth
+c
+c     isec()    - variable codes for secondary header data
+c     ibio()    - variable codes for biological data
+c     parminf()  - variable specific information
+c     jprecp()   - precision for variable specific information
+c     jsigp()    - number of significant figures for variable specific
+c                information
+c     jtotp()    - number of digits in for variable specific information
+c
+c     itaxnum() - different taxonomic and biomass variable
+c                  codes found in data
+c     vtax()    - value of taxonomic variables and biomass variables
+c
+c     jsigtax() - number of significant figures in taxon values and
+c                  biomass variables
+c     jprectax()- precision of taxon values and biomass variables
+c
+c     jtottax() - number of bytes in taxon values 
+c     itaxerr() - error codes for taxon data
+c     itaxorigerr() - originators error codes for taxon data
+c
+c     nbothtot()- total number of taxa variables
+c     stdz(40) - standard depth levels
+c
+c*******************************************************************
+
+      integer isig(3), iprec(3), ip2(0:maxlevel), ierror(maxlevel),
+     &        ipi(maxlevel,2)
+      dimension jsig2(maxlevel),jprec2(maxlevel),sechead(maxlevel)
+      dimension jsigb(maxlevel),jprecb(maxlevel),bio(maxlevel)
+      dimension depth(maxlevel)
+      dimension jtot2(maxlevel),jtotb(maxlevel)
+      dimension msig(maxlevel,maxcalc), mprec(maxlevel,maxcalc)
+      dimension mtot(maxlevel,maxcalc)
+      dimension temp(maxlevel,maxcalc),iderror(maxlevel,0:maxcalc)
+      dimension isec(maxlevel),ibio(maxlevel)
+      dimension parminf(maxpinf,0:maxcalc),jsigp(maxpinf,0:maxcalc)
+      dimension jprecp(maxpinf,0:maxcalc),jtotp(maxpinf,0:maxcalc)
+      dimension iorigflag(maxlevel,0:maxcalc)
+      dimension itaxnum(maxtcode,maxtax),vtax(0:maxtcode,maxtax)
+      dimension jsigtax(maxtcode,maxtax),jprectax(maxtcode,maxtax)
+      dimension jtottax(maxtcode,maxtax),itaxerr(maxtcode,maxtax)
+      dimension itaxorigerr(maxtcode,maxtax)
+
+      dimension stdz(kdim)
+
+      common /thedata/ depth,temp
+      common /flags/ ierror,iderror
+      common /oflags/ iorigflag
+      common /significant/ msig
+      common /precision/ mprec
+      common /totfigs/ mtot
+      common /second/ jsig2,jprec2,jtot2,isec,sechead
+      common /parminfo/ jsigp,jprecp,jtotp,parminf
+      common /biology/ jsigb,jprecb,jtotb,ibio,bio
+      common /taxon/ jsigtax,jprectax,jtottax,itaxerr,
+     &     vtax,itaxnum,nbothtot,itaxorigerr
+      
+      data stdz/ 0., 10., 20., 30., 50., 75., 100., 125., 150.,
+     &     200., 250., 300., 400., 500., 600., 700., 800., 900.,
+     &     1000., 1100., 1200., 1300., 1400., 1500., 1750., 2000.,
+     &     2500., 3000., 3500., 4000., 4500., 5000., 5500., 6000.,
+     &     6500., 7000., 7500., 8000., 8500., 9000./
+      
+c**************************************************************
+c
+c     nf is the input file indentification number
+c
+c**************************************************************
+
+      data nf/11/
+      
+c**************************************************************
+c
+c     Get user input file name from which casts will be
+c     taken.  Open this file.
+c
+c**************************************************************
+
+c User can modify the next section to read from a text file listing
+c different input data files as a do-loop, for example, as opposed
+c a single data input file.
+
+      write(6,*)' '
+      write(6,*)'Input File Name:'
+      read(5,'(a80)') filename
+      write(6,*)' '
+      write(6,*)' '      
+
+      open(nf,file=filename,status='old')
+      
+c**************************************************************
+c
+c   SUBROUTINE "WODread":  READS IN A SINGLE PROFILE FROM THE ASCII 
+c                          FILE AND STORES THE DATA INTO ARRAYS
+c   -------------------------------------------------------------------
+c
+c   Passed Variables:
+c     
+c     nf      - file identification number for input file
+c     jj      - WOD cast number
+c     cc      - NODC country code
+c     icruise - NODC cruise number
+c     iyear   - year of cast
+c     month   - month of cast
+c     iday    - day of cast
+c     time    - time of cast
+c     rlat    - latitude of cast
+c     rlon    - longitude of cast
+c     levels  - number of depth levels of data
+c     istdlev - observed (0) or standard (1) levels
+c     nvar   - number of variables recorded in cast
+c     ip2(i)  - variable codes of variables in cast
+c     nsecond - number of secondary header variables
+c     nbio    - number of biological variables
+c     isig()  - number of significant figures in (1) latitude, (2) longitude
+c                and (3) time
+c     iprec() - precision of (1) latitude, (2) longitude, (3) time
+c     bmiss   - missing value marker
+c     ieof    - set to one if end of file has been encountered
+c
+c   Common/Shared Variables and Arrays (see COMMON area of program):
+c
+c     depth(x)   - depth in meters (x = depth level)
+c     temp(x,y)  - variable data (x = depth level, y = variable ID = ip2(i))
+c                ... see also nvar, ip2, istdlev, levels above ...
+c     sechead(i) - secondary header data (i = secondary header ID = isec(j))
+c     isec(j)    - secondary header ID (j = #sequence (1st, 2nd, 3rd))
+c                ... see also nsecond above ...
+c     bio(i)     - biology header data (i = biol-header ID = ibio(j))
+c     ibio(j)    - biology header ID (j = #sequence (1st, 2nd, 3rd))
+c                ... see also nbio above ...
+c     nbothtot   - number of taxa set / biomass variables
+c     vtax(i,j)  - taxonomic/biomass array, where j = (1..nbothtot)
+c                   For each entry (j=1..nbothtot), there are vtax(0,j)
+c                   sub-entries.  [Note:  The number of sub-entries is 
+c                   variable for each main entry.]  vtax also holds the
+c                   value of the sub-entries.
+c     itaxnum(i,j)- taxonomic code or sub-code 
+c     chars       - WOD character data: 1. originators cruise code,
+c                                       2. originators station code
+c     npi        - number of PI codes
+c     ipi        - Primary Investigator information
+c                  1. primary investigator
+c                  2. variable investigated
+c     
+
+c***************************************************************
+      
+      iVERSflag = 0             !- default is "WOD-2005"
+      ieof = 0                  !- initialize end of file flag
+      
+      write(6,*)
+     *  'Enter number of casts to view (0=view entire file)'
+      read(5,*) numcasts
+      if ( numcasts .eq. 0 ) numcasts=10000000
+
+      do 50 ij=1,numcasts           !- MAIN CAST LOOP 
+         
+       chars(1)= '               '
+       chars(2)= '               '
+ 
+       
+       if (iVERSflag .eq. 0) then
+          
+c     .   Read in as "WOD-2005" format
+          
+          call WODread200X(nf,jj,cc,icruise,iyear,month,iday,
+     &         time,rlat,rlon,levels,istdlev,nvar,ip2,nsecond,nbio,
+     &         isig,iprec,bmiss,ieof,chars,ipi,npi,iVERSflag)
+          
+c     .   ONLY happens if format rejected (rewind and try as WOD-1999)
+          if (iVERSflag .gt. 0) then
+             print *,' '
+             print *,
+     &            ' This data file is not in the WOD-2005 format.',
+     &            '    Trying it in the WOD-1998 format.'
+             print *,' '
+             print *,' '
+             rewind(nf) !- rewind file
+          endif
+
+       endif
+
+       if (iVERSflag .eq. 1) then 
+          
+c     .   Read in as "WOD-1998" format          
+          
+c     .  WODread200X rejected format.  Must be WOD-1998 format.
+          
+          call WODread1998(nf,jj,cc,icruise,iyear,month,iday,
+     &         time,rlat,rlon,levels,istdlev,nvar,ip2,nsecond,nbio,
+     &         isig,iprec,bmiss,ieof,chars,ipi,npi)
+          
+       endif
+       
+       if ( ieof.gt.0 ) goto 4  !- Exit
+       
+c***************************************************************
+c
+c     STANDARD LEVELS OR OBSERVED LEVELS
+c     ----------------------------------
+c     
+c     If this file is on standard levels (istdlev=1), program places the
+c     standard depths in the depth() array (otherwise, observed depth values 
+c     were read in and stored above by subroutine WODreadxxxx; where xxxx is
+c     200X or 1998 depending on the data input format).
+c
+c***************************************************************
+
+       if (istdlev .eq. 1 .and. ij .eq. 1) then
+          
+        do 60 i=1,kdim
+         depth(i)=stdz(i)
+ 60     continue
+          
+       endif
+ 
+c**************************************************************
+c     
+c     WRITE HEADER INFORMATION TO THE SCREEN
+c     --------------------------------------
+c
+c     cc         - country code (a2)
+c     icruise    - WOD cruise identifier (i8)
+c     rlat       - latitude (f7.3)
+c     rlon       - longitude (f8.3)
+c     iyear      - year (i4)
+c     month      - month (i2)
+c     iday       - day (i2)
+c     time       - time (GMT) (f7.2)
+c     jj         - WOD cast identifier (i8)
+c     levels     - number of depth levels measured (i6)
+c     
+c**************************************************************
+       
+ 800   format(1x,a2,i8,1x,f7.3,1x,f8.3,1x,i4,1x,i2,1x,i2,
+     &      1x,f7.2,1x,i8,1x,i6)
+
+       write(6,*)
+     &'----------------------------------------------------------'
+
+       write(6,*) 'Output from ASCII file,  cast# ',ij
+       
+       write(6,*)
+     &'----------------------------------------------------------'
+
+       write(6,*)' '
+      
+       write(6,*)
+     &'CC  cruise Latitde Longitde YYYY MM DD    Time    Cast  #levels'
+
+       write(6,800) cc,icruise,rlat,rlon,iyear,month,iday,
+     &      time,jj,levels
+       
+       write(6,*) ' '
+       write(6,*) 'Number of variables in this cast: ',nvar
+       write(6,*) ' '
+       
+c**************************************************************
+c
+c     WRITE CHARACTER DATA TO THE SCREEN
+c     ----------------------------------
+c     
+c     chars(1)   - Originators cruise identifier
+c     chars(2)   - Originators station identifier
+c
+c**************************************************************
+
+       if ( ( chars(1)(1:1) .ne. ' ' ) .and.
+     &     ( chars(1)(1:4) .ne. 'NONE' )) then
+        write(6,*) 'Originators Cruise Code: ',chars(1)
+       endif
+
+       if ( ( chars(2)(1:1) .ne. ' ' ) .and.
+     &     ( chars(2)(1:4) .ne. 'NONE' )) then
+        write(6,*) 'Originators Station Code: ',chars(2)
+       endif
+
+       write(6,*) ' '
+
+c***************************************************************
+c
+c     WRITE PRIMARY INVESTIGATOR INFORMATION TO THE SCREEN
+c     ----------------------------------------------------
+c
+c     npi = number of primary investigator entries
+c     ipi(1..npi,1)  - PI code
+c     ipi(1..npi,2)  - variable for which PI was responsible
+c     
+c***************************************************************
+       
+       do 505 n=1,npi
+
+          write(6,'(1x,a21,i5,1x,a20,i3)') 
+     &         'Primary Investigator:',ipi(n,1),
+     &         ' ... for variable #:',ipi(n,2)
+          
+ 505   continue
+
+       if ( npi .gt. 0 ) write(6,*) ' '
+
+
+c**************************************************************
+c
+c     WRITE VARIABLE-CODE (column headings) TO THE SCREEN
+c     ----------------------------------------------------
+c     
+c     nvar          - number of variables (1...nvar)
+c     ip2(1..nvar)  - variable code for each variable present
+c     
+c     Example:  
+c       For a cast with just Temperature[1], Oxygen[3], Pressure[25]:
+c     
+c       The variable sequence is ip2(1)=Temperature, ip2(2)=Oxygen, 
+c          ip2(3)=Pressure
+c     
+c       nvar = 3
+c
+c       ip2(1) = 1, ip2(2) = 3, ip3(3) = 25
+c
+c     
+c     Note:  If "nvar = 0", biology only cast.
+c     
+c**************************************************************
+
+c     format(5x,1a,5x,10(3x,i2,11x))
+
+801    format(5x,"z  fo",4x,10(i2,8x,"fo",3x))
+
+       if (nvar .gt. 0) then
+          
+          write(6,801) (ip2(n),n=1,nvar)
+          write(6,*)' '
+
+c**************************************************************
+c
+c     WRITE DEPTH-DEPENDENT VARIABLE DATA TO THE SCREEN
+c     --------------------------------------------------
+c
+c     Print depth (depth(n)), error flags for depth (iderror(n,0)),
+c     each variable (temp(n,1..nvar)), and error flags for each
+c     variables (iderror(n,1..nvar))
+c
+c**************************************************************
+
+ 802      format(f7.1,1x,i1,i1,14(f9.3,' (',i1,') ',i1,i1))
+          
+          do 80 n=1,levels
+             write(6,802) depth(n),iderror(n,0),iorigflag(n,0),
+     &            (temp(n,ip2(j)),msig(n,ip2(j)),
+     &            iderror(n,ip2(j)),iorigflag(n,ip2(j)),j=1,nvar)
+ 80       continue
+          
+          write(6,*) ' ' 
+          
+c***************************************************************
+c
+c     PRINT ENTIRE-PROFILE ERROR FLAGS
+c     ------------------------------------
+c
+c***************************************************************
+          
+ 8021     format('VarFlag:    ',11x,11(i1,14x))
+          
+          write(6,8021)(ierror(ip2(j)),j=1,nvar)
+          
+          write(6,*) ' ' 
+          
+          
+       endif                    !- "if (nvar .gt. 0) then"
+
+c*************************************************************
+c
+c     WRITE SECONDARY-HEADER INFORMATION TO THE SCREEN
+c     ---------------------------------------------
+c
+c     Print the secondary header code (isec(1..nsecond)) and the value
+c     for that secondary header (sechead(isec(n))).
+c     
+c*************************************************************
+
+ 803  format(1x,'Secondary header #',i3,3x,f8.3,' (',i1,')')
+ 903  format(1x,'Secondary header #',i3,3x,f8.0,' (',i1,')')
+
+      do 85 n = 1,nsecond
+
+       if ( int(sechead(isec(n))) .lt. sechead(isec(n))) then
+        write(6,803) isec(n), sechead(isec(n)),jsig2(isec(n))
+       else
+        write(6,903) isec(n), sechead(isec(n)),jsig2(isec(n))
+       endif
+
+85    continue
+ 
+      write(6,*) ' ' 
+
+c*************************************************************
+c
+c      WRITE VARIABLE SPECIFIC INFORMATION TO THE SCREEN
+c      -------------------------------------------------
+c
+c*************************************************************
+
+ 814  format(1x,'Measured Variable #',i3,' Information Code #',i3,
+     &       3x,f8.3,' (',i1,')')
+ 914  format(1x,'Measured Variable #',i3,' Information Code #',i3,
+     &       3x,f8.0,' (',i1,')')
+
+      do 86 j0=1,nvar
+
+       j=ip2(j0)
+
+       do 87 i=1,maxpinf
+
+        if ( jtotp(i,j) .gt. 0 ) then
+
+         if ( int(parminf(i,j)) .lt. parminf(i,j)) then
+          write(6,814) j, i,parminf(i,j),jsigp(i,j)
+         else
+          write(6,914) j, i,parminf(i,j),jsigp(i,j)
+         endif
+
+         jtotp(i,j)=0
+
+        endif
+
+87     continue
+
+86    continue
+
+c*************************************************************
+c
+c     WRITE BIOLOGICAL HEADER INFORMATION TO THE SCREEN
+c     ------------------------------------------
+c     
+c     Print the biology header code (ibio(1..nbio)) and the value
+c     for that biology header (bio(ibio(n))).
+c
+c*************************************************************
+
+ 804  format(1x,'Biological header #',i3,3x,f13.3,' (',i1,')')
+
+      
+      do 90 n = 1,nbio
+       write(6,804) ibio(n), bio(ibio(n)),jsigb(ibio(n))
+       bio(ibio(n))=bmiss
+       jsigb(ibio(n))=0
+       ibio(n)=0
+90    continue
+      nbio=0
+
+      write(6,*) ' ' 
+ 
+c*************************************************************
+c     
+c     WRITE TAXA SET/BIOMASS VARIABLE INFORMATION TO THE SCREEN
+c     ----------------------------------------------------------
+c     
+c     For each set/variable (1..nbothtot), print the set/variable code 
+c     (ivtax = vtax(1,n)) and each member of that set (1..vtax(0,n)), 
+c     where the sub-code is itaxnum(n2,n) and the sub-value is vtax(n2,n).
+c
+c*************************************************************
+      
+ 805  format(5x,'   Code #',i4,3x,f13.3,' (',i1,') ',i1,i1)
+      
+      do 91 n = 1,nbothtot
+         
+       intax = vtax(0,n)     
+       ivtax = vtax(1,n)
+
+       if ( ivtax .lt. 0. .and. ivtax .gt. -501.) then
+        write(6,'(a8,i3,1x,a25,i12," (",i1,")")') 'Taxa-set',n,
+     &         ':  Biomass Parameter [1]#',ivtax,jsigtax(1,n)
+       else
+        write(6,'(a8,i3,1x,a22,4x,i10," (",i1,") ")') 'Taxa-set',n,
+     &         ':  Taxonomic Code [1]#',ivtax,jsigtax(1,n)
+       endif
+
+       vtax(0,n)=0.
+       vtax(1,n)=0.
+
+
+       do 92 n2 = 2,intax
+        write(6,805) itaxnum(n2,n), vtax(n2,n), jsigtax(n2,n),
+     &               itaxerr(n2,n),itaxorigerr(n2,n)
+        vtax(n2,n)=bmiss
+        jsigtax(n2,n)=0
+        itaxnum(n2,n)=0
+ 92    continue
+       write(6,*)' '
+ 91   continue
+      nbothtot=0
+ 
+      write(6,*) ' ' 
+      
+
+
+50    continue !- End of MAIN LOOP
+      
+ 4    continue !- EXIT 
+
+      stop
+      end
+
+c----------------------------------------------------------------
+
+      SUBROUTINE WODREAD200X(nf,jj,cc,icruise,iyear,month,iday,
+     &     time,rlat,rlon,levels,isoor,nvar,ip2,nsecond,nbio,
+     &     isig,iprec,bmiss,ieof,chars,ipi,npi,iVERSflag)
+      
+c     This subroutine reads in the WOD ASCII format and loads it
+c     into arrays which are common/shared with the calling program.
+
+c*****************************************************************
+c
+c   Passed Variables:
+c
+c     nf       - file identification number for input file
+c     jj       - WOD cast number
+c     cc       - NODC country code
+c     icruise  - NODC cruise number
+c     iyear    - year of cast
+c     month    - month of cast
+c     iday     - day of cast
+c     time     - time of cast
+c     rlat     - latitude of cast
+c     rlon     - longitude of cast
+c     levels   - number of depth levels of data
+c     isoor    - observed (0) or standard (1) levels
+c     nvar     - number of variables recorded in cast
+c     ip2      - variable codes of variables in cast
+c     nsecond  - number of secondary header variables
+c     nbio     - number of biological variables
+c     isig     - number of significant figures in (1) latitude, (2) longitude,
+c                 and (3) time
+c     iprec    - precision of (1) latitude, (2) longitude, (3) time
+c     itotfig  - number of digits in (1) latitude, (2) longitude, (3) time
+c     bmiss    - missing value marker
+c     ieof     - set to one if end of file has been encountered
+c     chars    - character data: 1=originators cruise code,
+c                                2=originators station code
+c     npi      - number of PI codes
+c     ipi      - Primary Investigator information
+c                  1. primary investigator
+c                  2. variable investigated
+c
+c     iVERSflag  -  set to "1" if data are in WOD-1998 format. 
+c                (subroutine exits so 1998 subroutine can be run)
+c
+c   Common/Shared Variables and Arrays (see COMMON area of program):
+c
+c     depth(x)   - depth in meters (x = depth level)
+c     temp(x,y)  - variable data (x = depth level, y = variable ID = ip2(i))
+c                ... see also nvar, ip2, istdlev, levels above ...
+c     sechead(i) - secondary header data (i = secondary header ID = isec(j))
+c     isec(j)    - secondary header ID (j = #sequence (1st, 2nd, 3rd))
+c                ... see also nsecond above ...
+c     bio(i)     - biology header data (i = biol-header ID = ibio(j))
+c     ibio(j)    - biology header ID (j = #sequence (1st, 2nd, 3rd))
+c                ... see also nbio above ...
+c     nbothtot   - number of taxa set / biomass variables
+c     vtax(i,j)  - taxonomic/biomass array, where j = (1..nbothtot)
+c                   For each entry (j=1..nbothtot), there are vtax(0,j)
+c                   sub-entries.  [Note:  The number of sub-entries is
+c                   variable for each main entry.]  vtax also holds the
+c                   value of the sub-entries.
+c    itaxnum(i,j)- taxonomic code or sub-code
+c    parminf(i,j)- variable specific information
+c    origflag(i,j)- originators data flags
+c
+c***************************************************************
+
+
+c******************************************************************
+c
+c   Parameters (constants):
+c
+c     maxlevel - maximum number of depth levels, also maximum
+c                 number of all types of variables
+c     maxcalc  - maximum number of measured and calculated
+c                 depth dependent variables
+c     maxtcode - maximum number of different taxa variable codes
+c     maxtax   - maximum number of taxa sets
+c     maxpinf - number of distinct variable specific information
+c               variables
+c
+c******************************************************************
+
+      parameter (maxlevel=30000, maxcalc=100)
+      parameter (maxtcode=25, maxtax=2000, maxpinf=25)
+
+c******************************************************************
+c
+c   Character Variables:
+c
+c     cc       - NODC country code
+c     xchar    - dummy character array for reading in each 80
+c                 character record
+c     aout     - format specifier (used for FORTRAN I/O)
+c     ichar    - cast character array
+c     
+c******************************************************************
+
+      character*2  cc
+      character*4  aout
+      character*15 chars(2)
+      character*80 xchar
+      character*1500000 ichar
+      
+      data aout /'(iX)'/
+      
+c******************************************************************
+c
+c    Arrays:
+c
+c     isig     - number of significant figures in (1) latitude, (2) longitude,
+c                 and (3) time
+c     iprec    - precision of (1) latitude, (2) longitude, (3) time
+c     itotfig  - number of digits in (1) latitude, (2) longitude, (3) time
+c     ip2      - variable codes for variables in cast
+c     ierror   - whole profile error codes for each variable
+c     jsig2    - number of significant figures in each secondary header variable
+c     jprec2   - precision of each secondary header variable
+c     jtot2    - number of digits in each secondary header variable
+c     sechead  - secondary header variables
+c     jsigb    - number of significant figures in each biological variable
+c     jprecb   - precision of each biological variable
+c     jtotb    - number of digits in each biological variable
+c     bio      - biological data
+c     idsig    - number of significant figures in each depth measurement
+c     idprec   - precision of each depth measurement
+c     idtot    - number of digits in each depth measurement
+c     depth    - depth of each measurement
+c     msig     - number of significant figures in each measured variable at
+c                 each level of measurement
+c     mprec    - precision of each measured variable at each
+c                 level of measurement
+c     mtot     - number of digits in each measured variable at
+c                 each level of measurement
+c     temp     - variable data at each level
+c     iderror  - error flags for each variable at each depth level
+c     iorigflag- originators flags for each variable and depth
+c     isec     - variable codes for secondary header data
+c     ibio     - variable codes for biological data
+c     parminf  - variable specific information
+c     jprecp   - precision for variable specific information
+c     jsigp    - number of significant figures for variable specific
+c                information
+c     jtotp    - number of digits in for variable specific information
+c     itaxnum  - different taxonomic and biomass variable
+c                 codes found in data
+c     vtax     - value of taxonomic variables and biomass variables
+c     jsigtax  - number of significant figures in taxon values and
+c                 biomass variables
+c     jprectax - precision of taxon values and biomass variables
+c     jtottax  - number of digits in taxon values and biomass
+c                 variables
+c     itaxerr  - taxon variable error code
+c     itaxorigerr - taxon originators variable error code
+c     nbothtot - total number of taxa and biomass variables
+c     ipi      - Primary investigator informationc
+c                 1. primary investigator
+c                 2. variable investigated
+c
+c*******************************************************************
+
+      dimension isig(3), iprec(3), ip2(0:maxlevel), ierror(maxlevel)
+      dimension itotfig(3),ipi(maxlevel,2)
+      dimension jsig2(maxlevel), jprec2(maxlevel), sechead(maxlevel)
+      dimension jsigb(maxlevel), jprecb(maxlevel), bio(maxlevel)
+      dimension idsig(maxlevel),idprec(maxlevel), depth(maxlevel)
+      dimension jtot2(maxlevel),jtotb(maxlevel),idtot(maxlevel)
+      dimension msig(maxlevel,maxcalc), mprec(maxlevel,maxcalc)
+      dimension mtot(maxlevel,maxcalc)
+      dimension temp(maxlevel,maxcalc),iderror(maxlevel,0:maxcalc)
+      dimension isec(maxlevel),ibio(maxlevel)
+      dimension parminf(maxpinf,0:maxcalc),jsigp(maxpinf,0:maxcalc)
+      dimension jprecp(maxpinf,0:maxcalc),jtotp(maxpinf,0:maxcalc)
+      dimension iorigflag(maxlevel,0:maxcalc)
+      dimension itaxnum(maxtcode,maxtax),vtax(0:maxtcode,maxtax)
+      dimension jsigtax(maxtcode,maxtax),jprectax(maxtcode,maxtax)
+      dimension jtottax(maxtcode,maxtax),itaxerr(maxtcode,maxtax)
+      dimension itaxorigerr(maxtcode,maxtax)
+
+c*******************************************************************
+c     
+c   Common Arrays and Variables:
+c
+c*******************************************************************
+      
+      common /thedata/ depth,temp
+      common /flags/ ierror,iderror
+      common /oflags/ iorigflag
+      common /significant/ msig
+      common /precision/ mprec
+      common /totfigs/ mtot
+      common /second/ jsig2,jprec2,jtot2,isec,sechead
+      common /parminfo/ jsigp,jprecp,jtotp,parminf
+      common /biology/ jsigb,jprecb,jtotb,ibio,bio
+      common /taxon/ jsigtax,jprectax,jtottax,itaxerr,
+     &     vtax,itaxnum,nbothtot,itaxorigerr
+      
+c******************************************************************
+c     
+c     Read in the first line of a cast into dummy character
+c     variable xchar
+c     
+c
+c     WOD-2005   First byte of each "cast record" is char "A".
+c
+c     WOD-1998   First byte of each "cast recond" is a number.
+c
+c******************************************************************
+
+      read(nf,'(a80)',end=500) xchar
+
+      if ( xchar(1:1) .ne. 'B' .and. xchar(1:1) .ne. 'A' ) then
+
+         iVERSflag = 1 !- not WOD-2005 format, must be WOD-1998
+         return
+
+      else
+         iVERSflag = 0 !- WOD-2005 format
+      endif
+      
+c******************************************************************
+c
+c     The first seven characters of a cast contain the
+c     number of characters which make up the entire cast.  Read
+c     this number into nchar
+c     
+c******************************************************************
+
+      read(xchar(2:2),'(i1)') inc
+      write(aout(3:3),'(i1)') inc
+      read(xchar(3:inc+2),aout) nchar
+
+c******************************************************************
+c
+c     Place the first line of the cast into the cast holder
+c     character array (ichar)
+c
+c******************************************************************
+
+      ichar(1:80) = xchar
+
+c******************************************************************
+c
+c     Calculate the number of full (all 80 characters contain information)
+c     lines in this cast.  Subtract one since the first line was
+c     already read in.
+c
+c******************************************************************
+
+      nlines = nchar/80
+
+c*****************************************************************
+c
+c     Read each line into the dummy variable
+c
+c*****************************************************************
+
+      do 49 n0 = 2,nlines
+
+       read(nf,'(a80)') xchar
+
+c*****************************************************************
+c
+c     Place the line into the whole cast array
+c
+c*****************************************************************
+
+       n = 80*(n0-1)+1
+       ichar(n:n+79)=xchar
+
+49    continue
+
+c*****************************************************************
+c
+c     If there is a last line with partial information, read in
+c     this last line and place it into the whole cast array
+c
+c*****************************************************************
+
+      if ( nlines*80 .lt. nchar .and. nlines .gt. 0) then
+
+       read(nf,'(a80)') xchar
+
+       n = 80*nlines+1
+       ichar(n:nchar) = xchar
+
+      endif
+       
+c*****************************************************************
+c
+c   Extract header information from the cast array
+c
+c     jj       - WOD cast number  
+c     cc       - NODC country code  
+c     icruise  - NODC cruise number
+c     iyear    - year of cast
+c     month    - month of cast
+c     iday     - day of cast
+c
+c*****************************************************************
+
+      istartc=inc+3
+      read(ichar(istartc:istartc),'(i1)') inc
+      write(aout(3:3),'(i1)') inc
+      read(ichar(istartc+1:istartc+inc),aout) jj
+      istartc=istartc+inc+1
+
+      cc = ichar(istartc:istartc+1)
+      istartc=istartc+2
+
+      read(ichar(istartc:istartc),'(i1)') inc
+      write(aout(3:3),'(i1)') inc
+      read(ichar(istartc+1:istartc+inc),aout) icruise
+      istartc=istartc+inc+1
+
+      read(ichar(istartc:istartc+3),'(i4)') iyear
+      istartc=istartc+4
+      read(ichar(istartc:istartc+1),'(i2)') month
+      istartc=istartc+2
+      read(ichar(istartc:istartc+1),'(i2)') iday
+      istartc=istartc+2
+
+c*****************************************************************
+c
+c   SUBROUTINE "charout":  READS IN AN WOD ASCII FLOATING-POINT
+c                          VALUE SEQUENCE (i.e. # sig-figs,
+c                          # total figs, precision, value itself).
+c                          * THIS WILL BE CALLED TO EXTRACT MOST 
+c   Examples:              FLOATING POINT VALUES IN THE WOD ASCII.
+c
+c     VALUE  Precision    WOD ASCII
+c     -----  ---------    ---------
+c     5.35       2        332535
+c     5.         0        1105
+c     15.357     3        55315357
+c    (missing)            -
+c
+c   ---------------------------------------------------------------
+c
+c  Read in time of cast (time) using CHAROUT subroutine:
+c
+c     istartc  - position in character array to begin to read
+c                 in data
+c     isig     - number of digits in data value
+c     iprec    - precision of data value
+c     ichar    - character array from which to read data
+c     time     - data value
+c     bmiss    - missing value marker
+c
+c*****************************************************************
+
+      call charout(istartc,isig(3),iprec(3),itotfig(3),ichar,
+     *             time,bmiss)
+
+c*****************************************************************
+c
+c     Read in latitude (rlat) and longitude (rlon) using CHAROUT:
+c     
+c        Negative latitude is south.
+c        Negative longitude is west.
+c     
+c*****************************************************************
+
+      call charout(istartc,isig(1),iprec(1),itotfig(3),ichar,
+     *             rlat,bmiss)
+      call charout(istartc,isig(2),iprec(2),itotfig(3),ichar,
+     *             rlon,bmiss)
+
+c*****************************************************************
+c     
+c     Read in the number of depth levels (levels) using CHAROUT:
+c
+c*****************************************************************
+
+      read(ichar(istartc:istartc),'(i1)') inc
+      write(aout(3:3),'(i1)') inc
+      read(ichar(istartc+1:istartc+inc),aout) levels
+      istartc=istartc+inc+1
+
+c*****************************************************************
+c
+c     Read in whether data is on observed levels (isoor=0) or
+c     standard levels (isoor=1)
+c
+c*****************************************************************
+
+      read(ichar(istartc:istartc),'(i1)') isoor
+      istartc=istartc+1
+
+c*****************************************************************
+c
+c     Read in number of variables in cast
+c
+c*****************************************************************
+
+      read(ichar(istartc:istartc+1),'(i2)') nvar
+      istartc=istartc+2
+
+c*****************************************************************
+c
+c     Read in the variable codes (ip2()), the whole profile
+c       error flags (ierror(ip2())), and variable specific
+c       information (iorigflag(,ip2()))
+c
+c*****************************************************************
+
+      do 30 n = 1,nvar
+
+       read(ichar(istartc:istartc),'(i1)') inc
+       write(aout(3:3),'(i1)') inc
+       read(ichar(istartc+1:istartc+inc),aout) ip2(n)
+       istartc=istartc+inc+1
+
+       read(ichar(istartc:istartc),'(i1)') ierror(ip2(n))
+       istartc=istartc+1
+
+       read(ichar(istartc:istartc),'(i1)') inc
+       write(aout(3:3),'(i1)') inc
+       read(ichar(istartc+1:istartc+inc),aout) npinf
+       istartc=istartc+inc+1
+
+       do 305 n2=1,npinf
+
+        read(ichar(istartc:istartc),'(i1)') inc
+        write(aout(3:3),'(i1)') inc
+        read(ichar(istartc+1:istartc+inc),aout) nn
+        istartc=istartc+inc+1
+
+        call charout(istartc,jsigp(nn,ip2(n)),jprecp(nn,ip2(n)),
+     &  jtotp(nn,ip2(n)),ichar, parminf(nn,ip2(n)),bmiss) 
+
+305    continue
+
+30    continue
+
+c****************************************************************
+c
+c     Read in number of bytes in character data
+c
+c****************************************************************
+
+      read(ichar(istartc:istartc),'(i1)') inc
+      istartc=istartc+1
+
+      npi=0
+      chars(1)(1:4)='NONE'
+      chars(2)(1:4)='NONE'
+
+      if ( inc .gt. 0 ) then
+       write(aout(3:3),'(i1)') inc
+       read(ichar(istartc+1:istartc+inc),aout) inchad
+       istartc=istartc+inc
+
+c****************************************************************
+c
+c    Read in number of character and primary investigator arrays
+c
+c****************************************************************
+
+      read(ichar(istartc:istartc),'(i1)') ica
+      istartc=istartc+1
+
+c****************************************************************
+c
+c    Read in character and primary investigator data
+c      1 - originators cruise code
+c      2 - originators station code
+c      3 - primary investigators information
+c
+c****************************************************************
+
+      do 45 nn=1,ica
+
+       read(ichar(istartc:istartc),'(i1)') icn
+       istartc=istartc+1
+
+       if ( icn .lt. 3 ) then
+        read(ichar(istartc:istartc+1),'(i2)') ns
+        istartc=istartc+2
+        chars(icn)= '               '
+        chars(icn)= ichar(istartc:istartc+ns-1)
+        istartc= istartc+ns
+       else
+        read(ichar(istartc:istartc+1),'(i2)') npi
+        istartc=istartc+2
+        do 505 n=1,npi
+         read(ichar(istartc:istartc),'(i1)') inc
+         write(aout(3:3),'(i1)') inc
+         read(ichar(istartc+1:istartc+inc),aout) ipi(n,2)
+         istartc=istartc+inc+1
+
+         read(ichar(istartc:istartc),'(i1)') inc
+         write(aout(3:3),'(i1)') inc
+         read(ichar(istartc+1:istartc+inc),aout) ipi(n,1)
+         istartc=istartc+inc+1
+505     continue
+       endif
+
+45    continue
+
+      endif
+
+c****************************************************************
+c
+c     Read in number of bytes in secondary header variables
+c
+c****************************************************************
+
+      read(ichar(istartc:istartc),'(i1)') inc
+      istartc=istartc+1
+      if ( inc .gt. 0 ) then
+       write(aout(3:3),'(i1)') inc
+       read(ichar(istartc+1:istartc+inc),aout) insec
+       istartc=istartc+inc
+
+c****************************************************************
+c
+c     Read in number of secondary header variables (nsecond)
+c
+c****************************************************************
+
+       read(ichar(istartc:istartc),'(i1)') inc
+       write(aout(3:3),'(i1)') inc

@@ Diff output truncated at 40000 characters. @@


More information about the Dart-dev mailing list