                            Reading MEDS Format

There are two programs found here that show how to read MEDS ASCII format,
the format of the data on this CD. The first, called MEDS_ASCII_LIST, can
be used to produce a listing to a printer of the contents of a file. The
second , called OCPROC_TO_TABLES, reads a binary form of the format, and
outputs the contents of the FORTRAN structures to separate files in a comma
separated value format. This latter form can be used to put data data into
any application software such as spreadsheet programs or some relational
databases. You can use this second program in combination with the first to
go from the format of data on this CD to tables.

Here are a few examples of how to use the contents of the format to filter
out records of interest. The software changes shown in these examples fit
into appropriate places in the first program.

Example 1: Selecting only those stations that have a quality flag of 'good'
for the position.
The quality flag for position is in the FXD structure and is called Q_POS.
It is a single character field and good positions are flagged with the
character '1'. At the point marked C*** Example 1 in MEDS_ASCII_LIST simply
insert

IF (STAT.FXD.Q_POS.NE.'1') ILIKE = 0

The variable ILIKE is used as a switch to control whether or not the data
from the station being read are printed or not. If ILIKE is anything other
than 1, it is not printed. Instead of printing the station, you could write
the information out to a file.

Example 2: Selecting only stations with temperature and salinity profiles.
This process requires looking at the contents of the PROF structure of the
station record. You need to add some code at the point marked C*** Example
2 in MEDS_ASCII_LIST. First if there is only one type of profile, then you
can go on to the next station. So just before

DO I=1,STAT.FXD.NO_PROF

put in the following check

IF (STAT.FXD.NO_PROF.LT.2) ILIKE = 0

Again we have used variable ILIKE to turn off writing the station to
output.

But this is only part of the job. Now within the DO loop, noted above, you
must check if both temperature and salinity profiles are present. Variable
STAT.PROF(I).PROF_TYPE is a four character variable that describes what is
the profile. You must check for 'TEMP' for temperature and any of 'PSAL',
'SSAL' or 'USAL' for salinity. If both TEMP and one of the others are
present, set ILIKE to 1.

Example 3: Select only those data that have passed through scientific
quality control.
To find data that have under gone scientific quality control, you have a
couple of places in the format where you may look. One place is at the
point marked C*** Example 3-1. Each scientific centre records which of its
tests the data have undergone and which tests were failed. Each of these at
each science centre is identified by a different value of
STAT.SURF_CODES(I).PCODE. PCODE is a four character variable. Look for
PCODE to be 'QAO$' or 'QAP$' to identify tests performed at AOML. For those
performed at Scripps, look for 'QSP$' or 'QSF$'. For those performed at
CSIRO, look for 'QRF$' or 'QRP$'. If you find PCODE is any one of these,
the data have passed through scientific quality control at the indicated
centre.

An alternate way to find out where the data have been is to look in the
HISTORY structure. This is marked by C*** Example 3-2. This part of the
format is used to track where the data have been. As each agency handling
the data process them, they write at least one record in this history
structure. The variable STAT.HISTORY(I).IDENT_CODE is a two character
variable. The science centres write a record using their two character
identifiers. For AOML this is 'AO', for Scripps this is 'SI' and for CSIRO
this is 'CS'. So, you need only look for an IDENT_CODE matching one of
these to know that the data have passed through science centre processing.
Simply use

IF STAT.HISTORY(I).IDENT_CODE.EQ.'AO') ILIKE = 1

to select only those records that have been through processing at AOML.

Example 4: Select temperatures between 100 and 400 m depth only.
To find only those temperatures that lie between 100 and 400 m you must
look into the profile records. At the point marked C*** Example 4.1 check
that PRF.FXD.PROF_TYPE is 'TEMP' indicating a temperature profile. If so,
then in the listing at C*** Example 4.2 you need to put in something like
the following.

IF (PRF.PROF(I).DEPTH_PRESS.GE.100. AND.
    PRF.PROF(I).DEPTH_PRESS.LE.400.) ILIKE = 1

Again ILIKE is used to indicate whether or not to select the results for
output. Of course, you could do other things at this point to only write
the temperatures at those depths.

You can also use PRF.PROF(I).Q_PARM to select only those values that have a
particular data quality flag (since this flag is stored in Q_PARM). The
software needed is similar to what was shown above in example 1.

You should be aware that the format contains at most 1500 depth-value pairs
in a single physical record. If a profile has more than 1500 depth-value
pairs they are divided into segments. The segment number is given by
PRF.FXD.PROFILE_SEG and will be a character string of '01', '02', etc. You
must take care to read all of the segments of a profile. That is what the
software is doing at the point in the program following the comment "Count
the number of profile segments to read".

