cat > p.f90 <<\EOR !=============================================================================! ! International Comprehensive Ocean-Atmosphere Data Set (ICOADS) 29 Oct 2007 ! ! Filename:level: rdimma0:01M Fortran 90/77 program+shell ! ! Purpose: Read and print/write IMMA Author: S.Lubker ! !=============================================================================! ! Software Revision Information (previous version: 24 May 2007, level 01L): ! PT maximum of 15 replaced by 21. !-----------------------------------------------------------------------3456789 ! Software documentation for the (modifiable) example program {rdimma} and for ! the (invariant) user-interface routines {prnskp,prnhdr,getrpt,east,init, ! minmax,savsum,putrpt,prnrpt,prnsum}. ! ! As provided {rdimma}: (a) Prints PROGID (the program name and level). Also, ! {prnhdr} prints a 4-line header for the unabbreviated record type (i.e., core ! plus all currently defined attms: 1-4 and 99). (b) Reads a report (from ! standard input) via a formatted read and calls {getrpt} to extract the fields ! and convert them from characters to numeric values. This makes the fields ! available in three parallel arrays: ! CTRUE: characters (each length 1024) blank for missing data ! ITRUE: integers NINT(FMISS) for missing data ! FTRUE: true (floating point) values FMISS for missing data ! Additional parallel arrays available within common block IMMA0 provide ! metadata defining the properties of currently defined fields. These include ! each field's length (ILEN), abbreviation (ABBR), allowable range(s), units ! (FUNITS; missing for character data) and type (ITYPE; 1=numeric, 2=base36, ! 3=character) (see {bdimma} for details). (c) For the core and attms, a ! PARAMETER statement relates each field abbreviation to an FTRUE (CTRUE, ! ITRUE, etc.) array location; this facilitates usage such as FDY = FTRUE(DY), ! to obtain the floating point value for day. Each element of CTRUE is a ! 1024-character string, but the field length can be used to control printing, ! e.g., PRINT *,CTRUE(DY)(:ILEN(DY)). (d) Prints the original report, RPT, ! under the aforementioned field headings (constructed using ABBR). (e) The ! program iterates (to step b) reading and printing reports until end-of-file ! (EOF) is encountered. Caution: IMPLICIT INTEGER(A-E,G-Z) is used; users may ! need to explicitly type additional variables when modifying this program. ! ! The following optional features are initially deactivated in the Fortran ! code; they may be activated by changing the appropriate Fortran comment ! lines to executable statements, i.e., remove the "!" from column 1: ! ! (a) Activate one or more calls to {prnskp} to suppress printing of the core ! and/or selected attms; {prnskp} is designed to work with the default calls ! to {prnhdr} and {prnrpt} for a reduced-width printout. Or (b): Deactivate ! the default calls to {prnhdr} and {prnrpt}, and activate one (or more) of ! the alternative calls to {prnhdr} and {prnrpt}. This provides flexibility ! so that the core or an attm can be printed individually (if only one pair ! of {prnhdr,prnrpt} is activated; alternatively, this can be accomplished by ! activating all but one call to {prnskp}). Activating multiple alternative ! calls to {prnhdr} and {prnrpt} can be used to arrange the core and attms ! vertically (i.e., core and attms on multiple lines, for a single report). ! Moreover, any contiguous portion of the headers and reports can be printed ! by adjusting the fields that appear in the subroutine calls, e.g., activating ! CALL PRNHDR(STDOUT,ILEN,ABBR,YR,HR) and CALL PRNRPT(STDOUT,ILEN,CTRUE,YR,HR) ! prints just year, month, day, and hour. Features (a) and (b) provide ! flexibility to print selected portions of the data; however, note that those ! two features were not designed to be used together (e.g., activating {prnskp} ! to skip the core, and {prnhdr,prnrpt} to print the core, will produce blank ! lines). By default printing is to standard output (STDOUT=6), but optionally ! STDOUT can be changed to another unit number in the calls to {prnhdr,prnrpt}. ! ! Additional notes on using {prnrpt}: To minimize data volume, IMMA data may ! have a "sparse" record structure, such that attms without any extant data are ! omitted, and the attm structure can vary from report to report. Sparse data ! printed via the default calls to {prnhdr, prnrpt}, are expanded out into the ! complete IMMA structure. Or, using {prnskp}, sparse reports are expanded out ! into a reduced print structure. Alternatively, IMMA data may have a "fixed" ! record structure, such that a fixed number of attms is always present. In ! either case, it can be determined whether an attm was originally present in ! the input data from ATTI and ATTL: these are printed by {prnrpt} if the attm ! was extant, or blank if it was missing. ATTC will always reflect the number ! of attms originally present (e.g., regardless how many are omitted from ! printing through the use of {prnskp}). ! ! (c) Activating {east} will transform longitudes stored according to the NCDC ! convention -179.99 (W) to 180.00 (E), into the ICOADS convention 0-359.99 E. ! This action is applied only to the numeric data (ITRUE, FTRUE), and does not ! take effect on the printed data, unless feature (d) is also activated. ! ! (d) Activating {putrpt} will convert all the true values (e.g., longitudes ! transformed via {east}) back into characters for printing and/or writing. ! Specifically, if changes have been made to FTRUE, {putrpt} puts them also ! into ITRUE, CTRUE, and RPT. Then the changes can be printed, by leaving ! {prnrpt} statement(s) in operation, or written, by activating (instead of ! {prnrpt}) the adjacent WRITE statement. If both {prnrpt} and the WRITE ! statement are activated, each report will be output twice, possibly with ! differences in format (which provides a means to see how the two different ! output methods work). For example, note that {prnskp} has no effect on the ! WRITE statement, in contrast to its effect on {prnrpt}. Reports with a ! sparse record structure will be output when {putrpt} and the WRITE statement ! are used, and ATTC will reflect the output attm count. Reports with a fixed ! record structure can be correctly output when {prnrpt} is used, with these ! caveats: (1) ATTI and ATTL must be set, when the attm data are entirely ! missing, or they will be printed blank; (2) ATTC will be set incorrectly if ! {prnskp} is used, but any of the attm data are extant. ! ! (e) Activate calls: to {minmax}, to set any "extreme" true values to error ! value FERR (by default equal to the missing value FMISS); to {savsum}, to ! save summary information for each field; and to {prnsum}, to print the ! following summary information on unit 10 (using field abbreviations, ABBR): ! -- A summary of the numbers (and percentages) of each field that are ! extant, missing, or erroneous. Erroneous data are also counted ! as a subset of the missing category. Any field (or attm) entirely ! missing in the input data is omitted from the summary. ! -- A summary of any erroneous fields encountered in the input data, ! with each unique pattern and its frequency listed. ! ! (f) The test for NREC greater than or equal to 50 can be activated to stop ! before reading/printing the entire file. Regarding feature (e), note that ! the {prnsum} summary will only be output if statement 900 is reached. ! ! (g) With more extensive modifications, {rdimma0} can be adapted to write ! IMMA data, using non-IMMA data as input. In this case it is important to ! note that a maintenance issue will arise as updates are made to {rdimma0}. ! Therefore, we recommend that code added for this purpose be isolated (e.g., ! into separate routines) as much as possible. To adapt {rdimma0}, the READ ! statement should be replaced by statements to read non-IMMA data, and ! {getrpt} deactivated. Prior to reading the non-IMMA data, {init} should ! be called to properly initialize the data structures: ! CALL INIT(CTRUE,ITRUE,FTRUE,FMISS,ILEN,NUM) ! Then the input data need to be transformed into the appropriate IMMA units, ! loaded into FTRUE (for numeric fields) or into CTRUE (for character fields), ! {putrpt} called, and the WRITE statement activated. For writing character ! fields into IMMA, {minmax} (see feature (e)), must also be called to signal ! to the program when character data are present in CTRUE. This also ensures ! that any data (numeric or character) not compliant with the format are not ! output (we also recommend that the other parts of feature (e), {savsum} and ! {prnsum}, be called). As discussed in Data Representation note (2) below, ! base36 data (ITYPE=3) need to be stored in FTRUE as the corresponding numeric ! value (e.g., 9=9.0, A=10.0). Data of ITYPE=3 must be stored left-justified ! in CTRUE (see {bdimma} for field types and constraints). ! ! Data representation notes: ! (1) Printed data: In the header, the field abbreviations (from ABBR) are ! listed vertically. The abbreviations are 1-4 characters in length, so ! the header always occupies four lines (even if a selected subset of ! fields includes no 4-character abbreviations). All decimal points are ! omitted for printing (i.e., each FTRUE value is divided by its FUNITS; ! e.g., LON=33.80/0.01 = 3380 printed). Missing data (FTRUE=FMISS) are ! printed as blank, as are erroneous data, unless the default for FERR is ! changed (see note 3). ! (2) Stored data (FTRUE, ITRUE, and CTRUE): Some 1-character fields (i.e., ! those with ITYPE=2) have alphabetic base36 values defined (and printed) ! as part of the legal range. In ITRUE and FTRUE, these are stored as ! the corresponding numeric values: A=10, B=11, ..., Z=35. For character ! (ITYPE=3) fields, note that ITRUE and FTRUE contain the ICHAR of the ! first character of the field (e.g., if ID=WHRN, ITRUE(ID)=87). This ! simplifies the implementation of the program, but users should be aware ! of the data type in processing character fields. ! (3) Erroneous data: Erroneous data can be detected in two ways: (i) Data ! that could not be read properly (e.g., a numeric field containing a ! special character). (ii) "Extreme" data, which read properly, but failed ! to adhere to the ranges defined in {bdimma} (e.g., a numeric temperature ! outside of -99.9 to 99.9). Data of the first type are always set to ! FERR, but data of the second type are only set to FERR if {minmax} is ! called. FERR equals FMISS by default. If FERR is set to a non-default ! value such as -888888., the printed output will contain all asterisks in ! fields that contained erroneous data. The non-default setting is also ! used for quality control applications that need to distinguish between ! actual missing data and data that were extant but erroneous. ! ! Performance: The long character strings made necessary by the supplemental ! attm slow the program down. Anyone not interested in those data could ! replace: ! CHARACTER*1024 RPT,CTRUE ! with ! CHARACTER RPT*378,CTRUE*16 ! and ! CALL GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR & ! &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) ! with ! CALL GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR & ! &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM-1) ! ! Machine/language dependencies: None known. Non-ANSI features: common block ! containing both character and non-character variables, and specification ! statements after data statements. ! The program conforms to Fortran 90 source code conventions for comments and ! continuation lines, but still compiles without change in many Fortran 77 ! environments. Added/included source code can be either free form or fixed. ! For more information: See and (electronic documents). !-----------------------------------------------------------------------3456789 PROGRAM RDIMMA IMPLICIT INTEGER(A-E,G-Z) INTEGER FNC,FM ! CHARACTER*10 PROGID DATA PROGID/'RDIMMA.01M'/ ! ! 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) ! ! 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) ! ! 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) ! ! 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) ! ! 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) ! ! HISTORICAL ATTACHMENT ! ! SUPPLEMENTAL DATA ATTACHMENT PARAMETER(ATTI99=197,ATTL99=198,ATTE=199,SUPD=200) ! 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 ! 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/,STDOUT/6/ ! ! PRINT PROGRAM HEADER !! WRITE(STDOUT,*)PROGID ! DO NOT PRINT CORE HEADER OR CORE ! CALL PRNSKP(YR,SH) ! DO NOT PRINT ATTACHMENT HEADER OR ATTACHMENT ! CALL PRNSKP(ATTI1,QCZ) ! CALL PRNSKP(ATTI2,RWS) ! CALL PRNSKP(ATTI3,BFL) ! CALL PRNSKP(ATTI4,SMV) ! CALL PRNSKP(ATTI99,SUPD) ! ! PRINT REPORT HEADER !! CALL PRNHDR(STDOUT,ILEN,ABBR,YR,SUPD) ! PRINT CORE HEADER ! CALL PRNHDR(STDOUT,ILEN,ABBR,YR,SH) ! PRINT ATTACHMENT HEADER ! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI1,QCZ) ! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI2,RWS) ! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI3,BFL) ! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI4,SMV) ! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI99,SUPD) ! INITIALIZE NUMBER OF REPORTS READ NREC=0 ! ! READ REPORT 100 CONTINUE READ(*,*,END=900)ctrue(supd)(1:4),ctrue(supd)(6:7) & ,ctrue(supd)(9:10),ctrue(supd)(12:13),ctrue(supd)(15:16) & ,ctrue(supd)(18:20),ctrue(supd)(22:27),ctrue(supd)(29:34) & ,ctrue(supd)(36:42),ctrue(supd)(44:46),ctrue(supd)(48:49) & ,ctrue(supd)(51:59),ctrue(supd)(61:68),ctrue(supd)(70:73) & ,ctrue(supd)(74:75),ctrue(supd)(76:77),ctrue(supd)(79:82) & ,ctrue(supd)(83:84),ctrue(supd)(85:86),ctrue(supd)(88:93) & ,ctrue(supd)(95:102),ctrue(supd)(104:104),ctrue(supd)(106:135) & ,ctrue(supd)(137:137),ctrue(supd)(139:168),ctrue(supd)(170:170) & ,ctrue(supd)(172:201),ctrue(supd)(203:232) ctrue(supd)(44:46)='999' ! INCREMENT NUMBER OF REPORTS READ NREC=NREC+1 ! ! CONVERT CHARACTERS TO FLOATING POINT VALUES ctrue(yr)(:16)=ctrue(supd)(1:4) ctrue(mo)(:16)=ctrue(supd)(6:7) ctrue(dy)(:16)=ctrue(supd)(9:10) ctrue(hr)(:16)=ctrue(supd)(12:13)//ctrue(supd)(15:16) ctrue(lat)(:16)=ctrue(supd)(22:24)//ctrue(supd)(26:27) ctrue(lon)(:16)=' '//ctrue(supd)(29:31)//ctrue(supd)(33:34) ctrue(slp)(:16)=ctrue(supd)(36:39)//ctrue(supd)(41:42) ctrue(a)(:16)=ctrue(supd)(42:42) ctrue(id)(:16)=ctrue(supd)(203:232) ctrue(im)=' 0' ctrue(atti99)='99' ctrue(attl99)=' 0' write(rpt,110)(ctrue(i),i=1,atti1-1),(ctrue(i),i=atti99,supd) 110 format(a4,2a2,a4,a5,a6,a2,5a1,2a2,a9,a2,a1,a3,a1,a3,a1,2a2 & ,a1,a5,a1,a3,a1,a4,a1,a4,a1,a4,a2,a4,7a1,6a2,2a2,a1,a232) CALL GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR & &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) ftrue(ii)=10. ftrue(dck)=736. ftrue(sid)=129. ftrue(pt)=5. if (nint(ftrue(hr)*100.)/100 .lt.1 .or. & nint(ftrue(hr)*100.)/100 .gt.24 .or. & mod(nint(ftrue(hr)*100.),100).lt.0 .or. & mod(nint(ftrue(hr)*100.),100).gt.59 .and. & mod(nint(ftrue(hr)*100.),100).ne.99) ftrue(hr)=fmiss if (ftrue(hr).ne.fmiss) then if (ctrue(hr)(3:4).eq.'99') then ftrue(hr)=nint(ftrue(hr)*100.)/100 ftrue(ti)=0. else ftrue(hr)=nint(ftrue(hr)*100.)/100 & + mod(nint(ftrue(hr)*100.),100)/60. ftrue(ti)=2. endif endif if (nint(ftrue(lat)*100.).lt.-9000 .or. & nint(ftrue(lat)*100.).gt. 9000 .and. & nint(ftrue(lat)*100.).ne.99999) ftrue(lat)=fmiss if (nint(ftrue(lon)*100.).lt.0 .or. & nint(ftrue(lon)*100.).gt.35999 .and. & nint(ftrue(lon)*100.).ne.99999) ftrue(lon)=fmiss if (ftrue(lat).ne.fmiss .and. ftrue(lon).ne.fmiss) then if (ctrue(lat)(1:5).eq.'99999' .or. & ctrue(lon)(2:6).eq.'99999') then ftrue(li)=3. else ftrue(li)=4. endif endif if (ftrue(slp).ne.fmiss .and. ftrue(a).ne.fmiss) then ftrue(slp)=ftrue(slp)+ftrue(a)/100. else ftrue(slp)=fmiss endif ctrue(a)(:16)=' ' ftrue(a)=fmiss ! ! CONVERT LONGITUDE TO DEGREES EAST CALL EAST(ITRUE(LON),FTRUE(LON),FERR) read(9,*)i99,i999,fy,fx,year,month,day,hour if (nint(ftrue(yr)).ne.year .or. & nint(ftrue(mo)).ne.month .or. & nint(ftrue(dy)).ne.day .or. & nint(ftrue(hr)*100.)/100.ne.hour) stop 'read(9,...' ftrue(lat)=fy ftrue(lon)=fx jdy=ixdtnd(nint(ftrue(dy)),nint(ftrue(mo)),nint(ftrue(yr))) if (jdy.lt.0 .or. ftrue(hr).eq.fmiss .or. ftrue(lon).eq.fmiss) then ftrue(hr)=fmiss else jdy=jdy+nint(ftrue(hr)*100.)/2400 ftrue(hr)=mod(ftrue(hr),24.) if (ctrue(supd)(:42).eq.'1930 01 30 18 99 180 -67.41 180.09 0999.32' .or. & ctrue(supd)(:42).eq.'1933 12 14 20 99 180 999.99 999.99 1009.48' .or. & ctrue(supd)(:42).eq.'1933 12 14 24 99 180 999.99 999.99 1006.44' .or. & ctrue(supd)(:42).eq.'1934 01 28 20 99 180 -69.72 180.05 0997.63' .or. & ctrue(supd)(:42).eq.'1934 01 28 24 99 180 -70.25 180.75 0997.97') then jdy=jdy-1 else & if (ctrue(supd)(:42).eq.'1929 01 25 12 99 180 -74.00 180.00 0987.81' .or. & ctrue(supd)(:42).eq.'1929 02 04 24 99 180 999.99 999.99 0997.97' .or. & ctrue(supd)(:42).eq.'1934 02 28 12 99 180 -74.10 179.75 0979.68' .or. & ctrue(supd)(:42).eq.'1934 02 28 16 99 180 -73.55 179.63 0981.04' .or. & ctrue(supd)(:42).eq.'1934 02 28 20 99 180 -73.05 179.53 0984.42' .or. & ctrue(supd)(:42).eq.'1934 02 28 24 99 180 -72.52 179.48 0986.46') then jdy=jdy+1 endif call rxltut(nint(ftrue(hr)*100.),jdy,nint(ftrue(lon)*100.),hour,udy) call rxnddt(udy,day,month,year) ftrue(yr)=year ftrue(mo)=month ftrue(dy)=day ftrue(hr)=hour/100. endif ! SET EXTREME FLOATING POINT VALUES TO ERROR VALUE CALL MINMAX(CTRUE,ITRUE,FTRUE,FMISS,FERR & &,ILEN,FMIN1,FMAX1,FMIN2,FMAX2,FUNITS,ITYPE,NUM) ! SAVE SUMMARY INFORMATION CALL SAVSUM(CTRUE,FTRUE,FMISS,FERR & &,ILEN,ABBR,NUM) ! ! CONVERT FLOATING POINT VALUES TO CHARACTERS CALL PUTRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR & &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) ! WRITE REPORT WRITE(STDOUT,'(A)')RPT(:LENTRM(RPT)) ! ! PRINT REPORT !! CALL PRNRPT(STDOUT,ILEN,CTRUE,YR,SUPD) ! PRINT CORE ! CALL PRNRPT(STDOUT,ILEN,CTRUE,YR,SH) ! PRINT ATTACHMENT ! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI1,QCZ) ! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI2,RWS) ! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI3,BFL) ! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI4,SMV) ! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI99,SUPD) ! ! STOP AFTER SEVERAL REPORTS HAVE BEEN READ ! IF (NREC.GE.50) STOP 'REMOVE STOP TO READ ALL REPORTS' call INIT(CTRUE,ITRUE,FTRUE,FMISS,ILEN,NUM) GOTO 100 ! ! END OF FILE 900 CONTINUE !! WRITE(STDOUT,*)'REPORTS ',NREC ! ! PRINT SUMMARY INFORMATION TO UNIT CALL PRNSUM(UNIT,PROGID,ABBR,NUM) END !=============================================================================! ! WARNING: Code beyond this point should not require any modification. ! !=============================================================================! !-----------------------------------------------------------------------3456789 SUBROUTINE INIT(CTRUE,ITRUE,FTRUE,FMISS,ILEN,NUM) ! INITIALIZE CTRUE, ITRUE, AND FTRUE IMPLICIT INTEGER(A-E,G-Z) CHARACTER*(*) CTRUE DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM),ILEN(NUM) ! DO 190 I=1,NUM IF (ILEN(I).EQ.1024) THEN CTRUE(I)(:)=' ' ELSE IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'INIT LEN CTRUE' CTRUE(I)(:ILEN(I))=' ' ENDIF ITRUE(I)=NINT(FMISS) FTRUE(I)=FMISS 190 CONTINUE END !-----------------------------------------------------------------------3456789 SUBROUTINE PRNSKP(BEG,END) ! DO NOT PRINT REPORT HEADER OR REPORT IMPLICIT INTEGER(A-E,G-Z) CHARACTER*(*) ABBR,CTRUE DIMENSION ILEN(*),ABBR(*),CTRUE(*) CHARACTER*1024 HDR,RPT EQUIVALENCE(HDR,RPT) DIMENSION SKP(1024) DATA SKP/1024*0/ SAVE SKP ! DO 190 I=BEG,END SKP(I)=1 190 CONTINUE RETURN !-----------------------------------------------------------------------3456789 ENTRY PRNHDR(STDOUT,ILEN,ABBR,BEG,END) ! PRINT REPORT HEADER ! DO 290 J=1,4 HDR=' ' PTR=0 DO 280 I=BEG,END IF (SKP(I).NE.1) THEN IF (ILEN(I).EQ.1024) THEN PTR=PTR+1 ELSE PTR=PTR+ILEN(I) ENDIF IF (PTR.GT.LEN(HDR)) STOP 'PRNHDR LEN HDR' HDR(PTR:PTR)=ABBR(I)(J:J) ENDIF 280 CONTINUE WRITE(STDOUT,'(A)')HDR(:PTR) 290 CONTINUE RETURN !-----------------------------------------------------------------------3456789 ENTRY PRNRPT(STDOUT,ILEN,CTRUE,BEG,END) ! PRINT REPORT ! RPT=' ' PTR=0 DO 390 I=BEG,END IF (SKP(I).NE.1) THEN IF (ILEN(I).EQ.1024) THEN IF (CTRUE(I)(:).EQ.' ') THEN WRITE(STDOUT,'(2A)')RPT(:PTR),' ' ELSE WRITE(STDOUT,'(2A)')RPT(:PTR),CTRUE(I)(:LENTRM(CTRUE(I))) ENDIF RETURN ENDIF IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'PRNRPT LEN CTRUE' IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'PRNRPT LEN RPT' RPT(PTR+1:PTR+ILEN(I))=CTRUE(I)(:ILEN(I)) PTR=PTR+ILEN(I) ENDIF 390 CONTINUE WRITE(STDOUT,'(A)')RPT(:PTR) END !-----------------------------------------------------------------------3456789 SUBROUTINE GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR & &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) ! 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*1024 DATA IFMT/'(BZ,I1)','(BZ,I2)','(BZ,I3)','(BZ,I4)' & &,'(BZ,I5)','(BZ,I6)','(BZ,I7)','(BZ,I8)','(BZ,I9)'/ SAVE IFMT ! PTR=0 ATTC=0 ATTI=0 TRS=0 DO 180 I=1,NUM IF (ABBR(I).EQ.'ATTI') THEN ATTI=NINT(FMIN1(I)) ATTL=NINT(FMIN1(I+1)) WRITE(STR(TRS+1:TRS+4),'(2I2)')ATTI,ATTL IF (ATTI.EQ.99) THEN IF (TRS+5.GT.LEN(STR)) STOP 'GETRPT LEN STR' IF (PTR+6.GT.LEN(RPT)) STOP 'GETRPT LEN RPT' IF (STR(TRS+1:TRS+4).NE.RPT(PTR+1:PTR+4)) THEN IF (RPT(PTR+1:).NE.' ') STOP 'GETRPT ATTI ATTL' STR(TRS+1:TRS+5)=' ' ELSE ATTC=ATTC+1 STR(TRS+1:TRS+5)=RPT(PTR+1:PTR+5) PTR=PTR+5 ENDIF IF (NUM.EQ.I+3) THEN CTRUE(NUM)(:)=RPT(PTR+1:) IF (CTRUE(NUM)(:).NE.RPT(PTR+1:)) STOP 'GETRPT LEN SUPD' ENDIF ELSE IF (TRS+ATTL.GT.LEN(STR)) STOP 'GETRPT LEN STR' IF (PTR+ATTL.GT.LEN(RPT)) STOP 'GETRPT LEN RPT' IF (STR(TRS+1:TRS+4).NE.RPT(PTR+1:PTR+4)) THEN STR(TRS+1:TRS+ATTL)=' ' ELSE ATTC=ATTC+1 STR(TRS+1:TRS+ATTL)=RPT(PTR+1:PTR+ATTL) PTR=PTR+ATTL ENDIF ENDIF ELSE IF (ATTI.EQ.0) THEN IF (TRS+ILEN(I).GT.LEN(STR)) STOP 'GETRPT LEN STR' IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'GETRPT LEN RPT' STR(TRS+1:TRS+ILEN(I))=RPT(PTR+1:PTR+ILEN(I)) PTR=PTR+ILEN(I) IF (ABBR(I).EQ.' IM') THEN IF (STR(TRS+1:TRS+ILEN(I)).NE.RPTID) STOP 'GETRPT RPTID' ENDIF ENDIF TRS=TRS+ILEN(I) 180 CONTINUE ! TRS=0 DO 190 I=1,NUM IF (ILEN(I).NE.1024) THEN IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'GETRPT LEN CTRUE' CTRUE(I)(:ILEN(I))=STR(TRS+1:TRS+ILEN(I)) TRS=TRS+ILEN(I) ENDIF ! IF (CTRUE(I)(:MIN(ILEN(I),LEN(CTRUE(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 ! IF (ITRUE(I).EQ.NINT(FMISS)) THEN FTRUE(I)=FMISS ELSE IF (ITRUE(I).EQ.NINT(FERR)) THEN FTRUE(I)=FERR ELSE IF (ITYPE(I).LE.2) THEN FTRUE(I)=ITRUE(I)*FUNITS(I) ELSE FTRUE(I)=ITRUE(I) ENDIF 190 CONTINUE RETURN !-----------------------------------------------------------------------3456789 ENTRY PUTRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR & &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) ! CONVERT FLOATING POINT VALUES TO CHARACTERS ! STR=' ' TRS=0 DO 280 I=1,NUM IF (FTRUE(I).EQ.FMISS) THEN ITRUE(I)=NINT(FMISS) ELSE IF (FTRUE(I).EQ.FERR) THEN ITRUE(I)=NINT(FERR) ELSE IF (ITYPE(I).LE.2) THEN ITRUE(I)=NINT(FTRUE(I)/FUNITS(I)) ELSE ITRUE(I)=NINT(FTRUE(I)) ENDIF ! IF (ITRUE(I).EQ.NINT(FMISS)) THEN CTRUE(I)(:MIN(ILEN(I),LEN(CTRUE(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 ! CTRUE(I)(:1)=CHAR(ITRUE(I)) ENDIF ! IF (ILEN(I).NE.1024) THEN IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'PUTRPT LEN CTRUE' STR(TRS+1:TRS+ILEN(I))=CTRUE(I)(:ILEN(I)) TRS=TRS+ILEN(I) ENDIF 280 CONTINUE ! RPT=' ' PTR=0 ATTC=0 ATTI=0 TRS=0 DO 290 I=1,NUM IF (ABBR(I).EQ.'ATTI') THEN ATTI=NINT(FMIN1(I)) ATTL=NINT(FMIN1(I+1)) WRITE(STR(TRS+1:TRS+4),'(2I2)')ATTI,ATTL IF (ATTI.EQ.99) THEN IF (TRS+5.GT.LEN(STR)) STOP 'PUTRPT LEN STR' IF (NUM.EQ.I+3) THEN IF (CTRUE(NUM)(:).NE.' ') THEN ATTC=ATTC+1 IF (PTR+6.GT.LEN(RPT)) STOP 'PUTRPT LEN RPT' RPT(PTR+1:PTR+5)=STR(TRS+1:TRS+5) PTR=PTR+5 RPT(PTR+1:)=CTRUE(NUM)(:) IF (RPT(PTR+1:).NE.CTRUE(NUM)(:)) STOP 'PUTRPT LEN SUPD' ENDIF ENDIF ELSE IF (TRS+ATTL.GT.LEN(STR)) STOP 'PUTRPT LEN STR' IF (STR(TRS+5:TRS+ATTL).NE.' ') THEN ATTC=ATTC+1 IF (PTR+ATTL.GT.LEN(RPT)) STOP 'PUTRPT LEN RPT' RPT(PTR+1:PTR+ATTL)=STR(TRS+1:TRS+ATTL) PTR=PTR+ATTL ENDIF ENDIF ELSE IF (ATTI.EQ.0) THEN IF (TRS+ILEN(I).GT.LEN(STR)) STOP 'PUTRPT LEN STR' IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'PUTRPT LEN RPT' IF (ABBR(I).EQ.' IM') THEN STR(TRS+1:TRS+ILEN(I))=RPTID ELSE IF (ABBR(I).EQ.'ATTC') THEN STR(TRS+1:TRS+ILEN(I))='%' ENDIF RPT(PTR+1:PTR+ILEN(I))=STR(TRS+1:TRS+ILEN(I)) PTR=PTR+ILEN(I) ENDIF TRS=TRS+ILEN(I) 290 CONTINUE PTR=INDEX(RPT,'%') RPT(PTR:PTR)=CHAR(ICHAR('0')+ATTC) END !-----------------------------------------------------------------------3456789 SUBROUTINE MINMAX(CTRUE,ITRUE,FTRUE,FMISS,FERR & &,ILEN,FMIN1,FMAX1,FMIN2,FMAX2,FUNITS,ITYPE,NUM) ! 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) ! DO 190 I=1,NUM IF (ITYPE(I).LE.2) THEN IF (FTRUE(I).EQ.FMISS .OR. FTRUE(I).EQ.FERR) THEN ITRUE(I)=NINT(FTRUE(I)) GOTO 190 ENDIF 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. FMIN2(I).NE.FMISS & & .AND.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 IF (ILEN(I).EQ.1024) THEN LENGTH=LEN(CTRUE(I)) ELSE IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'MINMAX LEN CTRUE' LENGTH=ILEN(I) ENDIF IF (CTRUE(I)(:LENGTH).EQ.' ') THEN FTRUE(I)=FMISS ITRUE(I)=NINT(FMISS) GOTO 190 ENDIF FTRUE(I)=ICHAR(CTRUE(I)(:1)) ITRUE(I)=NINT(FTRUE(I)) DO 180 J=1,LENGTH 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 190 CONTINUE END !-----------------------------------------------------------------------3456789 SUBROUTINE SAVSUM(CTRUE,FTRUE,FMISS,FERR & &,ILEN,ABBR,NUM) ! 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)) ! 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 (FTRUE(I).EQ.FMISS) THEN IF (ILEN(I).EQ.1024) THEN IF (CTRUE(I)(:).EQ.' ') GOTO 190 ELSE IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'SAVSUM LEN CTRUE' IF (CTRUE(I)(:ILEN(I)).EQ.' ') GOTO 190 ENDIF ENDIF SUM3(I)=SUM3(I)+1 WRITE(STR,'(I3,A6,2X,A53)')I,ABBR(I),CTRUE(I) CALL SAVSTR(STR) ENDIF 190 CONTINUE RETURN !-----------------------------------------------------------------------3456789 ENTRY PRNSUM(UNIT,PROGID,ABBR,NUM) ! PRINT SUMMARY INFORMATION TO UNIT ! 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 !-----------------------------------------------------------------------3456789 SUBROUTINE SAVSTR(STR) ! 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 ! 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 'SAVSTR INCREASE MMAX' M=M+1 ARR1(M)=STR ARR2(M)=1 RETURN !-----------------------------------------------------------------------3456789 ENTRY PRNSTR(UNIT) ! PRINT FREQUENCY OF STRING ! 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 !-----------------------------------------------------------------------3456789 INTEGER FUNCTION IB36(B36,IERR) ! CONVERT BASE36 CHARACTER TO INTEGER CHARACTER B36 INTEGER IERR CHARACTER*36 STR DATA STR/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ SAVE STR ! IB36=INDEX(STR,B36) IF (IB36.NE.0) THEN IB36=IB36-1 ELSE IB36=IERR ENDIF END !-----------------------------------------------------------------------3456789 CHARACTER FUNCTION B36(IB36,ERR) ! CONVERT INTEGER TO BASE36 CHARACTER INTEGER IB36 CHARACTER ERR CHARACTER*36 STR DATA STR/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ SAVE STR ! IF (IB36.GE.0 .AND. IB36.LE.35) THEN B36=STR(IB36+1:) ELSE B36=ERR ENDIF END !-----------------------------------------------------------------------3456789 FUNCTION LENTRM(STR) ! 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 !-----------------------------------------------------------------------3456789 SUBROUTINE EAST(ITRUE,FTRUE,FERR) ! CONVERT LONGITUDE TO DEGREES EAST IMPLICIT INTEGER(A-E,G-Z) ! 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 !-----------------------------------------------------------------------3456789 SUBROUTINE SDEG(ITRUE,FTRUE,FERR) ! CONVERT LONGITUDE TO SIGNED DEGREES EAST IMPLICIT INTEGER(A-E,G-Z) ! 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 !-----------------------------------------------------------------------3456789 SUBROUTINE ZEROS(CTRUE,ILEN,ABBR,ITYPE,NUM) ! 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)'/ SAVE IFMT ! DO 190 I=1,NUM IF (ITYPE(I).EQ.1 & & .AND. ILEN(I).NE.1 & & .AND. ABBR(I).NE.' IM' & & .AND. ABBR(I).NE.'ATTI' & & .AND. ABBR(I).NE.'ATTL') THEN IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'ZEROS LEN CTRUE' IF (CTRUE(I)(:ILEN(I)).EQ.' ') GOTO 190 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 !-----------------------------------------------------------------------3456789 BLOCK DATA BDIMMA ! COMMON BLOCK DATA STATEMENTS IMPLICIT INTEGER(A-E,G-Z) ! ! missing = -999999 ! ILEN = field length ! ABBR = field abbreviation ! FMIN1 = field range minimum (first, or only) ! FMAX1 = field range maximum (first, or only) ! FMIN2 = field range minimum (second, or missing) ! FMAX2 = field range maximum (second, or missing) ! FUNITS = field units (missing, if itype=3) ! ITYPE = 1: numeric: decimal range(s) ! 2: numeric: decimal range(s), transformed to base36 ! 3: character: decimal range(s), transformed to ascii ! RPTID = 0 (IMMA version that the program can read) ! 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 ! 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. , 21. ,-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', 1. , 1. ,-999999.,-999999., 1. , 1, & &1024, 'SUPD', 32. , 126. ,-999999.,-999999.,-999999., 3/ DATA RPTID/' 0'/ END EOR rm a.out f90 p.f90 lmrlib.o #date grep -h '^..,180,' E?.csv J.csv B?.csv > fort.9 sed -e 's/,/","/g' -e 's/.*/"&"/' /nas/slubker/byrd/EleanorBolling?.csv /nas/slubker/byrd/JacobRuppert.csv /nas/slubker/byrd/Bear?.csv | ./a.out > /nas/slubker/byrd/BYRD