cat > p.f <<\EOR C=============================================================================C C International Comprehensive Ocean-Atmosphere Data Set (ICOADS) 29 Jun 2005 C C Filename:level: rdimma0:01H Fortran 77 program+shell C C Purpose: Read and print/write IMMA Author: S.Lubker C C=============================================================================C C Software Revision Information (previous version: 18 May 2005, level 01G): C PROGID properly updated, and revisions of comments about writing IMMA. 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 always present. In C either case, it can be determined whether an attm was originally present in C the input data from ATTI and ATTL: these are printed by {prnrpt} if the attm C was extant, or blank if it was missing. ATTC will always reflect the number C of attms originally present (e.g., regardless how many are omitted from C 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 (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 (g) With more extensive modifications, {rdimma0} can be adapted to write C IMMA data, using non-IMMA data as input. In this case it is important to C note that a maintenance issue will arise as updates are made to {rdimma0}. C Therefore, we recommend that code added for this purpose be isolated (e.g., C into separate routines) as much as possible. To adapt {rdimma0}, the READ C statement should be replaced by statements to read non-IMMA data, and C {getrpt} deactivated. Prior to reading the non-IMMA data, {init} should C 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 (for numeric fields) or into CTRUE (for character fields), C {putrpt} called, and the WRITE statement activated. For writing character C fields into IMMA, {minmax} (see feature (e)), must also be called to signal C to the program when character data are present in CTRUE. This also ensures C that any data (numeric or character) not compliant with the format are not C output (we also recommend that the other parts of feature (e), {savsum} and C {prnsum}, be called). As discussed in Data Representation note (2) below, C base36 data (ITYPE=3) need to be stored in FTRUE as the corresponding numeric C value (e.g., 9=9.0, A=10.0). Data of ITYPE=3 must be stored left-justified C in CTRUE (see {bdimma} for field types and constraints). 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.01H'/ 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/ real dwpt 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)=714. ftrue(sid)=63. C C READ REPORT 100 CONTINUE c----------------------------------------------------------------------- c Identifier = WMO Buoy number c Odate = Observation date (yyyymmdd) c Otime = Observation time (hhmm) c Lat = Latitude (positive North) c Lon = Longitude (positive West) c QC_POS = Quality control flag for position** c PDT = Position date ( yyyymmdd) c PTM = Position time (hhmm) c Drogue = Drogue depth (m) c SST = Sea surface temperature (degrees C) c QC_SST = Quality control flag for SST** c Airtemp = Air temperature (degrees C) c QC_AirT = Quality control flag for Air temp** c Pressure = Air Pressure at sea level (hecto Pascals) c QC_Pr = Quality control flag for pressure** c WSp = Wind speed (m/s) c QC_Wsp = Quality control flag for Wind Speed** c WDir = Wind direction relative to true North (degrees) c QC_WD = Quality control flag for Wind direction** c RelHum = Relative humidity (%) c QC_RH = Quality control flag for relative humidity** c c **Quality Control flags: c 0=not checked 1=good 3=doubtful 4=bad c c Notes about Drogue Depth: c 9999.9 indicates that the drogue is detached c A blank value usually means that the buoy was not drogued c c c Identifier,Odate,OTime,Lat,Lon,QC_POS,PDT,PTM,Drogue,SST,QC_SST,Airtemp,QC_AirT,Pressure,QC_Pr,WSp,QC_WS,WDir,QC_WD,RelHum,QC_RH c----------------------------------------------------------------------- READ(*,'(A123)',END=900)ctrue(supd) read(ctrue(supd),'(2a5,2a2,a5,a10,a12,9x,5x,8x,6a10)') + ctrue(id)(:5),ctrue(yr)(:5),ctrue(mo)(:2),ctrue(dy)(:2) +,ctrue(hr)(:5),ctrue(lat)(:10),ctrue(lon)(:12),ctrue(sst)(:10) +,ctrue(at)(:10),ctrue(slp)(:10),ctrue(w)(:10),ctrue(d)(:10) +,ctrue(dpt)(:10) read(ctrue(id) ,'( f5.0)',iostat=ios)ftrue(id) read(ctrue(yr) ,'(1x,f4.0)',iostat=ios)ftrue(yr) read(ctrue(mo) ,'( f2.0)',iostat=ios)ftrue(mo) read(ctrue(dy) ,'( f2.0)',iostat=ios)ftrue(dy) read(ctrue(hr) ,'(1x,f4.0)',iostat=ios)ftrue(hr) read(ctrue(lat),'(1x,f9.4)',iostat=ios)ftrue(lat) read(ctrue(lon),'(1x,f9.4)',iostat=ios)ftrue(lon) read(ctrue(sst),'(1x,f7.2)',iostat=ios)ftrue(sst) read(ctrue(at) ,'(1x,f7.2)',iostat=ios)ftrue(at) read(ctrue(slp),'(1x,f7.2)',iostat=ios)ftrue(slp) read(ctrue(w) ,'(1x,f7.2)',iostat=ios)ftrue(w) read(ctrue(d) ,'(1x,f7.2)',iostat=ios)ftrue(d) read(ctrue(dpt),'(1x,f7.2)',iostat=ios)ftrue(dpt) if (ctrue(id) ( :5 ).eq.' ') ftrue(id) =fmiss if (ctrue(yr) (2:4+1).eq.' ') ftrue(yr) =fmiss if (ctrue(mo) ( :2 ).eq.' ') ftrue(mo) =fmiss if (ctrue(dy) ( :2 ).eq.' ') ftrue(dy) =fmiss if (ctrue(hr) (2:4+1).eq.' ') ftrue(hr) =fmiss if (ctrue(lat)(2:9+1).eq.' ') ftrue(lat)=fmiss if (ctrue(lon)(2:9+1).eq.' ') ftrue(lon)=fmiss if (ctrue(sst)(2:7+1).eq.' ') ftrue(sst)=fmiss if (ctrue(at) (2:7+1).eq.' ') ftrue(at) =fmiss if (ctrue(slp)(2:7+1).eq.' ') ftrue(slp)=fmiss if (ctrue(w) (2:7+1).eq.' ') ftrue(w) =fmiss if (ctrue(d) (2:7+1).eq.' ') ftrue(d) =fmiss if (ctrue(dpt)(2:7+1).eq.' ') ftrue(dpt)=fmiss if (index('34',ctrue(lon)(12:12)).ne.0) goto 100 if (index('34',ctrue(sst)(10:10)).ne.0) ftrue(sst)=fmiss if (index('34',ctrue(at) (10:10)).ne.0) ftrue(at) =fmiss if (index('34',ctrue(slp)(10:10)).ne.0) ftrue(slp)=fmiss if (index('34',ctrue(w) (10:10)).ne.0) ftrue(w) =fmiss if (index('34',ctrue(d) (10:10)).ne.0) ftrue(d) =fmiss if (index('34',ctrue(dpt)(10:10)).ne.0) ftrue(dpt)=fmiss if (ftrue(hr).ne.fmiss) then if (mod(nint(ftrue(hr)),100).ge.60) then ftrue(hr)=fmiss else ftrue(hr)=nint(ftrue(hr))/100+mod(nint(ftrue(hr)),100)/60. endif endif if (ftrue(lon).ne.fmiss) ftrue(lon)=nint(-ftrue(lon)*100.)/100. if (ftrue(d).ne.fmiss) then if (mod(nint(ftrue(d)*100.),1000).ne.0) then ftrue(d)=fmiss else if (nint(ftrue(d)).eq.0) then ftrue(d)=361. endif endif if (ftrue(dpt).ne.fmiss) then if (ftrue(at).eq.fmiss) then ftrue(dpt)=fmiss else ftrue(dpt)=dwpt(ftrue(at),ftrue(dpt)) endif endif 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) 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) ctrue(ti)(:1)=' ' ctrue(li)(:1)=' ' ctrue(di)(:1)=' ' ctrue(wi)(:1)=' ' ctrue(it)(:1)=' ' ftrue(ti)=ftrue(hr) ftrue(li)=max(ftrue(lat),ftrue(lon)) ftrue(di)=ftrue(d) ftrue(wi)=ftrue(w) ftrue(it)=max(ftrue(sst),ftrue(at),ftrue(dpt)) if (ftrue(ti).ne.fmiss) ftrue(ti)=2. if (ftrue(li).ne.fmiss) ftrue(li)=5. if (ftrue(di).ne.fmiss) ftrue(di)=0. if (ftrue(wi).ne.fmiss) ftrue(wi)=8. if (ftrue(it).ne.fmiss) ftrue(it)=3. 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----------------------------------------------------------------------- FUNCTION DWPT(T,RH) C INCLUDE 'LIB_DEV:[GUDOC]EDFVAXBOX.FOR/LIST' C Baker, Schlatter 17-MAY-1982 Original version. C THIS FUNCTION RETURNS THE DEW POINT (CELSIUS) GIVEN THE TEMPERATURE C (CELSIUS) AND RELATIVE HUMIDITY (%). THE FORMULA IS USED IN THE C PROCESSING OF U.S. RAWINSONDE DATA AND IS REFERENCED IN PARRY, H. C DEAN, 1969: "THE SEMIAUTOMATIC COMPUTATION OF RAWINSONDES," C TECHNICAL MEMORANDUM WBTM EDL 10, U.S. DEPARTMENT OF COMMERCE, C ENVIRONMENTAL SCIENCE SERVICES ADMINISTRATION, WEATHER BUREAU, C OFFICE OF SYSTEMS DEVELOPMENT, EQUIPMENT DEVELOPMENT LABORATORY, C SILVER SPRING, MD (OCTOBER), PAGE 9 AND PAGE II-4, LINE 460. X = 1.-0.01*RH C COMPUTE DEW POINT DEPRESSION. DPD =(14.55+0.114*T)*X+((2.5+0.007*T)*X)**3+(15.9+0.117*T)*X**14 DWPT = T-DPD RETURN 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=100000) 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 #date ./a.out