cat > p.f <<\EOR C=============================================================================C C International Comprehensive Ocean-Atmosphere Data Set (ICOADS) 18 May 2005 C C Filename:level: rdimma0:01G Fortran 77 program+shell C C Purpose: Read and print/write IMMA Author: S.Lubker C C=============================================================================C C Software Revision Information (previous version: 31 Jan 2005, level 01F): C Field LOT (attm 4) changed to type character (from numeric). Removed C {gettrf}, related routines {qb10,b2qxy,prntrf}, and associated data C structures (QCFLG and TRFLG) (note: {gettrf,qb10,b2qxy} became part of C separate {trimqc2.f} software). Documented {init}. (Two NCDC-specific C routines {sdeg,zeros} were also added, but are documented separately.) C-----------------------------------------------------------------------3456789 C Software documentation for the (modifiable) example program {rdimma} and for C the (invariant) user-interface routines {prnskp,prnhdr,getrpt,east,init, C minmax,savsum,putrpt,prnrpt,prnsum}. C C As provided {rdimma}: (a) Prints PROGID (the program name and level). Also, C {prnhdr} prints a 4-line header for the unabbreviated record type (i.e., core C plus all currently defined attms: 1-4 and 99). (b) Reads a report (from C standard input) via a formatted read and calls {getrpt} to extract the fields C and convert them from characters to numeric values. This makes the fields C available in three parallel arrays: C CTRUE: characters (each length 1024) blank for missing data C ITRUE: integers NINT(FMISS) for missing data C FTRUE: true (floating point) values FMISS for missing data C Additional parallel arrays available within common block IMMA0 provide C metadata defining the properties of currently defined fields. These include C each field's length (ILEN), abbreviation (ABBR), allowable range(s), units C (FUNITS; missing for character data) and type (ITYPE; 1=numeric, 2=base36, C 3=character) (see {bdimma} for details). (c) For the core and attms, a C PARAMETER statement relates each field abbreviation to an FTRUE (CTRUE, C ITRUE, etc.) array location; this facilitates usage such as FDY = FTRUE(DY), C to obtain the floating point value for day. Each element of CTRUE is a C 1024-character string, but the field length can be used to control printing, C e.g., PRINT *,CTRUE(DY)(:ILEN(DY)). (d) Prints the original report, RPT, C under the aforementioned field headings (constructed using ABBR). (e) The C program iterates (to step b) reading and printing reports until end-of-file C (EOF) is encountered. Caution: IMPLICIT INTEGER(A-E,G-Z) is used; users may C need to explicitly type additional variables when modifying this program. C C The following optional features are initially deactivated in the Fortran C code; they may be activated by changing the appropriate Fortran comment C lines to executable statements, i.e., remove the letter "C" from column 1: C C (a) Activate one or more calls to {prnskp} to suppress printing of the core C and/or selected attms; {prnskp} is designed to work with the default calls C to {prnhdr} and {prnrpt} for a reduced-width printout. Or (b): Deactivate C the default calls to {prnhdr} and {prnrpt}, and activate one (or more) of C the alternative calls to {prnhdr} and {prnrpt}. This provides flexibility C so that the core or an attm can be printed individually (if only one pair C of {prnhdr,prnrpt} is activated; alternatively, this can be accomplished by C activating all but one call to {prnskp}). Activating multiple alternative C calls to {prnhdr} and {prnrpt} can be used to arrange the core and attms C vertically (i.e., core and attms on multiple lines, for a single report). C Moreover, any contiguous portion of the headers and reports can be printed C by adjusting the fields that appear in the subroutine calls, e.g., activating C CALL PRNHDR(ILEN,ABBR,YR,HR) and CALL PRNRPT(ILEN,CTRUE,YR,HR) prints just C year, month, day, and hour. Features (a) and (b) provide flexibility to C print selected portions of the data; however, note that those two features C were not designed to be used together (e.g., activating {prnskp} to skip C the core, and {prnhdr,prnrpt} to print the core, will produce blank lines). C C Additional notes on using {prnrpt}: To minimize data volume, IMMA data may C have a "sparse" record structure, such that attms without any extant data are C omitted, and the attm structure can vary from report to report. Sparse data C printed via the default calls to {prnhdr, prnrpt}, are expanded out into the C complete IMMA structure. Or, using {prnskp}, sparse reports are expanded out C into a reduced print structure. Alternatively, IMMA data may have a "fixed" C record structure, such that a fixed number of attms is present in all C reports. In either case, it can be determined whether an attm was originally C present in the input data from ATTI and ATTL: these are printed by {prnrpt} C if the attm was extant, or blank if it was missing. ATTC will always reflect C the number of attms originally present (e.g., regardless how many are omitted C from printing through the use of {prnskp}). C C (c) Activating {east} will transform longitudes stored according to the NCDC C convention -179.99 (W) to 180.00 (E), into the ICOADS convention 0-359.99 E. C This action is applied only to the numeric data (ITRUE, FTRUE), and does not C take effect on the printed data, unless feature (d) is also activated. C C (d) Activating {putrpt} will convert all the true values (e.g., longitudes C transformed via {east}) back into characters for printing and/or writing. C Specifically, if changes have been made to FTRUE, {putrpt} puts them also C into ITRUE, CTRUE, and RPT. Then the changes can be printed, by leaving C {prnrpt} statement(s) in operation, or written, by activating (instead of C {prnrpt}) the adjacent WRITE statement. If both {prnrpt} and the WRITE C statement are activated, each report will be output twice, possibly with C differences in format (which provides a means to see how the two different C output methods work). For example, note that {prnskp} has no effect on the C WRITE statement, in contrast to its effect on {prnrpt}. Reports with a C sparse record structure will be output when {putrpt} and the WRITE statement C are used, and ATTC will reflect the output attm count. Reports with a fixed C record structure can be correctly output when {prnrpt} is used, with these C caveats: (1) ATTI and ATTL must be set, when the attm data are entirely C missing, or they will be printed blank; (2) ATTC will be set incorrectly if C {prnskp} is used, but any of the attm data are extant. C C Additional notes on writing IMMA data: With more extensive modifications, C the program can be used to write IMMA data, using non-IMMA data as input. C In this case the READ statement should be replaced by statements to read C non-IMMA data, and {getrpt} deactivated. Prior to reading the non-IMMA C data, {init} should be called to properly initialize the data structures: C call INIT(CTRUE,ITRUE,FTRUE,FMISS,ILEN,NUM) C Then the input data need to be transformed into the appropriate IMMA units, C loaded into FTRUE, {putrpt} called, and the WRITE statement activated. For C writing IMMA, we recommend using feature (f), which ensures that data not C compliant with the format are not output. If {rdimma0} is adapted for this C purpose, it is important to note that a maintenance issue will arise when C updates are made to {rdimma0}. Therefore, we recommend that code added for C this purpose be isolated (e.g., into separate routines) as much as possible. C C (e) Activate calls: to {minmax}, to set any "extreme" true values to error C value FERR (by default equal to the missing value FMISS); to {savsum}, to C save summary information for each field; and to {prnsum}, to print the C following summary information on unit 10 (using field abbreviations, ABBR): C -- A summary of the numbers (and percentages) of each field that are C extant, missing, or erroneous. Erroneous data are also counted C as a subset of the missing category. Any field (or attm) entirely C missing in the input data is omitted from the summary. C -- A summary of any erroneous fields encountered in the input data, C with each unique pattern and its frequency listed. C C (f) The test for NREC greater than or equal to 50 can be activated to stop C before reading/printing the entire file. Regarding feature (e), note that C the {prnsum} summary will only be output if statement 900 is reached. C C Data representation notes: C (1) Printed data: In the header, the field abbreviations (from ABBR) are C listed vertically. The abbreviations are 1-4 characters in length, so C the header always occupies four lines (even if a selected subset of C fields includes no 4-character abbreviations). All decimal points are C omitted for printing (i.e., each FTRUE value is divided by its FUNITS; C e.g., LON=33.80/0.01 = 3380 printed). Missing data (FTRUE=FMISS) are C printed as blank, as are erroneous data, unless the default for FERR is C changed (see note 3). C (2) Stored data (FTRUE, ITRUE, and CTRUE): Some 1-character fields (i.e., C those with ITYPE=2) have alphabetic base36 values defined (and printed) C as part of the legal range. In ITRUE and FTRUE, these are stored as C the corresponding numeric values: A=10, B=11, ..., Z=35. For character C (ITYPE=3) fields, note that ITRUE and CTRUE contain the ICHAR of the C first character of the field (e.g., if ID=WHRN, ITRUE(ID)=87). This C simplifies the implementation of the program, but users should be aware C of the data type in processing character fields. C (3) Erroneous data: Erroneous data can be detected in two ways: (i) Data C that could not be read properly (e.g., a numeric field containing a C special character). (ii) "Extreme" data, which read properly, but failed C to adhere to the ranges defined in {bdimma} (e.g., a numeric temperature C outside of -99.9 to 99.9). Data of the first type are always set to C FERR, but data of the second type are only set to FERR if {minmax} is C called. FERR equals FMISS by default. If FERR is set to a non-default C value such as -888888., the printed output will contain all asterisks in C fields that contained erroneous data. The non-default setting is also C used for quality control applications that need to distinguish between C actual missing data and data that were extant but erroneous. C C Machine dependencies: None known. Non-ANSI features: common block C containing both character and non-character variables, and specification C statements after data statements. C For more information: See and (electronic documents). C-----------------------------------------------------------------------3456789 PROGRAM RDIMMA IMPLICIT INTEGER(A-E,G-Z) C CHARACTER*10 PROGID DATA PROGID/'RDIMMA.01F'/ C C CORE PARAMETER(YR=1,MO=2,DY=3,HR=4,LAT=5,LON=6,IM=7,ATTC=8,TI=9,LI=10 +,DS=11,VS=12,NID=13,II=14,ID=15,C1=16,DI=17,D=18,WI=19,W=20,VI=21 +,VV=22,WW=23,W1=24,SLP=25,A=26,PPP=27,IT=28,AT=29,WBTI=30,WBT=31 +,DPTI=32,DPT=33,SI=34,SST=35,N=36,NH=37,CL=38,HI=39,H=40,CM=41 +,CH=42,WD=43,WP=44,WH=45,SD=46,SP=47,SH=48) C C ICOADS ATTACHMENT PARAMETER(ATTI1=49,ATTL1=50,BSI=51,B10=52,B1=53,DCK=54,SID=55 +,PT=56,DUPS=57,DUPC=58,TC=59,PB=60,WX=61,SX=62,C2=63,SQZ=64,SQA=65 +,AQZ=66,AQA=67,UQZ=68,UQA=69,VQZ=70,VQA=71,PQZ=72,PQA=73,DQZ=74 +,DQA=75,ND=76,SF=77,AF=78,UF=79,VF=80,PF=81,RF=82,ZNC=83,WNC=84 +,BNC=85,XNC=86,YNC=87,PNC=88,ANC=89,GNC=90,DNC=91,SNC=92,CNC=93 +,ENC=94,FNC=95,TNC=96,QCE=97,LZ=98,QCZ=99) C C IMMT-2/FM13 ATTACHMENT PARAMETER(ATTI2=100,ATTL2=101,OS=102,OP=103,FM=104,IX=105,W2=106 +,SGN=107,SGT=108,SGH=109,WMI=110,SD2=111,SP2=112,SH2=113,IS=114 +,ES=115,RS=116,IC1=117,IC2=118,IC3=119,IC4=120,IC5=121,IR=122 +,RRR=123,TR=124,QCI=125,QI1=126,QI2=127,QI3=128,QI4=129,QI5=130 +,QI6=131,QI7=132,QI8=133,QI9=134,QI10=135,QI11=136,QI12=137 +,QI13=138,QI14=139,QI15=140,QI16=141,QI17=142,QI18=143,QI19=144 +,QI20=145,QI21=146,HDG=147,COG=148,SOG=149,SLL=150,SLHH=151 +,RWD=152,RWS=153) C C MODEL QUALITY CONTROL ATTACHMENT PARAMETER(ATTI3=154,ATTL3=155,CCCC=156,BUID=157,BMP=158,BSWU=159 +,SWU=160,BSWV=161,SWV=162,BSAT=163,BSRH=164,SRH=165,SIX=166 +,BSST=167,MST=168,MSH=169,BY=170,BM=171,BD=172,BH=173,BFL=174) C C SHIP METADATA ATTACHMENT PARAMETER(ATTI4=175,ATTL4=176,C1M=177,OPM=178,KOV=179,COR=180 +,TOB=181,TOT=182,EOT=183,LOT=184,TOH=185,EOH=186,SIM=187,LOV=188 +,DOS=189,HOP=190,HOT=191,HOB=192,HOA=193,SMF=194,SME=195,SMV=196) C C HISTORICAL ATTACHMENT C C SUPPLEMENTAL DATA ATTACHMENT PARAMETER(ATTI99=197,ATTL99=198,ATTE=199,SUPD=200) C PARAMETER(NUM=200) CHARACTER*4 ABBR,RPTID COMMON /IMMA0/ILEN(NUM),ABBR(NUM),FMIN1(NUM),FMAX1(NUM) +,FMIN2(NUM),FMAX2(NUM),FUNITS(NUM),ITYPE(NUM),RPTID C CHARACTER*1024 RPT,CTRUE DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM) DATA CTRUE/NUM*' '/,ITRUE/NUM*-999999/,FTRUE/NUM*-999999./ +,FMISS/-999999./,FERR/-999999./,UNIT/10/ C C PRINT PROGRAM HEADER c PRINT *,PROGID C DO NOT PRINT CORE HEADER OR CORE C CALL PRNSKP(YR,SH) C DO NOT PRINT ATTACHMENT HEADER OR ATTACHMENT C CALL PRNSKP(ATTI1,QCZ) C CALL PRNSKP(ATTI2,RWS) C CALL PRNSKP(ATTI3,BFL) C CALL PRNSKP(ATTI4,SMV) C CALL PRNSKP(ATTI99,SUPD) C C PRINT REPORT HEADER c CALL PRNHDR(ILEN,ABBR,YR,SUPD) C PRINT CORE HEADER C CALL PRNHDR(ILEN,ABBR,YR,SH) C PRINT ATTACHMENT HEADER C CALL PRNHDR(ILEN,ABBR,ATTI1,QCZ) C CALL PRNHDR(ILEN,ABBR,ATTI2,RWS) C CALL PRNHDR(ILEN,ABBR,ATTI3,BFL) C CALL PRNHDR(ILEN,ABBR,ATTI4,SMV) C CALL PRNHDR(ILEN,ABBR,ATTI99,SUPD) C INITIALIZE NUMBER OF REPORTS READ NREC=0 ftrue(dck)=883. ftrue(sid)=121. C C READ REPORT 100 CONTINUE READ(*,'(A)',END=900)RPT C INCREMENT NUMBER OF REPORTS READ NREC=NREC+1 C C CONVERT CHARACTERS TO FLOATING POINT VALUES c CALL GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR c +,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) call read(rpt(10:16),ctrue(id), ftrue(id), fmiss,'(bz,f5.0)') call read(rpt(17:20),ctrue(yr), ftrue(yr), fmiss,'(bz,f4.0)') call read(rpt(21:22),ctrue(mo), ftrue(mo), fmiss,'(bz,f2.0)') call read(rpt(23:24),ctrue(dy), ftrue(dy), fmiss,'(bz,f2.0)') call read(rpt(25:28),ctrue(hr), ftrue(hr), fmiss,'(bz,f4.2)') call read(rpt(29:32),ctrue(lat),ftrue(lat),fmiss,'(bz,f3.1)') call read(rpt(33:37),ctrue(lon),ftrue(lon),fmiss,'(bz,f4.1)') call read(rpt(41:44),ctrue(at), ftrue(at), fmiss,'(bz,f4.1)') call read(rpt(45:48),ctrue(dpt),ftrue(dpt),fmiss,'(bz,f4.1)') call read(rpt(49:52),ctrue(sst),ftrue(sst),fmiss,'(bz,f4.1)') call read(rpt(53:57),ctrue(slp),ftrue(slp),fmiss,'(bz,f5.1)') call read(rpt(58:60),ctrue(d), ftrue(d), fmiss,'(bz,f3.0)') call read(rpt(61:64),ctrue(w), ftrue(w), fmiss,'(bz,f4.1)') call read(rpt(75:77),ctrue(wh), ftrue(wh), fmiss,'(bz,f3.1)') call read(rpt(78:80),ctrue(wp), ftrue(wp), fmiss,'(bz,f3.1)') call read(rpt(84:86),ctrue(wd), ftrue(wd), fmiss,'(bz,f3.1)') call read(rpt(87:90),ctrue(rrr),ftrue(rrr),fmiss,'(bz,f4.0)') ctrue(supd)=rpt if (ftrue(hr).ne.fmiss) then min=mod(nint(ftrue(hr)*100.),100) if (min.ge.0 .and. min.le.59) then ftrue(hr)=nint(ftrue(hr)*100.)/100+min/60. else ftrue(hr)=fmiss endif endif if (ftrue(lat).ne.fmiss) then if (ctrue(lat)(4:4).eq.'S') then ftrue(lat)=-ftrue(lat) else if (ctrue(lat)(4:4).ne.'N') then ftrue(lat)=fmiss endif endif if (ftrue(lon).ne.fmiss) then if (ctrue(lon)(5:5).eq.'W') then ftrue(lon)=-ftrue(lon) else if (ctrue(lon)(5:5).ne.'E') then ftrue(lon)=fmiss endif endif if (ftrue(d).ne.fmiss) then if (nint(ftrue(d)).eq.0) then ftrue(d)=361. else if (nint(ftrue(d)).eq.999) then ftrue(d)=362. else if (nint(ftrue(d)).gt.360) then ftrue(d)=fmiss endif endif if (ftrue(w).ne.fmiss) then ftrue(w)=fxktms(ftrue(w)) endif if (ftrue(sst).ne.fmiss) then if (index('0123456789',ctrue(sst)(:1)).ne.0) + ftrue(sst)=ftrue(sst)/10. endif if (ftrue(wd).ne.fmiss) then if (nint(ftrue(wd)*10.).ge.0 +.and. nint(ftrue(wd)*10.).le.360) then if (nint(ftrue(wd)*10.).ne.0) then if (nint(ftrue(wd)).eq.0) ftrue(wd)=36. endif else ftrue(wd)=fmiss endif endif if (ftrue(wp).ne.fmiss) then if (nint(ftrue(wp)).eq.99) then ftrue(wp)=fmiss endif endif if (ftrue(wh).ne.fmiss) then ftrue(wh)=ftrue(wh)*2. endif if (ftrue(rrr).ne.fmiss) then if (nint(ftrue(rrr)).gt.989) then ftrue(rrr)=fmiss endif endif C C CONVERT LONGITUDE TO DEGREES EAST CALL EAST(ITRUE(LON),FTRUE(LON),FERR) C SET EXTREME FLOATING POINT VALUES TO ERROR VALUE CALL MINMAX(CTRUE,ITRUE,FTRUE,FMISS,FERR +,ILEN,FMIN1,FMAX1,FMIN2,FMAX2,FUNITS,ITYPE,NUM) call set(ctrue(ti),ftrue(ti),fmiss,2.,ftrue(hr)) call set(ctrue(li),ftrue(li),fmiss,0.,max(ftrue(lat),ftrue(lon))) call set(ctrue(di),ftrue(di),fmiss,5.,ftrue(d)) call set(ctrue(wi),ftrue(wi),fmiss,8.,ftrue(w)) call set(ctrue(it),ftrue(it),fmiss,0.,max(ftrue(at),ftrue(dpt) +,ftrue(sst))) call set(ctrue(tr),ftrue(tr),fmiss,1.,ftrue(rrr)) C SAVE SUMMARY INFORMATION CALL SAVSUM(CTRUE,FTRUE,FMISS,FERR +,ILEN,ABBR,NUM) C C CONVERT FLOATING POINT VALUES TO CHARACTERS CALL PUTRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR +,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) C WRITE REPORT WRITE(*,'(A)')RPT(:LENTRM(RPT)) C C PRINT REPORT c CALL PRNRPT(ILEN,CTRUE,YR,SUPD) C PRINT CORE C CALL PRNRPT(ILEN,CTRUE,YR,SH) C PRINT ATTACHMENT C CALL PRNRPT(ILEN,CTRUE,ATTI1,QCZ) C CALL PRNRPT(ILEN,CTRUE,ATTI2,RWS) C CALL PRNRPT(ILEN,CTRUE,ATTI3,BFL) C CALL PRNRPT(ILEN,CTRUE,ATTI4,SMV) C CALL PRNRPT(ILEN,CTRUE,ATTI99,SUPD) C C STOP AFTER SEVERAL REPORTS HAVE BEEN READ C IF (NREC.GE.50) STOP 'REMOVE STOP TO READ ALL REPORTS' GOTO 100 C C END OF FILE 900 CONTINUE c PRINT *,'REPORTS ',NREC C C PRINT SUMMARY INFORMATION TO UNIT CALL PRNSUM(UNIT,PROGID,ABBR,NUM) END c-----------------------------------------------------------------------3456789 subroutine read(rpt,ctrue,ftrue,fmiss,fmt) character*(*) rpt,ctrue*16,fmt c ctrue=rpt ftrue=fmiss if (ctrue.ne.' ') read(ctrue,fmt,iostat=ios) ftrue end c-----------------------------------------------------------------------3456789 subroutine set(ctrue,ftrue,fmiss,float,ftrue2) character ctrue*16 c if (ftrue2.ne.fmiss) then ftrue=float else ctrue=' ' ftrue=fmiss endif end C=============================================================================C C WARNING: Code beyond this point should not require any modification. C C=============================================================================C C-----------------------------------------------------------------------3456789 SUBROUTINE INIT(CTRUE,ITRUE,FTRUE,FMISS,ILEN,NUM) C INITIALIZE CTRUE, ITRUE, AND FTRUE IMPLICIT INTEGER(A-E,G-Z) CHARACTER*(*) CTRUE DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM),ILEN(NUM) C DO 190 I=1,NUM IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'INIT CTRUE LENGTH' CTRUE(I)(:ILEN(I))=' ' ITRUE(I)=NINT(FMISS) FTRUE(I)=FMISS 190 CONTINUE END C-----------------------------------------------------------------------3456789 SUBROUTINE EAST(ITRUE,FTRUE,FERR) C CONVERT LONGITUDE TO DEGREES EAST IMPLICIT INTEGER(A-E,G-Z) C IF(NINT(FTRUE*100.).GE.-36000 .AND. NINT(FTRUE*100.).LE.36000)THEN FTRUE=MOD(FTRUE+360.,360.) ITRUE=NINT(FTRUE*100.) ELSE FTRUE=FERR ITRUE=NINT(FERR) ENDIF END C-----------------------------------------------------------------------3456789 SUBROUTINE PRNSKP(BEG,END) C DO NOT PRINT REPORT HEADER OR REPORT IMPLICIT INTEGER(A-E,G-Z) CHARACTER*(*) ABBR,CTRUE DIMENSION ILEN(*),ABBR(*),CTRUE(*) CHARACTER*1024 HDR,RPT*2048 EQUIVALENCE(HDR,RPT) DIMENSION SKP(1024) DATA SKP/1024*0/ SAVE SKP C DO 190 I=BEG,END SKP(I)=1 190 CONTINUE RETURN C-----------------------------------------------------------------------3456789 ENTRY PRNHDR(ILEN,ABBR,BEG,END) C PRINT REPORT HEADER C DO 295 J=1,4 HDR=' ' PTR=0 DO 290 I=BEG,END IF (SKP(I).EQ.0) THEN IF (ILEN(I).EQ.1024) THEN PTR=PTR+1 ELSE PTR=PTR+ILEN(I) ENDIF HDR(PTR:PTR)=ABBR(I)(J:J) ENDIF 290 CONTINUE PRINT '(A)',HDR(:PTR) 295 CONTINUE RETURN C-----------------------------------------------------------------------3456789 ENTRY PRNRPT(ILEN,CTRUE,BEG,END) C PRINT REPORT C RPT=' ' PTR=0 DO 390 I=BEG,END IF (SKP(I).EQ.0) THEN IF (ILEN(I).EQ.1024) THEN IF (PTR+1.GT.LEN(RPT)) STOP 'PRNRPT RPT LENGTH' RPT(PTR+1:)=CTRUE(I) IF (RPT(PTR+1:).NE.CTRUE(I)) STOP 'PRNRPT OVERFLOW' PTR=LENTRM(RPT) ELSE IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'PRNRPT RPT LENGTH' IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'PRNRPT CTRUE LENGTH' RPT(PTR+1:PTR+ILEN(I))=CTRUE(I)(:ILEN(I)) PTR=PTR+ILEN(I) ENDIF ENDIF 390 CONTINUE PRINT '(A)',RPT(:PTR) END C-----------------------------------------------------------------------3456789 SUBROUTINE GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR +,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) C CONVERT CHARACTERS TO FLOATING POINT VALUES IMPLICIT INTEGER(A-E,G-Z) CHARACTER*(*) RPT,CTRUE,ABBR,RPTID DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM) +,ILEN(NUM),ABBR(NUM),FMIN1(NUM),FUNITS(NUM),ITYPE(NUM) CHARACTER B36,IFMT(9)*8,STR*2048 DATA IFMT/'(BZ,I1)','(BZ,I2)','(BZ,I3)','(BZ,I4)' +,'(BZ,I5)','(BZ,I6)','(BZ,I7)','(BZ,I8)','(BZ,I9)'/ SAVE IFMT C PTR=0 RST=0 ATTC=1000 DO 180 I=1,NUM IF (ABBR(I).EQ.'ATTI') THEN ATTC=MOD(ATTC,1000) ATTI=NINT(FMIN1(I)) ATTL=NINT(FMIN1(I+1)) IF (RST+4.GT.LEN(STR)) STOP 'GETRPT STR LENGTH' IF (PTR+4.GT.LEN(RPT)) THEN STR(RST+1:)=' ' RST=LEN(STR) GOTO 185 ENDIF WRITE(STR(RST+1:RST+4),'(2I2)')ATTI,ATTL IF (ATTL.EQ.0) THEN IF (RPT(PTR+1:PTR+4).EQ.STR(RST+1:RST+4)) THEN STR(RST+1:)=RPT(PTR+1:) IF (STR(RST+1:).NE.RPT(PTR+1:)) STOP 'GETRPT OVERFLOW' PTR=LEN(RPT) ELSE STR(RST+1:)=' ' ENDIF RST=LEN(STR) GOTO 185 ELSE IF (RST+ATTL.GT.LEN(STR)) STOP 'GETRPT STR LENGTH' IF (RPT(PTR+1:PTR+4).EQ.STR(RST+1:RST+4)) THEN IF (PTR+ATTL.GT.LEN(RPT)) STOP 'GETRPT RPT LENGTH' STR(RST+1:RST+ATTL)=RPT(PTR+1:PTR+ATTL) PTR=PTR+ATTL ELSE STR(RST+1:RST+ATTL)=' ' ENDIF ENDIF ELSE IF (ATTC.GE.1000) THEN IF (RST+ILEN(I).GT.LEN(STR)) STOP 'GETRPT STR LENGTH' IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'GETRPT RPT LENGTH' STR(RST+1:RST+ILEN(I))=RPT(PTR+1:PTR+ILEN(I)) IF (ABBR(I).EQ.' IM') THEN IF (RPT(PTR+1:PTR+2).NE.RPTID) STOP 'IMMA VERSION INVALID' ENDIF PTR=PTR+ILEN(I) ENDIF ENDIF RST=RST+ILEN(I) 180 CONTINUE 185 IF (PTR.LT.LEN(RPT)) THEN IF (RPT(PTR+1:).NE.' ') STOP 'GETRPT INCOMPLETE' ENDIF C IF (RST.LT.LEN(STR)) STR(RST+1:)=' ' RST=0 DO 190 I=1,NUM IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'GETRPT CTRUE LENGTH' C IF (ILEN(I).EQ.1024) THEN IF (RST+1.GT.LEN(STR)) STOP 'GETRPT STR LENGTH' CTRUE(I)=STR(RST+1:) IF (CTRUE(I).NE.STR(RST+1:)) STOP 'GETRPT OVERFLOW' RST=LEN(STR) ELSE IF (RST+ILEN(I).GT.LEN(STR)) STOP 'GETRPT STR LENGTH' CTRUE(I)(:ILEN(I))=STR(RST+1:RST+ILEN(I)) RST=RST+ILEN(I) ENDIF C IF (CTRUE(I)(:ILEN(I)).EQ.' ') THEN ITRUE(I)=NINT(FMISS) ELSE IF (ITYPE(I).EQ.1) THEN READ(CTRUE(I)(:ILEN(I)),IFMT(ILEN(I)),IOSTAT=IOS)ITRUE(I) IF (IOS.NE.0) ITRUE(I)=NINT(FERR) ELSE IF (ITYPE(I).EQ.2) THEN ITRUE(I)=IB36(CTRUE(I)(:ILEN(I)),NINT(FERR)) ELSE ITRUE(I)=ICHAR(CTRUE(I)(:1)) ENDIF C IF (ITRUE(I).NE.NINT(FMISS) .AND. ITRUE(I).NE.NINT(FERR) + .AND. ITYPE(I).LE.2) THEN FTRUE(I)=ITRUE(I)*FUNITS(I) ELSE FTRUE(I)=ITRUE(I) ENDIF 190 CONTINUE RETURN C-----------------------------------------------------------------------3456789 ENTRY PUTRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR +,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) C CONVERT FLOATING POINT VALUES TO CHARACTERS C RST=0 DO 280 I=1,NUM IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'PUTRPT CTRUE LENGTH' C IF (FTRUE(I).NE.FMISS .AND. FTRUE(I).NE.FERR + .AND. ITYPE(I).LE.2) THEN ITRUE(I)=NINT(FTRUE(I)/FUNITS(I)) ELSE ITRUE(I)=NINT(FTRUE(I)) ENDIF C IF (ITRUE(I).EQ.NINT(FMISS)) THEN CTRUE(I)(:ILEN(I))=' ' ELSE IF (ITYPE(I).EQ.1) THEN WRITE(CTRUE(I)(:ILEN(I)),IFMT(ILEN(I)))ITRUE(I) ELSE IF (ITYPE(I).EQ.2) THEN CTRUE(I)(:ILEN(I))=B36(ITRUE(I),'*') ELSE C CTRUE(I)(:1)=CHAR(ITRUE(I)) ENDIF C IF (ILEN(I).EQ.1024) THEN IF (RST+1.GT.LEN(STR)) STOP 'PUTRPT STR LENGTH' STR(RST+1:)=CTRUE(I) IF (STR(RST+1:).NE.CTRUE(I)) STOP 'PUTRPT OVERFLOW' RST=LEN(STR) ELSE IF (RST+ILEN(I).GT.LEN(STR)) STOP 'PUTRPT STR LENGTH' STR(RST+1:RST+ILEN(I))=CTRUE(I)(:ILEN(I)) RST=RST+ILEN(I) ENDIF 280 CONTINUE IF (RST.LT.LEN(STR)) STR(RST+1:)=' ' C PTR=0 RST=0 ATTC=1000 DO 290 I=1,NUM IF (ABBR(I).EQ.'ATTI') THEN ATTC=MOD(ATTC,1000) ATTI=NINT(FMIN1(I)) ATTL=NINT(FMIN1(I+1)) IF (RST+4.GT.LEN(STR)) STOP 'PUTRPT STR LENGTH' IF (PTR+4.GT.LEN(RPT)) THEN IF (STR(RST+1:).NE.' ') STOP 'PUTRPT INCOMPLETE' RST=LEN(STR) GOTO 295 ENDIF WRITE(STR(RST+1:RST+4),'(2I2)')ATTI,ATTL IF (ATTL.EQ.0) THEN IF (STR(RST+5:).NE.' ') THEN RPT(PTR+1:)=STR(RST+1:) IF (RPT(PTR+1:).NE.STR(RST+1:)) STOP 'PUTRPT OVERFLOW' PTR=LEN(RPT) ATTC=ATTC+1 ENDIF RST=LEN(STR) GOTO 295 ELSE IF (RST+ATTL.GT.LEN(STR)) STOP 'PUTRPT STR LENGTH' IF (STR(RST+5:RST+ATTL).NE.' ') THEN IF (PTR+ATTL.GT.LEN(RPT)) STOP 'PUTRPT RPT LENGTH' RPT(PTR+1:PTR+ATTL)=STR(RST+1:RST+ATTL) PTR=PTR+ATTL ATTC=ATTC+1 ENDIF ENDIF ELSE IF (ATTC.GE.1000) THEN IF (RST+ILEN(I).GT.LEN(STR)) STOP 'PUTRPT STR LENGTH' IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'PUTRPT RPT LENGTH' RPT(PTR+1:PTR+ILEN(I))=STR(RST+1:RST+ILEN(I)) IF (ABBR(I).EQ.' IM') THEN RPT(PTR+1:PTR+2)=RPTID ELSE IF (ABBR(I).EQ.'ATTC') THEN ATTC=1000+RST*10 ENDIF PTR=PTR+ILEN(I) ENDIF ENDIF RST=RST+ILEN(I) 290 CONTINUE 295 IF (PTR.LT.LEN(RPT)) RPT(PTR+1:)=' ' ATTC=MOD(ATTC,1000) IF (ATTC/10.GT.0) +WRITE(RPT(ATTC/10+1:ATTC/10+1),'(I1)')MOD(ATTC,10) END C-----------------------------------------------------------------------3456789 SUBROUTINE MINMAX(CTRUE,ITRUE,FTRUE,FMISS,FERR +,ILEN,FMIN1,FMAX1,FMIN2,FMAX2,FUNITS,ITYPE,NUM) C SET EXTREME FLOATING POINT VALUES TO ERROR VALUE IMPLICIT INTEGER(A-E,G-Z) CHARACTER*(*) CTRUE DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM) +,ILEN(NUM),FMIN1(NUM),FMAX1(NUM),FMIN2(NUM),FMAX2(NUM) +,FUNITS(NUM),ITYPE(NUM) C DO 190 I=1,NUM IF (ITYPE(I).GT.2) THEN IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'MINMAX CTRUE LENGTH' IF (CTRUE(I)(:ILEN(I)).EQ.' ') THEN ITRUE(I)=NINT(FMISS) ELSE ITRUE(I)=ICHAR(CTRUE(I)(:1)) ENDIF FTRUE(I)=ITRUE(I) ENDIF IF (FTRUE(I).NE.FMISS .AND. FTRUE(I).NE.FERR) THEN IF (ITYPE(I).LE.2) THEN ITRUE(I)=NINT(FTRUE(I)/FUNITS(I)) IF (ITRUE(I).GE.NINT(FMIN1(I)/FUNITS(I)) + .AND.ITRUE(I).LE.NINT(FMAX1(I)/FUNITS(I)) + .OR. ITRUE(I).GE.NINT(FMIN2(I)/FUNITS(I)) + .AND.ITRUE(I).LE.NINT(FMAX2(I)/FUNITS(I))) THEN ELSE FTRUE(I)=FERR ITRUE(I)=NINT(FERR) ENDIF ELSE DO 180 J=1,ILEN(I) IF (LGE(CTRUE(I)(J:J),'A') + .AND.LLE(CTRUE(I)(J:J),'Z') + .OR. NINT(FMIN1(I)).LE.48 + .AND.LGE(CTRUE(I)(J:J),'0') + .AND.LLE(CTRUE(I)(J:J),'9') + .OR. NINT(FMIN1(I)).EQ.32 + .AND.LGE(CTRUE(I)(J:J),' ') + .AND.LLE(CTRUE(I)(J:J),'~')) THEN ELSE FTRUE(I)=FERR ITRUE(I)=NINT(FERR) GOTO 190 ENDIF 180 CONTINUE ENDIF ENDIF 190 CONTINUE END C-----------------------------------------------------------------------3456789 SUBROUTINE SAVSUM(CTRUE,FTRUE,FMISS,FERR +,ILEN,ABBR,NUM) C SAVE SUMMARY INFORMATION IMPLICIT INTEGER(A-E,G-Z) CHARACTER*(*) PROGID,ABBR,CTRUE DIMENSION CTRUE(NUM),FTRUE(NUM),ILEN(NUM),ABBR(NUM) CHARACTER*64 STR DIMENSION SUM1(1024),SUM2(1024),SUM3(1024) DATA SUM1,SUM2,SUM3/1024*0,1024*0,1024*0/ SAVE SUM1,SUM2,SUM3 PC(A1,A2)=NINT(FLOAT(A1*100)/MAX(A2,1)) C DO 190 I=1,NUM IF (FTRUE(I).NE.FMISS .AND. FTRUE(I).NE.FERR) THEN SUM1(I)=SUM1(I)+1 ELSE SUM2(I)=SUM2(I)+1 IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'SAVSUM CTRUE LENGTH' IF (CTRUE(I)(:ILEN(I)).NE.' ') THEN SUM3(I)=SUM3(I)+1 WRITE(STR,'(I3,A6,2X,A53)')I,ABBR(I),CTRUE(I) CALL SAVSTR(STR) ENDIF ENDIF 190 CONTINUE RETURN C-----------------------------------------------------------------------3456789 ENTRY PRNSUM(UNIT,PROGID,ABBR,NUM) C PRINT SUMMARY INFORMATION TO UNIT C WRITE(UNIT,'(A)')PROGID WRITE(UNIT,'(/1X,A)')'SUMMARY OF FIELDS' WRITE(UNIT,'(A6,2(2X,A10,A11,A13))')'FIELD' +,'# EXTANT','# MISSING','# ERRONEOUS' +,'% EXTANT','% MISSING','% ERRONEOUS' DO 290 I=1,NUM IF (SUM1(I).GT.0 .OR. SUM3(I).GT.0) THEN TOTAL=SUM1(I)+SUM2(I) WRITE(UNIT,'(A6,2(2X,I10,I11,I13))')ABBR(I) + , SUM1(I) , SUM2(I) , SUM3(I) + ,PC(SUM1(I),TOTAL),PC(SUM2(I),TOTAL),PC(SUM3(I),TOTAL) ENDIF SUM1(I)=0 SUM2(I)=0 SUM3(I)=0 290 CONTINUE WRITE(UNIT,'(/1X,A)')'SUMMARY OF ERRORS' WRITE(UNIT,'(A6,2X,A,T70,A)')'FIELD','ERROR','FREQUENCY' CALL PRNSTR(UNIT) END C-----------------------------------------------------------------------3456789 SUBROUTINE SAVSTR(STR) C SAVE FREQUENCY OF STRING IMPLICIT INTEGER(A-E,G-Z) PARAMETER(MMAX=10000) CHARACTER*64 STR,ARR1 DIMENSION ARR1(MMAX),ARR2(MMAX) DATA M/0/ SAVE C DO 190 I=1,M IF (STR.NE.ARR1(I)) GOTO 190 ARR2(I)=ARR2(I)+1 RETURN 190 CONTINUE IF (M+1.GE.MMAX) STOP 'INCREASE MMAX' M=M+1 ARR1(M)=STR ARR2(M)=1 RETURN C-----------------------------------------------------------------------3456789 ENTRY PRNSTR(UNIT) C PRINT FREQUENCY OF STRING C DO 290 K=1,M-1 J=K DO 280 L=K+1,M IF (LLT(ARR1(L),ARR1(J))) J=L 280 CONTINUE IF (J.NE.K) THEN ARR1(MMAX)=ARR1(K) ARR2(MMAX)=ARR2(K) ARR1(K)=ARR1(J) ARR2(K)=ARR2(J) ARR1(J)=ARR1(MMAX) ARR2(J)=ARR2(MMAX) ENDIF 290 CONTINUE WRITE(UNIT,'(A,T70,I9)')(ARR1(I)(4:),ARR2(I),I=1,M) M=0 END C-----------------------------------------------------------------------3456789 INTEGER FUNCTION IB36(B36,IERR) C CONVERT BASE36 CHARACTER TO INTEGER CHARACTER B36 INTEGER IERR CHARACTER*36 STR DATA STR/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ SAVE STR C IB36=INDEX(STR,B36) IF (IB36.NE.0) THEN IB36=IB36-1 ELSE IB36=IERR ENDIF END C-----------------------------------------------------------------------3456789 CHARACTER FUNCTION B36(IB36,ERR) C CONVERT INTEGER TO BASE36 CHARACTER INTEGER IB36 CHARACTER ERR CHARACTER*36 STR DATA STR/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ SAVE STR C IF (IB36.GE.0 .AND. IB36.LE.35) THEN B36=STR(IB36+1:) ELSE B36=ERR ENDIF END C-----------------------------------------------------------------------3456789 FUNCTION LENTRM(STR) C LENGTH OF A STRING MINUS TRAILING BLANKS CHARACTER STR*(*) DO 190 LENTRM=LEN(STR),1,-1 IF (STR(LENTRM:LENTRM).NE.' ') RETURN 190 CONTINUE END C-----------------------------------------------------------------------3456789 SUBROUTINE SDEG(ITRUE,FTRUE,FERR) C CONVERT LONGITUDE TO SIGNED DEGREES EAST IMPLICIT INTEGER(A-E,G-Z) C IF(NINT(FTRUE*100.).GE.-36000 .AND. NINT(FTRUE*100.).LE.36000)THEN IF(NINT(FTRUE*100.).GT.18000)FTRUE=FTRUE-360. ITRUE=NINT(FTRUE*100.) ELSE FTRUE=FERR ITRUE=NINT(FERR) ENDIF END C-----------------------------------------------------------------------3456789 SUBROUTINE ZEROS(CTRUE,ILEN,ABBR,ITYPE,NUM) C ZERO FILL LEADING BLANKS IMPLICIT INTEGER(A-E,G-Z) CHARACTER*(*) CTRUE,ABBR DIMENSION CTRUE(NUM),ILEN(NUM),ABBR(NUM),ITYPE(NUM) CHARACTER IFMT(18)*8 DATA IFMT/'(I1.1)','(I2.2)','(I3.3)','(I4.4)','(I5.5)','(I6.6)' +,'(I7.7)','(I8.8)','(I9.9)','(I1.0)','(I2.1)','(I3.2)','(I4.3)' +,'(I5.4)','(I6.5)','(I7.6)','(I8.7)','(I9.8)'/ C DO 190 I=1,NUM IF (CTRUE(I)(:ILEN(I)).NE.' ' + .AND. ILEN(I).NE.1 + .AND. ABBR(I).NE.' IM' + .AND. ABBR(I).NE.'ATTI' + .AND. ABBR(I).NE.'ATTL' + .AND. ITYPE(I).EQ.1) THEN READ(CTRUE(I)(:ILEN(I)),IFMT(ILEN(I)))ITRUE IF (ITRUE.LT.0) THEN WRITE(CTRUE(I)(:ILEN(I)),IFMT(ILEN(I)+9))ITRUE ELSE WRITE(CTRUE(I)(:ILEN(I)),IFMT(ILEN(I)))ITRUE ENDIF ENDIF 190 CONTINUE END C-----------------------------------------------------------------------3456789 BLOCK DATA BDIMMA C COMMON BLOCK DATA STATEMENTS IMPLICIT INTEGER(A-E,G-Z) C C missing = -999999 C ILEN = field length C ABBR = field abbreviation C FMIN1 = field range minimum (first, or only) C FMAX1 = field range maximum (first, or only) C FMIN2 = field range minimum (second, or missing) C FMAX2 = field range maximum (second, or missing) C FUNITS = field units (missing, if itype=3) C ITYPE = 1: numeric: decimal range(s) C 2: numeric: decimal range(s), transformed to base36 C 3: character: decimal range(s), transformed to ascii C RPTID = 0 (IMMA version that the program can read) C PARAMETER(NUM=200) CHARACTER*4 ABBR,RPTID COMMON /IMMA0/ILEN(NUM),ABBR(NUM),FMIN1(NUM),FMAX1(NUM) +,FMIN2(NUM),FMAX2(NUM),FUNITS(NUM),ITYPE(NUM),RPTID C DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=1,18)/ + 4, ' YR', 1600. , 2024. ,-999999.,-999999., 1. , 1, + 2, ' MO', 1. , 12. ,-999999.,-999999., 1. , 1, + 2, ' DY', 1. , 31. ,-999999.,-999999., 1. , 1, + 4, ' HR', 0.00, 23.99,-999999.,-999999., 0.01 , 1, + 5, ' LAT', -90.00, 90.00,-999999.,-999999., 0.01 , 1, + 6, ' LON', 0.00, 359.99, -179.99, 180.00, 0.01 , 1, + 2, ' IM', 0. , 99. ,-999999.,-999999., 1. , 1, + 1, 'ATTC', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' TI', 0. , 3. ,-999999.,-999999., 1. , 1, + 1, ' LI', 0. , 6. ,-999999.,-999999., 1. , 1, + 1, ' DS', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' VS', 0. , 9. ,-999999.,-999999., 1. , 1, + 2, ' NID', 0. , 99. ,-999999.,-999999., 1. , 1, + 2, ' II', 0. , 10. ,-999999.,-999999., 1. , 1, + 9, ' ID', 32. , 126. ,-999999.,-999999.,-999999., 3, + 2, ' C1', 48. , 57. , 65. , 90. ,-999999., 3, + 1, ' DI', 0. , 6. ,-999999.,-999999., 1. , 1, + 3, ' D', 1. , 362. ,-999999.,-999999., 1. , 1/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=19,36)/ + 1, ' WI', 0. , 8. ,-999999.,-999999., 1. , 1, + 3, ' W', 0.0 , 99.9 ,-999999.,-999999., 0.1 , 1, + 1, ' VI', 0. , 2. ,-999999.,-999999., 1. , 1, + 2, ' VV', 90. , 99. ,-999999.,-999999., 1. , 1, + 2, ' WW', 0. , 99. ,-999999.,-999999., 1. , 1, + 1, ' W1', 0. , 9. ,-999999.,-999999., 1. , 1, + 5, ' SLP', 870.0 , 1074.6 ,-999999.,-999999., 0.1 , 1, + 1, ' A', 0. , 8. ,-999999.,-999999., 1. , 1, + 3, ' PPP', 0.0 , 51.0 ,-999999.,-999999., 0.1 , 1, + 1, ' IT', 0. , 9. ,-999999.,-999999., 1. , 1, + 4, ' AT', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 1, 'WBTI', 0. , 3. ,-999999.,-999999., 1. , 1, + 4, ' WBT', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 1, 'DPTI', 0. , 3. ,-999999.,-999999., 1. , 1, + 4, ' DPT', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 2, ' SI', 0. , 12. ,-999999.,-999999., 1. , 1, + 4, ' SST', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 1, ' N', 0. , 9. ,-999999.,-999999., 1. , 1/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=37,54)/ + 1, ' NH', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' CL', 0. , 10. ,-999999.,-999999., 1. , 2, + 1, ' HI', 0. , 1. ,-999999.,-999999., 1. , 1, + 1, ' H', 0. , 10. ,-999999.,-999999., 1. , 2, + 1, ' CM', 0. , 10. ,-999999.,-999999., 1. , 2, + 1, ' CH', 0. , 10. ,-999999.,-999999., 1. , 2, + 2, ' WD', 0. , 38. ,-999999.,-999999., 1. , 1, + 2, ' WP', 0. , 30. , 99. , 99. , 1. , 1, + 2, ' WH', 0. , 99. ,-999999.,-999999., 1. , 1, + 2, ' SD', 0. , 38. ,-999999.,-999999., 1. , 1, + 2, ' SP', 0. , 30. , 99. , 99. , 1. , 1, + 2, ' SH', 0. , 99. ,-999999.,-999999., 1. , 1, + 2, 'ATTI', 1. , 1. ,-999999.,-999999., 1. , 1, + 2, 'ATTL', 65. , 65. ,-999999.,-999999., 1. , 1, + 1, ' BSI',-999999.,-999999.,-999999.,-999999., 1. , 1, + 3, ' B10', 1. , 648. ,-999999.,-999999., 1. , 1, + 2, ' B1', 0. , 99. ,-999999.,-999999., 1. , 1, + 3, ' DCK', 0. , 999. ,-999999.,-999999., 1. , 1/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=55,72)/ + 3, ' SID', 0. , 999. ,-999999.,-999999., 1. , 1, + 2, ' PT', 0. , 15. ,-999999.,-999999., 1. , 1, + 2, 'DUPS', 0. , 14. ,-999999.,-999999., 1. , 1, + 1, 'DUPC', 0. , 2. ,-999999.,-999999., 1. , 1, + 1, ' TC', 0. , 1. ,-999999.,-999999., 1. , 1, + 1, ' PB', 0. , 2. ,-999999.,-999999., 1. , 1, + 1, ' WX', 1. , 1. ,-999999.,-999999., 1. , 1, + 1, ' SX', 1. , 1. ,-999999.,-999999., 1. , 1, + 2, ' C2', 0. , 40. ,-999999.,-999999., 1. , 1, + 1, ' SQZ', 1. , 35. ,-999999.,-999999., 1. , 2, + 1, ' SQA', 1. , 21. ,-999999.,-999999., 1. , 2, + 1, ' AQZ', 1. , 35. ,-999999.,-999999., 1. , 2, + 1, ' AQA', 1. , 21. ,-999999.,-999999., 1. , 2, + 1, ' UQZ', 1. , 35. ,-999999.,-999999., 1. , 2, + 1, ' UQA', 1. , 21. ,-999999.,-999999., 1. , 2, + 1, ' VQZ', 1. , 35. ,-999999.,-999999., 1. , 2, + 1, ' VQA', 1. , 21. ,-999999.,-999999., 1. , 2, + 1, ' PQZ', 1. , 35. ,-999999.,-999999., 1. , 2/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=73,90)/ + 1, ' PQA', 1. , 21. ,-999999.,-999999., 1. , 2, + 1, ' DQZ', 1. , 35. ,-999999.,-999999., 1. , 2, + 1, ' DQA', 1. , 21. ,-999999.,-999999., 1. , 2, + 1, ' ND', 1. , 2. ,-999999.,-999999., 1. , 1, + 1, ' SF', 1. , 15. ,-999999.,-999999., 1. , 2, + 1, ' AF', 1. , 15. ,-999999.,-999999., 1. , 2, + 1, ' UF', 1. , 15. ,-999999.,-999999., 1. , 2, + 1, ' VF', 1. , 15. ,-999999.,-999999., 1. , 2, + 1, ' PF', 1. , 15. ,-999999.,-999999., 1. , 2, + 1, ' RF', 1. , 15. ,-999999.,-999999., 1. , 2, + 1, ' ZNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' WNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' BNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' XNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' YNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' PNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' ANC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' GNC', 1. , 10. ,-999999.,-999999., 1. , 2/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=91,108)/ + 1, ' DNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' SNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' CNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' ENC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' FNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 1, ' TNC', 1. , 10. ,-999999.,-999999., 1. , 2, + 2, ' QCE', 0. , 63. ,-999999.,-999999., 1. , 1, + 1, ' LZ', 1. , 1. ,-999999.,-999999., 1. , 1, + 2, ' QCZ', 0. , 31. ,-999999.,-999999., 1. , 1, + 2, 'ATTI', 2. , 2. ,-999999.,-999999., 1. , 1, + 2, 'ATTL', 76. , 76. ,-999999.,-999999., 1. , 1, + 1, ' OS', 0. , 6. ,-999999.,-999999., 1. , 1, + 1, ' OP', 0. , 9. ,-999999.,-999999., 1. , 1, + 2, ' FM', 0. , 8. ,-999999.,-999999., 1. , 1, + 1, ' IX', 1. , 7. ,-999999.,-999999., 1. , 1, + 1, ' W2', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' SGN', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' SGT', 0. , 10. ,-999999.,-999999., 1. , 2/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=109,126)/ + 2, ' SGH', 0. , 50. , 56. , 99. , 1. , 1, + 1, ' WMI', 0. , 9. ,-999999.,-999999., 1. , 1, + 2, ' SD2', 0. , 38. ,-999999.,-999999., 1. , 1, + 2, ' SP2', 0. , 30. , 99. , 99. , 1. , 1, + 2, ' SH2', 0. , 99. ,-999999.,-999999., 1. , 1, + 1, ' IS', 1. , 5. ,-999999.,-999999., 1. , 1, + 2, ' ES', 0. , 99. ,-999999.,-999999., 1. , 1, + 1, ' RS', 0. , 4. ,-999999.,-999999., 1. , 1, + 1, ' IC1', 0. , 10. ,-999999.,-999999., 1. , 2, + 1, ' IC2', 0. , 10. ,-999999.,-999999., 1. , 2, + 1, ' IC3', 0. , 10. ,-999999.,-999999., 1. , 2, + 1, ' IC4', 0. , 10. ,-999999.,-999999., 1. , 2, + 1, ' IC5', 0. , 10. ,-999999.,-999999., 1. , 2, + 1, ' IR', 0. , 4. ,-999999.,-999999., 1. , 1, + 3, ' RRR', 0. , 999. ,-999999.,-999999., 1. , 1, + 1, ' TR', 1. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QCI', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QI1', 0. , 9. ,-999999.,-999999., 1. , 1/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=127,144)/ + 1, ' QI2', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QI3', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QI4', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QI5', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QI6', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QI7', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QI8', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, ' QI9', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI10', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI11', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI12', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI13', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI14', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI15', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI16', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI17', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI18', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI19', 0. , 9. ,-999999.,-999999., 1. , 1/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=145,162)/ + 1, 'QI20', 0. , 9. ,-999999.,-999999., 1. , 1, + 1, 'QI21', 0. , 9. ,-999999.,-999999., 1. , 1, + 3, ' HDG', 0. , 360. ,-999999.,-999999., 1. , 1, + 3, ' COG', 0. , 360. ,-999999.,-999999., 1. , 1, + 2, ' SOG', 0. , 99. ,-999999.,-999999., 1. , 1, + 2, ' SLL', 0. , 99. ,-999999.,-999999., 1. , 1, + 3, 'SLHH', -99. , 99. ,-999999.,-999999., 1. , 1, + 3, ' RWD', 1. , 362. ,-999999.,-999999., 1. , 1, + 3, ' RWS', 0.0 , 99.9 ,-999999.,-999999., 0.1 , 1, + 2, 'ATTI', 3. , 3. ,-999999.,-999999., 1. , 1, + 2, 'ATTL', 66. , 66. ,-999999.,-999999., 1. , 1, + 4, 'CCCC', 65. , 90. ,-999999.,-999999.,-999999., 3, + 6, 'BUID', 48. , 57. , 65. , 90. ,-999999., 3, + 5, ' BMP', 870.0 , 1074.6 ,-999999.,-999999., 0.1 , 1, + 4, 'BSWU', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 4, ' SWU', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 4, 'BSWV', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 4, ' SWV', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=163,180)/ + 4, 'BSAT', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 3, 'BSRH', 0. , 100. ,-999999.,-999999., 1. , 1, + 3, ' SRH', 0. , 100. ,-999999.,-999999., 1. , 1, + 1, ' SIX', 2. , 3. ,-999999.,-999999., 1. , 1, + 4, 'BSST', -99.9 , 99.9 ,-999999.,-999999., 0.1 , 1, + 1, ' MST', 0. , 9. ,-999999.,-999999., 1. , 1, + 3, ' MSH', 0. , 999. ,-999999.,-999999., 1. , 1, + 4, ' BY', 0. , 9999. ,-999999.,-999999., 1. , 1, + 2, ' BM', 1. , 12. ,-999999.,-999999., 1. , 1, + 2, ' BD', 1. , 31. ,-999999.,-999999., 1. , 1, + 2, ' BH', 0. , 23. ,-999999.,-999999., 1. , 1, + 2, ' BFL', 0. , 99. ,-999999.,-999999., 1. , 1, + 2, 'ATTI', 4. , 4. ,-999999.,-999999., 1. , 1, + 2, 'ATTL', 57. , 57. ,-999999.,-999999., 1. , 1, + 2, ' C1M', 65. , 90. ,-999999.,-999999.,-999999., 3, + 2, ' OPM', 0. , 99. ,-999999.,-999999., 1. , 1, + 2, ' KOV', 32. , 126. ,-999999.,-999999.,-999999., 3, + 2, ' COR', 65. , 90. ,-999999.,-999999.,-999999., 3/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=181,198)/ + 3, ' TOB', 32. , 126. ,-999999.,-999999.,-999999., 3, + 3, ' TOT', 32. , 126. ,-999999.,-999999.,-999999., 3, + 2, ' EOT', 32. , 126. ,-999999.,-999999.,-999999., 3, + 2, ' LOT', 32. , 126. ,-999999.,-999999.,-999999., 3, + 1, ' TOH', 32. , 126. ,-999999.,-999999.,-999999., 3, + 2, ' EOH', 32. , 126. ,-999999.,-999999.,-999999., 3, + 3, ' SIM', 32. , 126. ,-999999.,-999999.,-999999., 3, + 3, ' LOV', 0. , 999. ,-999999.,-999999., 1. , 1, + 2, ' DOS', 0. , 99. ,-999999.,-999999., 1. , 1, + 3, ' HOP', 0. , 999. ,-999999.,-999999., 1. , 1, + 3, ' HOT', 0. , 999. ,-999999.,-999999., 1. , 1, + 3, ' HOB', 0. , 999. ,-999999.,-999999., 1. , 1, + 3, ' HOA', 0. , 999. ,-999999.,-999999., 1. , 1, + 5, ' SMF', 0. ,99999. ,-999999.,-999999., 1. , 1, + 5, ' SME', 0. ,99999. ,-999999.,-999999., 1. , 1, + 2, ' SMV', 0. , 99. ,-999999.,-999999., 1. , 1, + 2, 'ATTI', 99. , 99. ,-999999.,-999999., 1. , 1, + 2, 'ATTL', 0. , 0. ,-999999.,-999999., 1. , 1/ DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I) +,FUNITS(I),ITYPE(I),I=199,200)/ + 1, 'ATTE',-999999.,-999999.,-999999.,-999999., 1. , 1, +1024, 'SUPD', 32. , 126. ,-999999.,-999999.,-999999., 3/ DATA RPTID/' 0'/ END EOR rm a.out f77 p.f lmrlib.o #date ./a.out