Example 5: Find XBTs that have used the new fall rate equations.
Unless information is specifically present, you should assume the old fall
rate equations have been used. XBTs that have used the new fall rate
equations always have information about the probe, recorder and the
equations. This information is stored in the SURF_CODES structure. You need
to look for a PCODE set to 'PFR$'. The values stored in CPARM are the
values for the WMO code tables 1770 and 4770 in that order (see document on
WMO codes). You look for these codes in the same way as illustrated in
example 3-1 above. If the code is present, look at the first 3 characters
of the value in CPARM as these encode the probe type and the fall rate
equation used. Compare these to WMO code table 1770 to determine which
equation was used to calculate depth.

Example 6: Find high density XBT data.
To find these data you will need to make use of the ocean area, year and
ship identifier. The ocean area given in the list of high density lines
will tell you which ocean area files to search in. The year will narrow
down the search to 4 files (one for each quarter). Then you use the ship
identifier to select only those stations from each file. This is done by
inserting code at the position marked Example 6. Insert

IF (STAT.FXD.CR_NUMBER.EQ.'SHIP    95') ILIKE = 1

where, again, setting the variable ILIKE to 1 means you wish to select this
station. Note that you should insert the correct ship identifier and the
last two digits of the year in question. The example treats data from a
ship with identifier SHIP collected in year 1995.

Reading MEDS ASCII Format


        PROGRAM MEDS_ASCII_LIST
C       Reads and lists the MEDS ASCII format written by NODC
        CHARACTER*25568 INSTR
C       -------------------------------------------------------------
C...    STATION STRUCTURE
C       -------------------------------------------------------------
        STRUCTURE /PR_STN/
        STRUCTURE FXD
                CHARACTER*8     MKEY
                INTEGER*4       ONE_DEG_SQ
                CHARACTER*10    CR_NUMBER
                CHARACTER*4     OBS_YEAR
                CHARACTER*2     OBS_MONTH
                CHARACTER*2     OBS_DAY
                CHARACTER*4     OBS_TIME
                CHARACTER*2     DATA_TYPE
                INTEGER*4       IUMSGNO
                CHARACTER*1     STREAM_SOURCE
                CHARACTER*1     U_FLAG
                INTEGER*2       STN_NUMBER
                REAL*4          LATITUDE
                REAL*4          LONGITUDE
                CHARACTER*1     Q_POS
                CHARACTER*1     Q_DATE_TIME
                CHARACTER*1     Q_RECORD
                CHARACTER*8     UP_DATE
                CHARACTER*12    BUL_TIME
                CHARACTER*6     BUL_HEADER
                CHARACTER*4     SOURCE_ID
                CHARACTER*4     STREAM_IDENT
                CHARACTER*4     QC_VERSION
                CHARACTER*1     AVAIL
                INTEGER*2       NO_PROF
                INTEGER*2       NPARMS
                INTEGER*2       SPARMS
                INTEGER*2       NUM_HISTS
        END STRUCTURE
        STRUCTURE PROF(1:20)
                INTEGER*2       NO_SEG
                CHARACTER*4     PROF_TYPE
                CHARACTER*1     DUP_FLAG
                CHARACTER*1     DIGIT_CODE
                CHARACTER*1     STANDARD
                REAL*4          DEEP_DEPTH
        END STRUCTURE
        STRUCTURE SURFACE(1:20)
                CHARACTER*4     PCODE
                REAL*4          PARM
                CHARACTER*1     Q_PARM
        END STRUCTURE
        STRUCTURE SURF_CODES(1:20)
                CHARACTER*4     PCODE
                CHARACTER*10    CPARM
                CHARACTER*1     Q_PARM
        END STRUCTURE
        STRUCTURE HISTORY(1:100)
                CHARACTER*2     IDENT_CODE
                CHARACTER*4     PRC_CODE
                CHARACTER*4     VERSION
                INTEGER*4       PRC_DATE
                CHARACTER*2     ACT_CODE
                CHARACTER*4     ACT_PARM
                REAL*4          AUX_ID
                REAL*4          O_VALUE
        END STRUCTURE
        END STRUCTURE
        RECORD /PR_STN/STAT
