There are two programs shown here that show how to read the ASCII format. 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.
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 = 0The 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_PROFput in the following check
IF (STAT.FXD.NO_PROF.LT.2) ILIKE = 0Again 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 = 1Again 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