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*(134+105) DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM) DATA CTRUE/NUM*' '/,ITRUE/NUM*-999999/,FTRUE/NUM*-999999./ & &,FMISS/-999999./,FERR/-999999./,UNIT/10/,STDOUT/7/ ! character hd*134,fn*10 data nhd/0/ ! ! 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(1,'(a7)')fn open(2,file='input2/'//fn) open(unit,file='output/summary/'//fn) ! ! READ REPORT 100 CONTINUE READ(*,'(i3,A)',END=900)lgth,RPT if (lgth.eq.134) then hd=rpt nhd=nhd+1 write(fn(8:),'(''-'',i2.2)')nhd open(stdout,file='output/'//fn) goto 100 else if (lgth.ne.105) then stop 'stop' endif ctrue(supd)=hd//rpt ! INCREMENT NUMBER OF REPORTS READ NREC=NREC+1 ctrue(id)(:16)=hd(5:28) if (index(ctrue(id)(:16),'NEBURG').ne.0) then ctrue(id)(:16)='LUNEBURG' else if (index(ctrue(id)(:16),'CK AUF').ne.0) then ctrue(id)(:16)='GLUCK AUF' else if (index(ctrue(id)(:16),'TTINGEN').ne.0) then ctrue(id)(:16)='GOTTINGEN' else if (index(ctrue(id)(:16),'F.E. SCH').ne.0) then ctrue(id)(:16)='F.E. SCHUTT' endif !! ctrue()(:16)=rpt(1:4) !! ctrue()(:16)=rpt(5:7) !! ctrue()(:16)=rpt(8:10) ctrue(yr)(:16)=rpt(11:14) ctrue(mo)(:16)=rpt(15:16) ctrue(dy)(:16)=rpt(17:18) ctrue(hr)(:16)=rpt(19:20)//' '//rpt(21:21) !! ctrue()(:16)=rpt(22:22) ctrue(lat)(:16)=' '//rpt(23:27) ctrue(lon)(:16)=' '//rpt(28:33) !! ctrue()(:16)=rpt(34:40) !! ctrue()(:16)=rpt(41:44) !! ctrue()(:16)= ctrue(slp)(:16)=' '//rpt(46:49)//rpt(45:45)//rpt(50:50) !! ctrue()(:16)= ctrue(wbt)(:16)=' '//rpt(51:53)//rpt(50:50) ctrue(dpt)(:16)=' '//rpt(51:53)//rpt(50:50) !! ctrue()(:16)= ctrue(at)(:16)=' '//rpt(55:57)//rpt(54:54) !! ctrue()(:16)= ctrue(sst)(:16)=' '//rpt(59:61)//rpt(58:58) !! ctrue()(:16)=rpt(62:63) !! ctrue()(:16)=rpt(64:70) ctrue(n)(:16)=rpt(72:72)//rpt(71:71) !! ctrue()(:16)=rpt(73:74) !! ctrue()(:16)=rpt(75:76) !! ctrue()(:16)=rpt(77:78) !! ctrue()(:16)=rpt(79:80) !! ctrue()(:16)= !! ctrue()(:16)= ctrue(d)(:16)=rpt(87:93) ctrue(w)(:16)=rpt(94:95)//' '//rpt(96:98) !! ctrue()(:16)= !! ctrue()(:16)=rpt(99:99) !! ctrue()(:16)=rpt(100:105) ctrue(im)(:16)=' 0' ctrue(atti99)(:16)='99' ctrue(attl99)(:16)=' 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,a) read(2,'(a,i9)')rpt(:34),nseq if (nseq.ne.nrec) stop 'nseq' if (rpt(1:4).eq.'9999') rpt(1:4)=' ' if (rpt(5:6).eq.'99') rpt(5:6)=' ' if (rpt(7:8).eq.'99') rpt(7:8)=' ' if (rpt(9:10).eq.'99') rpt(9:12)=' ' if (rpt(13:17).eq.'99999') rpt(13:17)=' ' if (rpt(18:23).eq.'999999') rpt(18:23)=' ' if (rpt(28:28).eq.'9') rpt(28:28)=' ' ! ! CONVERT CHARACTERS TO FLOATING POINT VALUES CALL GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR & &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM) goto 200 ! if (ftrue(hr).ne.fmiss) then select case (ctrue(hr)(5:5)) case ('A') if (itrue(hr).eq.1200) then ftrue(hr)=ftrue(hr)-12. else if (itrue(hr).lt.0 .or. itrue(hr).gt.1100) then ftrue(hr)=fmiss endif case ('P') if (itrue(hr).ge.100 .and. itrue(hr).le.1100) then ftrue(hr)=ftrue(hr)+12. else if (itrue(hr).lt.1200 .or. itrue(hr).gt.2300) then ftrue(hr)=fmiss endif end select endif ! if (ftrue(lat).ne.fmiss) then if (itrue(lat).eq.0) then else if (itrue(lat).ge.0 .and. itrue(lat).le.9060 .and. & mod(itrue(lat),100).ge.0 .and. mod(itrue(lat),100).le.60) then !! ftrue(lat)=itrue(lat)/100+mod(itrue(lat),100)/60. select case (ctrue(lat)(6:6)) case ('N') case ('S') ftrue(lat)=-ftrue(lat) end select else ftrue(lat)=fmiss endif endif ! if (ftrue(lon).ne.fmiss) then if (itrue(lon).eq.0) then else if (itrue(lon).ge.0 .and. itrue(lon).le.18060 .and. & mod(itrue(lon),100).ge.0 .and. mod(itrue(lon),100).le.60) then !! ftrue(lon)=itrue(lon)/100+mod(itrue(lon),100)/60. select case (ctrue(lon)(7:7)) case ('E') case ('W') ftrue(lon)=-ftrue(lon) end select else ftrue(lon)=fmiss endif endif ! 200 continue call rxtltu(ftrue(yr),ftrue(mo),ftrue(dy),ftrue(hr),ftrue(lon) & ,fmiss) ! select case (ctrue(id)(1:9)) case ('BLAD EAGL') ctrue(id)(1:9)='BALD EAGL' case ('COMMONDOR','COMMODOR ') ctrue(id)(1:9)='COMMODORE' case ('LILIAN ') ctrue(id)(1:9)='LILLIAN ' case ('PAGE OF S') ctrue(id)(1:9)='PAGE ' case ('PHANTHER ') ctrue(id)(1:9)='PANTHER ' case ('PEERLES ') ctrue(id)(1:9)='PEERLESS ' case ('SHIP MARY') ctrue(id)(1:9)='MARY ROSS' case ('SIMON ') ctrue(id)(1:9)='SIMOON ' case ('STARLIGTH') ctrue(id)(1:9)='STARLIGHT' case ('SWEESTAKE') ctrue(id)(1:9)='SWEEPSTAK' case ('DAYLIGTH ') ctrue(id)(1:9)='DAYLIGHT ' case ('GRAET REP') ctrue(id)(1:9)='GREAT REP' case ('LIGTHNING') ctrue(id)(1:9)='LIGHTNING' case ('MATCHLEP ') ctrue(id)(1:9)='MATCHLESS' case ('MIDNIGTH ') ctrue(id)(1:9)='MIDNIGHT ' case ('TWILIGTH ') ctrue(id)(1:9)='TWILIGHT ' case ('WAHINGTON') ctrue(id)(1:9)='WASHINGTO' case ('WATH CHEE') ctrue(id)(1:9)='WHAT CHEE' end select ! if (ftrue(lat).ne.fmiss .and. ftrue(slp).ne.fmiss) then call temp(wbt) if (ftrue(wbt).ne.fmiss) then if (nint(ftrue(wbt)*10.).ge.-500 .and. & nint(ftrue(wbt)*10.).le. 500) then select case (ctrue(slp)(6:7)) case ('11','32','34','41') if (ctrue(slp)(6:7).ne.'34') ftrue(dpt)=ftrue(dpt)*10. ftrue(pb)=1. end select endif endif if (ftrue(pb).eq.fmiss) ftrue(pb)=2. select case (ctrue(slp)(6:6)) case ('1','4') if (ftrue(slp).gt.100.) ftrue(slp)=ftrue(slp)/10. if (nint(ftrue(pb)).eq.1) & ftrue(slp)=ftrue(slp)+fwbptf(ftrue(slp),ftrue(dpt)) ftrue(slp)=ftrue(slp)+fwbpgv(ftrue(slp),ftrue(lat),2) ftrue(slp)=fxeimb(ftrue(slp)) case ('3') if (ftrue(slp).lt.100.) ftrue(slp)=ftrue(slp)*10. if (nint(ftrue(pb)).eq.1) & ftrue(slp)=ftrue(slp)+fwbptc(ftrue(slp),ftrue(dpt)) ftrue(slp)=ftrue(slp)+fwbpgv(ftrue(slp),ftrue(lat),2) ftrue(slp)=fxmmmb(ftrue(slp)) case default ftrue(slp)=fmiss end select else ftrue(slp)=fmiss endif ctrue(wbt)(:16)=' ' ftrue(wbt)=fmiss ctrue(dpt)(:16)=' ' ftrue(dpt)=fmiss ftrue(it)=fmiss ! call temp(at) itrue(it)=nint(ftrue(it)) call temp(sst) if (itrue(it).ne.nint(fmiss) .and. & itrue(it).ne.nint(ftrue(it))) then if (itrue(it).le.2 .and. nint(ftrue(it)).le.2) then ftrue(it)=3. else ftrue(it)=fmiss endif endif ! ctrue(n)(:16)=ctrue(n)(2:2)//ctrue(n)(1:1) if (ftrue(n).ne.fmiss) then select case (ctrue(n)(1:1)) case (' ','0') case default if (ctrue(n)(1:2).eq.'10') then ftrue(n)=10. else ftrue(n)=fmiss endif end select endif if (ftrue(n).ne.fmiss) then ftrue(n)=ixt0ok(nint(ftrue(n))) endif ! select case (ctrue(d)(:16)) case ('C') ftrue(d)=361. case ('B','V') ftrue(d)=362. case default select case (ctrue(d)(:16)) case ('NEXE250','NEXE500','NEXE750' & & ,'SEXE250','SEXE500','SEXE750') ctrue(d)(8:8)='E' case ('NWXW250','NWXW500','NWXW750' & & ,'SWXW250','SWXW500','SWXW750') ctrue(d)(8:8)='W' end select ftrue(d)=ix128d(ctrue(d)(:16),itrue(d),nint(fmiss)) end select ! if (ftrue(w).eq.fmiss) then ftrue(w)=fxwfbf(ctrue(w)(4:6),fmiss) endif if (ftrue(w).ne.fmiss) then if (nint(ftrue(w)).ge.0 .and. nint(ftrue(w)).le.12) then ftrue(w)=fxbfms(nint(ftrue(w))) else ftrue(w)=fmiss endif else endif ! ! CONVERT LONGITUDE TO DEGREES EAST ! CALL EAST(ITRUE(LON),FTRUE(LON),FERR) ! SET EXTREME FLOATING POINT VALUES TO ERROR VALUE CALL MINMAX(CTRUE,ITRUE,FTRUE,FMISS,FERR & &,ILEN,FMIN1,FMAX1,FMIN2,FMAX2,FUNITS,ITYPE,NUM-1) ftrue(ti)=0. if (ctrue(id)(:9).ne.' ') ftrue(ii)=10. if (ftrue(w).ne.fmiss) ftrue(wi)=5. if (ftrue(slp).eq.fmiss) ftrue(pb)=fmiss ftrue(dck)=721. ftrue(sid)=152. ftrue(pt)=5. ftrue(tc)=1. ! 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) ! contains ! subroutine temp(wbt) if (ftrue(wbt).ne.fmiss) then select case (ctrue(wbt)(5:5)) case ('1') ftrue(wbt)=fxtftc(ftrue(wbt)*10.) ftrue(it)=6. case ('2') ftrue(wbt)=ftrue(wbt)*10. ftrue(it)=2. case ('3') ftrue(wbt)=fxtrtc(ftrue(wbt)*10.) ftrue(it)=9. case ('4') ftrue(it)=0. case default ftrue(wbt)=fmiss end select endif end subroutine END !-----------------------------------------------------------------------3456789 subroutine rxtltu(yr,mo,dy,hr,lon,fmiss) real yr,mo,dy,hr,lon,fmiss integer mdy,ndy,uyr,umo,udy,uhr ! mdy = ixdtnd(nint(dy),nint(mo),nint(yr)) if (mdy.lt.0 & .or. nint(hr*100.).lt.000 .or. nint(hr*100.).gt.2400 & .or. lon.eq.fmiss) then hr = fmiss return endif if (nint(hr*100.).eq.2400) then mdy = mdy + 1 hr = 0.00 endif call rxltut(nint(hr*100.),mdy,nint(lon*100.),uhr,ndy) call rxnddt(ndy,udy,umo,uyr) yr = uyr mo = umo dy = udy hr = uhr/100. end !-----------------------------------------------------------------------3456789 real function fxwfbf(str,fmiss) character str*3 real fmiss select case (str) case ('20') fxwfbf=0. case ('21') fxwfbf=1. case ('22','501') fxwfbf=2. case ('23','601') fxwfbf=3. case ('24','511') fxwfbf=4. case ('25','441') fxwfbf=5. case ('26','571') fxwfbf=6. case ('27','512') fxwfbf=7. case ('28','442') fxwfbf=8. case ('29','572') fxwfbf=9. case ('30') fxwfbf=10. case ('31') fxwfbf=11. case ('32') fxwfbf=12. case default fxwfbf=fmiss end select end !-----------------------------------------------------------------------3456789 integer function ix128d(c128,dc,imiss) !-----Convert 8-character 128-point wind direction abbreviation c128 into ! degrees, or return imiss if unrecognized; also return numeric code ! 1-128 (or imiss) in dc (see {lmrlib} for background). Recognized ! abbreviations are in cwd, with these characteristics: left-justified, ! upper-case, with trailing blank fill, and where "X" stands for "by". ! NOTE: No constraint is placed on imiss (it could overlap with data). !-----sjl, 10 Feb 2014. implicit integer(a-e,g-z) character*8 c128,cwd(128) data cwd & /'N250E ','N500E ','N750E ','NXE ','NXE250E ','NXE500E ' & ,'NXE750E ','NNE ','NNE250E ','NNE500E ','NNE750E ','NEXN ' & ,'NE750N ','NE500N ','NE250N ','NE ','NE250E ','NE500E ' & ,'NE750E ','NEXE ','NEXE250E','NEXE500E','NEXE750E','ENE ' & ,'ENE250E ','ENE500E ','ENE750E ','EXN ','E750N ','E500N ' & ,'E250N ','E ','E250S ','E500S ','E750S ','EXS ' & ,'ESE750E ','ESE500E ','ESE250E ','ESE ','SEXE750E','SEXE500E' & ,'SEXE250E','SEXE ','SE750E ','SE500E ','SE250E ','SE ' & ,'SE250S ','SE500S ','SE750S ','SEXS ','SSE750E ','SSE500E ' & ,'SSE250E ','SSE ','SXE750E ','SXE500E ','SXE250E ','SXE ' & ,'S750E ','S500E ','S250E ','S ','S250W ','S500W ' & ,'S750W ','SXW ','SXW250W ','SXW500W ','SXW750W ','SSW ' & ,'SSW250W ','SSW500W ','SSW750W ','SWXS ','SW750S ','SW500S ' & ,'SW250S ','SW ','SW250W ','SW500W ','SW750W ','SWXW ' & ,'SWXW250W','SWXW500W','SWXW750W','WSW ','WSW250W ','WSW500W ' & ,'WSW750W ','WXS ','W750S ','W500S ','W250S ','W ' & ,'W250N ','W500N ','W750N ','WXN ','WNW750W ','WNW500W ' & ,'WNW250W ','WNW ','NWXW750W','NWXW500W','NWXW250W','NWXW ' & ,'NW750W ','NW500W ','NW250W ','NW ','NW250N ','NW500N ' & ,'NW750N ','NWXN ','NNW750W ','NNW500W ','NNW250W ','NNW ' & ,'NXW750W ','NXW500W ','NXW250W ','NXW ','N750W ','N500W ' & ,'N250W ','N '/ ix128d = imiss do 500 j=1,128 if(c128.eq.cwd(j)) then ix128d = nint(360./128.*j) dc = j return endif 500 continue return 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 gfortran p.f90 lmrlib.o #date #./a.out