C       -------------------------------------------------------------
C...     PROFILE STRUCTURE
C       -------------------------------------------------------------
        STRUCTURE /PR_PROFILE/
        STRUCTURE FXD
                CHARACTER*8     MKEY
                INTEGER*4       ONE_DEG_SQ
                CHARACTER*10    CR_NUMBER
                CHARACTER*4     OBS_YEAR
                CHARACTER*2     OBS_MONTH
                CHARACTER*2     OBS_DAY
                CHARACTER*4     OBS_TIME
                CHARACTER*2     DATA_TYPE
                INTEGER*4       IUMSGNO
                CHARACTER*4     PROF_TYPE
                CHARACTER*2     PROFILE_SEG
                INTEGER*2       NO_DEPTHS
                CHARACTER*1     D_P_CODE
        END STRUCTURE
        STRUCTURE PROF(1:1500)
                REAL*4          DEPTH_PRESS
                CHARACTER*1     DP_FLAG
                REAL*4          PARM
                CHARACTER*1     Q_PARM
        END STRUCTURE
        END STRUCTURE
        RECORD /PR_PROFILE/PRF
C
        OPEN(UNIT=1,STATUS='OLD',FORM='FORMATTED',
     &   RECORDTYPE='VARIABLE',READONLY,RECL=25568)
C
        OPEN(UNIT=2,STATUS='NEW',FORM='FORMATTED')
C
C   Use ILIKE to qualify whether or not a record should be printed.
C   If ILIKE = 1 it prints, otherwise it does not.
        ILIKE = 1
        NWR=1
        NN=1
C
1       CONTINUE
        READ(1,100,END=999) INSTR
100     FORMAT(A25568)
C
C   Read FXD structure
        STAT.FXD.MKEY = INSTR(1:8)
        READ(INSTR(9:16),101) STAT.FXD.ONE_DEG_SQ
101     FORMAT(I8)
        STAT.FXD.CR_NUMBER = INSTR(17:26)
C*** Example 6
        STAT.FXD.OBS_YEAR = INSTR(27:30)
        STAT.FXD.OBS_MONTH = INSTR(31:32)
        STAT.FXD.OBS_DAY = INSTR(33:34)
        STAT.FXD.OBS_TIME = INSTR(35:38)
        STAT.FXD.DATA_TYPE = INSTR(39:40)
        READ(INSTR(41:52),102) STAT.FXD.IUMSGNO
102     FORMAT(I12)
        STAT.FXD.STREAM_SOURCE = INSTR(53:53)
        STAT.FXD.U_FLAG = INSTR(54:54)
        READ(INSTR(55:62),103) STAT.FXD.STN_NUMBER
103     FORMAT(I8)
        READ(INSTR(63:70),104)  STAT.FXD.LATITUDE
104     FORMAT(F8.4)
        READ(INSTR(71:79),105) STAT.FXD.LONGITUDE
105     FORMAT(F9.4)
        STAT.FXD.Q_POS = INSTR(80:80)
C*** Example 1
        STAT.FXD.Q_DATE_TIME = INSTR(81:81)
        STAT.FXD.Q_RECORD = INSTR(82:82)
        STAT.FXD.UP_DATE = INSTR(83:90)
        STAT.FXD.BUL_TIME = INSTR(91:102)
        STAT.FXD.BUL_HEADER = INSTR(103:108)
        STAT.FXD.SOURCE_ID = INSTR(109:112)
        STAT.FXD.STREAM_IDENT = INSTR(113:116)
        STAT.FXD.QC_VERSION = INSTR(117:120)
        STAT.FXD.AVAIL = INSTR(121:121)
        READ(INSTR(122:123),106) STAT.FXD.NO_PROF
106     FORMAT(I2)
        READ(INSTR(124:125),106) STAT.FXD.NPARMS
        READ(INSTR(126:127),106) STAT.FXD.SPARMS
        READ(INSTR(128:130),107) STAT.FXD.NUM_HISTS
107     FORMAT(I3)
C
C       Read PROF structure
        ISTART = 131
C*** Example 2
        DO I=1,STAT.FXD.NO_PROF
          IST = ISTART + 14*(I-1)
          READ(INSTR(IST:IST+1),106) STAT.PROF(I).NO_SEG
          STAT.PROF(I).PROF_TYPE = INSTR(IST+2:IST+5)
          STAT.PROF(I).DUP_FLAG = INSTR(IST+6:IST+6)
          STAT.PROF(I).DIGIT_CODE = INSTR(IST+7:IST+7)
          STAT.PROF(I).STANDARD = INSTR(IST+8:IST+8)
          READ(INSTR(IST+9:IST+13),108) STAT.PROF(I).DEEP_DEPTH
