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