108       FORMAT(F5.0)
        ENDDO
C
C   Read SURFACE structure
        ISTART = ISTART + 14*(STAT.FXD.NO_PROF)
        DO I=1,STAT.FXD.NPARMS
          IST = ISTART + 15*(I-1)
          STAT.SURFACE(I).PCODE = INSTR(IST:IST+3)
          READ(INSTR(IST+4:IST+13),109) STAT.SURFACE(I).PARM
109       FORMAT(F10.3)
          STAT.SURFACE(I).Q_PARM = INSTR(14:14)
        ENDDO
C
C   Read SURF_CODES structure
        ISTART = ISTART + 15*(STAT.FXD.NPARMS)
C*** Example 3-1
        DO I=1,STAT.FXD.SPARMS
          IST = ISTART + 15*(I-1)
          STAT.SURF_CODES(I).PCODE = INSTR(IST:IST+3)
          STAT.SURF_CODES(I).CPARM = INSTR(IST+4:IST+13)
          STAT.SURF_CODES(I).Q_PARM = INSTR(14:14)
        ENDDO
C
C   Read HISTORY structure
        ISTART = ISTART + 15*(STAT.FXD.SPARMS)
        DO I=1,STAT.FXD.NUM_HISTS
          IST = ISTART + 42*(I-1)
          STAT.HISTORY(I).IDENT_CODE = INSTR(IST:IST+1)
C*** Example 3-2
          STAT.HISTORY(I).PRC_CODE = INSTR(IST+2:IST+5)
          STAT.HISTORY(I).VERSION = INSTR(IST+6:IST+9)
          READ(INSTR(IST+10:IST+17),103) STAT.HISTORY(I).PRC_DATE
          STAT.HISTORY(I).ACT_CODE = INSTR(IST+18:IST+19)
          STAT.HISTORY(I).ACT_PARM = INSTR(IST+20:IST+23)
          READ(INSTR(IST+24:IST+31),110) STAT.HISTORY(I).AUX_ID
110       FORMAT(F8.3)
          READ(INSTR(IST+32:IST+41),111) STAT.HISTORY(I).O_VALUE
111       FORMAT(F10.5)
        ENDDO
C
        IF(ILIKE.EQ.1) THEN
        WRITE (6,4002) NWR
4002    FORMAT (///'***********************',I10/)
        WRITE (6,4001) STAT.FXD.MKEY,STAT.FXD.IUMSGNO,
     &   STAT.FXD.STREAM_SOURCE,STAT.FXD.U_FLAG
4001    FORMAT (' MKEY ',a10,'   IUMSGNO ',i10,'   STREAM_SOURCE ',a5,
     &   '   UFLAG ',a5)
C
        WRITE (6,4003) STAT.FXD.ONE_DEG_SQ,STAT.FXD.CR_NUMBER,
     &   STAT.FXD.OBS_YEAR,STAT.FXD.OBS_MONTH,STAT.FXD.OBS_DAY,
     &   STAT.FXD.OBS_TIME
4003    FORMAT (' ONE_DEG_SQ',1X,I6,3X,'CR_NUMBER',1X,A14,2X,'OBS_DATE',
     &   1X,A4,2A2,3X,'OBS_TIME',1X,A4)
C
        WRITE (6,4004) STAT.FXD.DATA_TYPE,STAT.FXD.STN_NUMBER,
     &   STAT.FXD.LATITUDE,STAT.FXD.LONGITUDE
4004    FORMAT (' DATA_TYPE',1X,A2,3X,' STN_NUMBER ',I5,3X,' LATITUDE',
     &   F10.4,3X,'LONGITUDE',F10.4)
C
        WRITE (6,4005) STAT.FXD.Q_POS,STAT.FXD.Q_DATE_TIME,
     &   STAT.FXD.Q_RECORD,STAT.FXD.UP_DATE
4005    FORMAT (' Q_POS ',A1,3X,'Q_DATE_TIME ',A1,3X,'Q_RECORD ',A1,3X,
     &   'UP_DATE ',A8)
C
        WRITE (6,4011) STAT.FXD.BUL_TIME,STAT.FXD.BUL_HEADER,
     &   STAT.FXD.SOURCE_ID,STAT.FXD.STREAM_IDENT,STAT.FXD.QC_VERSION,
     &   STAT.FXD.AVAIL
4011    FORMAT (' BUL_TIME',1X,A12,2X,'BUL_HEADER',1X,A6,2X,
     &   'SOURCE_ID',1X,A4,2X,'STREAM_IDENT',1X,A4/' QC_VERSION ',A4,3X,
     &   'DATA_AVAIL ',A1)
C
        WRITE (6,4006) STAT.FXD.NO_PROF,
     &   (STAT.PROF(I).NO_SEG,STAT.PROF(I).PROF_TYPE,
     &   STAT.PROF(I).DUP_FLAG,STAT.PROF(I).DIGIT_CODE,
     &   STAT.PROF(I).STANDARD,STAT.PROF(I).DEEP_DEPTH,
     &   I=1,STAT.FXD.NO_PROF)
4006    FORMAT (/' VECTOR OF ',I2,' PROFILE DESCRIPTORS - NO_SEG,'
     &   ' PROF_TYPE, DUP_FLAG,'/'   DIGIT_CODE, STANDARD, DEEP_DEPTH'/
     &   (I5,1X,A4,1X,A1,1X,A1,1X,A1,F8.1,'.'))
C
        WRITE (6,4007)  STAT.FXD.NPARMS,
     &   (STAT.SURFACE(I).PCODE,STAT.SURFACE(I).PARM,
     &   STAT.SURFACE(I).Q_PARM,
     &   I=1,STAT.FXD.NPARMS)
4007    FORMAT (/' VECTOR OF ',I2,' STATION LEVEL PARAMETERS - PCODE,'
     &   ' PARM, Q_PARM'/3(3X,A4,1X,F10.4,3X,A1))
C
        WRITE (6,4014) STAT.FXD.SPARMS,
     &   (STAT.SURF_CODES(I).PCODE,STAT.SURF_CODES(I).CPARM,
     &   STAT.SURF_CODES(I).Q_PARM,
     &   I=1,STAT.FXD.SPARMS)
4014    FORMAT (/' VECTOR OF ',I2,' STATION CHARACTER FIELDS - ',
     &   'SRFC_CODE, SRFC_PARM, SRFC_Q_PARM'/3(3X,A4,1X,A10,1X,A1))
C
        WRITE (6,4010) STAT.FXD.NUM_HISTS,
     &   (STAT.HISTORY(I).IDENT_CODE,STAT.HISTORY(I).PRC_CODE,
     &   STAT.HISTORY(I).VERSION,STAT.HISTORY(I).PRC_DATE,
     &   STAT.HISTORY(I).ACT_CODE,STAT.HISTORY(I).ACT_PARM,
     &   STAT.HISTORY(I).AUX_ID,STAT.HISTORY(I).O_VALUE,
     &   I=1,STAT.FXD.NUM_HISTS)
4010    FORMAT (//' VECTOR OF ',I3,' HISTORY RECORDS'/
     &   ' - IDENT_CODE, PRC_CODE, VERSION, PRC_DATE, ACT_CODE,
     &   ACT_PARM, AUX_ID, ORIG_VAL'/
     &   (1X,A2,1X,A4,2X,A4,2X,I8,2X,A2,2X,A4,2X,F9.3,2X,F9.3))
        NWR=NWR+1
        ENDIF
C
C  Count the number of profile segments to read
        NO_PRF = 0
        DO I = 1,STAT.FXD.NO_PROF
          NO_PRF = NO_PRF + STAT.PROF(I).NO_SEG
        ENDDO
C
C  Read the profile segments
        DO J=1,NO_PRF
          READ(1,100,END=999) INSTR
C  Read FXD structure
          PRF.FXD.MKEY = INSTR(1:8)
          READ(INSTR(9:16),101) PRF.FXD.ONE_DEG_SQ
          PRF.FXD.CR_NUMBER = INSTR(17:26)
          PRF.FXD.OBS_YEAR = INSTR(27:30)
          PRF.FXD.OBS_MONTH = INSTR(31:32)
          PRF.FXD.OBS_DAY = INSTR(33:34)
          PRF.FXD.OBS_TIME = INSTR(35:38)
          PRF.FXD.DATA_TYPE = INSTR(39:40)
          READ(INSTR(41:52),102) PRF.FXD.IUMSGNO
          PRF.FXD.PROF_TYPE = INSTR(53:56)
C*** Example 4.1
          PRF.FXD.PROFILE_SEG = INSTR(57:58)
          READ(INSTR(59:62),112) PRF.FXD.NO_DEPTHS
112       FORMAT(I4)
          PRF.FXD.D_P_CODE = INSTR(63:63)
C
C   Read PROF structure
          ISTART = 64
          DO I=1,PRF.FXD.NO_DEPTHS
            IST = ISTART + 17*(I-1)
C*** Example 4.2
            READ(INSTR(IST:IST+5),113) PRF.PROF(I).DEPTH_PRESS
113         FORMAT(F6.1)
            PRF.PROF(I).DP_FLAG = INSTR(IST+6:IST+6)
            READ(INSTR(IST+8:IST+16),114) PRF.PROF(I).PARM
114         FORMAT(F9.3)
            PRF.PROF(I).Q_PARM = INSTR(IST+17:IST+17)
          ENDDO
C
C  Write the profile segments
        IF(ILIKE.EQ.1) THEN
        WRITE (6,5001) PRF.FXD.MKEY,PRF.FXD.IUMSGNO
5001    FORMAT (//' MKEY ',a10,'   IUMSGNO ',i10)
C
        WRITE (6,5003) PRF.FXD.ONE_DEG_SQ,PRF.FXD.CR_NUMBER,
     &   PRF.FXD.OBS_YEAR,PRF.FXD.OBS_MONTH,PRF.FXD.OBS_DAY,
     &   PRF.FXD.OBS_TIME
5003    FORMAT (' ONE_DEG_SQ',1X,I6,3X,'CR_NUMBER',1X,A14,2X,'OBS_DATE',
     &   1X,A4,2A2,3X,'OBS_TIME',1X,A4)
C
        WRITE (6,5004) PRF.FXD.DATA_TYPE,PRF.FXD.PROF_TYPE,
     &   PRF.FXD.PROFILE_SEG
5004    FORMAT (' DATA_TYPE',1X,A2,3X,' PROF_TYPE ',A4,3X,
     &   ' PROFILE_SEG ',A2)
C
        WRITE (6,5012) PRF.FXD.NO_DEPTHS,PRF.FXD.D_P_CODE,
     &   (PRF.PROF(I).DEPTH_PRESS,PRF.PROF(I).DP_FLAG,
     &   PRF.PROF(I).PARM,PRF.PROF(I).Q_PARM,
     &   I=1,PRF.FXD.NO_DEPTHS)
5012    FORMAT (/' NO_DEPTHS ',I5,3X,'D-P-CODE ',A1/
     &   ' - DEPTH_PRESS, DP_FLAG, PROF_PARM, ',
     &   'PROF_Q_PARM'/3(5X,F8.1,1X,A1,F10.4,1X,A1))
        ENDIF
        ENDDO
C
        NN=NN+1
        GO TO 1
C
999     CONTINUE
        PRINT 190,NN-1,NWR-1
190     FORMAT(' ',2I10,' STATIONS WERE READ AND OUTPUT')
        STOP
        END

Writing data to tables.

        PROGRAM OCPROC_TO_TABLES
C       Reads binary format and writes contents to separate tables
C       for each structure
        CHARACTER STNNO*4, AKEY*17, CRN*10, DATETIME*10, OTIME*5, PD*10
        CHARACTER PDC*8, UDATE*10, STR*1, COMMA*1, STR1*5000
        DIMENSION STR(5000)
        EQUIVALENCE (STR1,STR)
C
        DICTIONARY 'CDD$TOP.APPLICATION.OCEAN.PROCESS_STN_REC/LIST'
        RECORD /PR_STN/STAT
        DICTIONARY 'CDD$TOP.APPLICATION.OCEAN.PROCESS_PROFILE_REC/LIST'
        RECORD /PR_PROFILE/PRF
C
        OPEN(UNIT=1,STATUS='OLD',FORM='UNFORMATTED',
     &   RECORDTYPE='VARIABLE',READONLY,IOSTAT=IOS)
        IF(IOS.NE.0)OPEN(UNIT=1,STATUS='OLD',FORM='UNFORMATTED',
     &   READONLY,RECORDTYPE='VARIABLE',ORGANIZATION='INDEXED')
C
        OPEN(UNIT=11,STATUS='NEW',FORM='FORMATTED',RECL=10000)
        OPEN(UNIT=12,STATUS='NEW',FORM='FORMATTED')
        OPEN(UNIT=13,STATUS='NEW',FORM='FORMATTED')
        OPEN(UNIT=14,STATUS='NEW',FORM='FORMATTED')
        OPEN(UNIT=15,STATUS='NEW',FORM='FORMATTED')
        OPEN(UNIT=16,STATUS='NEW',FORM='FORMATTED')
C
        COMMA = ','
        NWR=1
        NWRITE1 = 0
        NWRITE2 = 0
        NWRITE3 = 0
        NWRITE4 = 0
        NWRITE5 = 0
        NWRITE6 = 0
        NN=1
C
1       CONTINUE
        READ(1,END=999) STAT.FXD,
     &     (STAT.PROF(I),I=1,STAT.FXD.NO_PROF),
     &     (STAT.SURFACE(J),J=1,STAT.FXD.NPARMS),
     &     (STAT.SURF_CODES(K),K=1,STAT.FXD.SPARMS),
     &     (STAT.HISTORY(L),L=1,STAT.FXD.NUM_HISTS)
C
        WRITE(STNNO,4000) STAT.FXD.STN_NUMBER
4000    FORMAT(I4.4)
        IF(STAT.FXD.CR_NUMBER(10:10).EQ.' ') THEN
          CRN = ' '//STAT.FXD.CR_NUMBER(1:9)
        ELSE
          CRN = STAT.FXD.CR_NUMBER
        ENDIF
        AKEY = CRN//'-'//STNNO//STAT.FXD.DATA_TYPE
        DATETIME = STAT.FXD.OBS_MONTH//'/'//STAT.FXD.OBS_DAY//
     &   '/'//STAT.FXD.OBS_YEAR
        OTIME = STAT.FXD.OBS_TIME(1:2)//':'//STAT.FXD.OBS_TIME(3:4)
        UDATE = STAT.FXD.UP_DATE(5:6)//'/'//STAT.FXD.UP_DATE(7:8)//
     &   '/'//STAT.FXD.UP_DATE(1:4)
C
        WRITE (STR1,4011) AKEY, COMMA, STAT.FXD.ONE_DEG_SQ,
     &   COMMA, STAT.FXD.CR_NUMBER, COMMA,
     &   STAT.FXD.STN_NUMBER, COMMA, DATETIME, COMMA,
     &   STAT.FXD.OBS_MONTH, COMMA,
     &   OTIME, COMMA, STAT.FXD.DATA_TYPE, COMMA,
     &   STAT.FXD.LATITUDE, COMMA, STAT.FXD.LONGITUDE, COMMA,
     &   STAT.FXD.Q_POS, COMMA, STAT.FXD.Q_DATE_TIME, COMMA,
     &   STAT.FXD.Q_RECORD, COMMA, UDATE, COMMA, STAT.FXD.BUL_TIME,
     &   COMMA, STAT.FXD.BUL_HEADER, COMMA,
     &   STAT.FXD.SOURCE_ID, COMMA, STAT.FXD.STREAM_IDENT, COMMA,
     &   STAT.FXD.QC_VERSION, COMMA, STAT.FXD.AVAIL
4011    FORMAT (A20,A1,I7,A1,A11,A1,I4.4,A1,A11,A1,A3,A1,A6,A1,A3,
     &   A1,F10.4,A1,F10.4,6A2,A1,A11,
     &   A1,A13,A1,A7,3(A1,A5),2A2)
        CALL SQUEEZE(STR, NS)
        WRITE(11,4100) (STR(I),I=1,NS)
4100    FORMAT(5000A1)
        NWRITE1 = NWRITE1 + 1
C
        DO I=1,STAT.FXD.NPARMS
        WRITE (STR1,4013)  AKEY, COMMA,
     &   STAT.SURFACE(I).PCODE, COMMA, STAT.SURFACE(I).PARM, COMMA,
     &   STAT.SURFACE(I).Q_PARM
4013    FORMAT (A17,A1,A4,A1,F10.4,2A1)
        CALL SQUEEZE(STR, NS)
        WRITE(13,4100) (STR(II),II=1,NS)
        NWRITE3 = NWRITE3 + 1
        ENDDO
C
        DO I=1,STAT.FXD.SPARMS
        WRITE (STR1,4014) AKEY, COMMA,
     &   STAT.SURF_CODES(I).PCODE, COMMA, STAT.SURF_CODES(I).CPARM,
     &   COMMA, STAT.SURF_CODES(I).Q_PARM
4014    FORMAT (A17,A1,A4,A1,A10,2A1)
        CALL SQUEEZE(STR, NS)
        WRITE(14,4100) (STR(II),II=1,NS)
        NWRITE4 = NWRITE4 + 1
        ENDDO
C
        DO I=1,STAT.FXD.NUM_HISTS
        WRITE(PDC,4002) STAT.HISTORY(I).PRC_DATE
4002    FORMAT(I8)
        PD = PDC(5:6)//'/'//PDC(7:8)//'/'//PDC(1:4)
        WRITE (STR1,4015) AKEY, COMMA, I, COMMA,
     &   STAT.HISTORY(I).IDENT_CODE, COMMA, STAT.HISTORY(I).PRC_CODE,
     &   COMMA, STAT.HISTORY(I).VERSION, COMMA, PD, COMMA,
     &   STAT.HISTORY(I).ACT_CODE, COMMA, STAT.HISTORY(I).ACT_PARM,
     &   COMMA, STAT.HISTORY(I).AUX_ID, COMMA,
     &   STAT.HISTORY(I).O_VALUE
        CALL SQUEEZE(STR, NS)
        WRITE(15,4100) (STR(II),II=1,NS)
        NWRITE5 = NWRITE5 + 1
        ENDDO
4015    FORMAT (A17,A1,I3.3,2A2,A1,A4,A1,A4,A1,A12,2A2,A1,A4,
     &   A1,F9.3,A1,F9.3)
        NWR=NWR+1
C
C  Count the number of profile segments to read
        NO_PRF = 0
        DO 20 I = 1,STAT.FXD.NO_PROF
        NO_PRF = NO_PRF + STAT.PROF(I).NO_SEG
20      CONTINUE
C
C  Read the profile segments
      DO 50 J=1,NO_PRF
        READ(1,END=999) PRF.FXD,
     &   (PRF.PROF(I),I=1,PRF.FXD.NO_DEPTHS)
C
C  Write the profile segments
        DO I=1,PRF.FXD.NO_DEPTHS
        WRITE (STR1,4016) AKEY, COMMA, PRF.FXD.PROF_TYPE, COMMA,
     &   PRF.PROF(I).DEPTH_PRESS, COMMA, PRF.PROF(I).DP_FLAG, COMMA,
     &   PRF.PROF(I).PARM, COMMA, PRF.PROF(I).Q_PARM
4016    FORMAT (A17,A1,A5,A1,F10.4,2A2,A1,F10.4,2A2)
        CALL SQUEEZE(STR, NS)
        WRITE(16,4100) (STR(II),II=1,NS)
        NWRITE6 = NWRITE6 + 1
        ENDDO
C
50      CONTINUE
C
        DO I=1,STAT.FXD.NO_PROF
        WRITE (STR1,4012) AKEY, COMMA,
     &   STAT.PROF(I).PROF_TYPE, COMMA,
     &   STAT.PROF(I).DUP_FLAG, COMMA, STAT.PROF(I).DIGIT_CODE, COMMA,
     &   STAT.PROF(I).STANDARD, COMMA, PRF.FXD.D_P_CODE, COMMA,
     &   STAT.PROF(I).DEEP_DEPTH
4012    FORMAT (A17,A1,A4,2A1,2A1,4A2,A1,F8.1)
        CALL SQUEEZE(STR, NS)
        WRITE(12,4100) (STR(II),II=1,NS)
        NWRITE2 = NWRITE2 + 1
        ENDDO
C
        NN=NN+1
c       IF(NN.LE.100) GO TO 1
        GO TO 1
C
999     CONTINUE
        PRINT 190,NN-1,NWR-1
190     FORMAT(' ',2I10,' STATIONS WERE READ AND OUTPUT')
        PRINT 198, NWRITE1, NWRITE2, NWRITE3, NWRITE4, NWRITE5, NWRITE6
198     FORMAT(' Number of rows written:',/,
     &   ' Station header: ',I20,/,
     &   ' Profile info:   ',I20,/,
     &   ' Surface info:   ',I20,/,
     &   ' SCodes info:    ',I20,/,
     &   ' History:        ',I20,/,
     &   ' Profile data:   ',I20)
        STOP
        END
C
        SUBROUTINE SQUEEZE(STR, NS)
C   Squeeze out imbedded blanks and remove trailing blanks and commas
        CHARACTER STR*1
        DIMENSION STR(3300)
C
        IDFLG = 0
        NSIZE = 3300
        NS = NSIZE
        DO I=1,NSIZE
          J = 1 + NSIZE - I
          IF(IDFLG.EQ.0) THEN
            IF(STR(J).EQ.' ') THEN
              NS = NS - 1
            ELSE
              IDFLG = 1
            ENDIF
          ELSE
            IF(STR(J).EQ.' ') THEN
              DO IJK = J,NS-1
                STR(IJK) = STR(IJK+1)
              ENDDO
              NS = NS - 1
            ENDIF
          ENDIF
        ENDDO
C
        RETURN
        END
