C=============================================================================C
C International Comprehensive Ocean-Atmosphere Data Set (ICOADS)  31 Jan 2005 C
C Filename:level: rdimma0:01F                        Fortran 77 program+shell C
C Purpose: Read and print/write IMMA                         Author: S.Lubker C
C                                                                             C
c Zaihua JI, zji@ucar.edu, 05/03/2005 -- modify code to read in PMEL data and C
c            write out in IMMA0 format; three sections, core, ICOADS attm and C
c            supplemental attm, are created for IMMA0                         C
c                                                                             C
c Work File : /huron/data/zji/wimma0_pmel.f
c  CVS File : $Header: /huron/dss/cvsroot/fortran/icoads/wimma0_pmel.f,v 1.11 2005/09/08 20:46:48 zji Exp $
c
C=============================================================================C
C Software Revision Information (previous version: 13 Jul 2004, level 01E):
C {flgrpt} removed and {gettrf} added; arguments to {prnrpt} transposed;
C arguments to {getrpt,putrpt} expanded and code rewritten; SIGN, SIGT, and
C SIGH renamed SGN, SGT, and SGH.
C-----------------------------------------------------------------------3456789
C Software documentation for the (modifiable) example program {rdimma} and for
C the (invariant) user-interface routines {prnskp,prnhdr,getrpt,east,gettrf,
C minmax,savsum,putrpt,prnrpt,prnsum}.
C
C As provided {rdimma}: (a) Prints PROGID (the program name and level).  Also,
C {prnhdr} prints a 4-line header for the unabbreviated record type (i.e., core
C plus all currently defined attms: 1-4 and 99).  (b) Reads a report (from
C standard input) via a formatted read and calls {getrpt} to extract the fields
C and convert them from characters to numeric values.  This makes the fields
C available in three parallel arrays:
C      CTRUE: characters (each length 1024)  blank       for missing data
C      ITRUE: integers                       NINT(FMISS) for missing data
C      FTRUE: true (floating point) values   FMISS       for missing data
C Additional parallel arrays available within common block IMMA0 provide
C metadata defining the properties of currently defined fields.  These include
C each field`s length (ILEN), abbreviation (ABBR), allowable range(s), units
C (FUNITS; missing for character data) and type (ITYPE; 1=numeric, 2=base36,
C 3=character) (see {bdimma} for details).  (c) For the core and attms, a
C PARAMETER statement relates each field abbreviation to an FTRUE (CTRUE,
C ITRUE, etc.) array location; this facilitates usage such as FDY = FTRUE(DY),
C to obtain the floating point value for day.  Each element of CTRUE is a
C 1024-character string, but the field length can be used to control printing,
C e.g., PRINT *,CTRUE(DY)(:ILEN(DY)).  (d) Prints the original report, RPT,
C under the aforementioned field headings (constructed using ABBR).  (e) The
C program iterates (to step b) reading and printing reports until end-of-file
C (EOF) is encountered.  Caution: IMPLICIT INTEGER(A-E,G-Z) is used; users may
C need to explicitly type additional variables when modifying this program.
C
C The following optional features are initially deactivated in the Fortran
C code; they may be activated by changing the appropriate Fortran comment
C lines to executable statements, i.e., remove the letter `C` from column 1:
C
C (a) Activate one or more calls to {prnskp} to suppress printing of the core
C and/or selected attms; {prnskp} is designed to work with the default calls
C to {prnhdr} and {prnrpt} for a reduced-width printout.  Or (b): Deactivate
C the default calls to {prnhdr} and {prnrpt}, and activate one (or more) of
C the alternative calls to {prnhdr} and {prnrpt}.  This provides flexibility
C so that the core or an attm can be printed individually (if only one pair
C of {prnhdr,prnrpt} is activated; alternatively, this can be accomplished by
C activating all but one call to {prnskp}).  Activating multiple alternative
C calls to {prnhdr} and {prnrpt} can be used to arrange the core and attms
C vertically (i.e., core and attms on multiple lines, for a single report).
C Moreover, any contiguous portion of the headers and reports can be printed
C by adjusting the fields that appear in the subroutine calls, e.g., activating
C CALL PRNHDR(ILEN,ABBR,YR,HR) and CALL PRNRPT(ILEN,CTRUE,YR,HR) prints just
C year, month, day, and hour.  Features (a) and (b) provide flexibility to
C print selected portions of the data; however, note that those two features
C were not designed to be used together (e.g., activating {prnskp} to skip
C the core, and {prnhdr,prnrpt} to print the core, will produce blank lines).
C
C Additional notes on using {prnrpt}:  To minimize data volume, IMMA data may
C have a `sparse` record structure, such that attms without any extant data are
C omitted, and the attm structure can vary from report to report.  Sparse data
C printed via the default calls to {prnhdr, prnrpt}, are expanded out into the
C complete IMMA structure.  Or, using {prnskp}, sparse reports are expanded out
C into a reduced print structure.  Alternatively, IMMA data may have a `fixed`
C record structure, such that a fixed number of attms are present in all
C reports.  In either case, it can be determined whether an attm was originally
C present in the input data from ATTI and ATTL: these are printed by {prnrpt}
C if the attm was extant, or blank if it was missing.  ATTC will always reflect
C the number of attms originally present (e.g., regardless how many are omitted
C from printing through the use of {prnskp}).
C
C (c) Activating {east} will transform longitudes stored according to the NCDC
C convention -179.99 (W) to 180.00 (E), into the ICOADS convention 0-359.99 E.
C This action is applied only to the numeric data (ITRUE, FTRUE), and does not
C take effect on the printed data, unless feature (e) is also activated.
C
C (d) Activate the call to {gettrf} to reformat the trimming and other quality
C control flags, plus other required fields, into array TRFLG.  This puts the
C information into a form compatible with that stored in the trimming section
C (Attm2) of the LMRF (LMR) format (the 23 elements of TRFLG are as documented
C in Table 1 of <stat_trim>).  Thus TRFLG can be used as input to {trimqc2.f}.
C
C Additional notes on the QC flags stored in IMMA: Currently, only the adaptive
C QC flags SQZ and SQA (not available from LMRF/LMR) are available, and only
C for 1784-1997; AQZ through DQA are always missing.  Like in LMR (Attm1), the
C NCDC-QC flags are available in a complete form (unlike in LMRF, where only a
C subset of that flag information is available from the composite flags).  The
C six external flags (ZE-RE), and the five source exclusion flags (SZ-RZ), are
C decoded by {gettrf} from the encoded variables QCE and QCZ, respectively, and
C reformatted for TRFLG.  Currently, however, only SZ-RZ are made available as
C individual fields, in elements 19-23 of TRFLG, and abbreviations ZE-RE and
C SZ-RZ (from the IMMA documentation, Table C1) are undefined in the program.
C
C (e) Activating {putrpt} will convert all the true values (e.g., longitudes
C transformed via {east}) back into characters for printing and/or writing.
C Specifically, if changes have been made to FTRUE, {putrpt} puts them also
C into ITRUE, CTRUE, and RPT.  Then the changes can be printed, by leaving
C {prnrpt} statement(s) in operation, or written, by activating (instead of
C {prnrpt}) the adjacent WRITE statement.  If both {prnrpt} and the WRITE
C statement are activated, each report will be output twice, possibly with
C differences in format (which provides a means to see how the two different
C output methods work).  For example, note that {prnskp} has no effect on the
C WRITE statement, in contrast to its effect on {prnrpt}.  Reports with a
C sparse record structure will be output when {putrpt} and the WRITE statement
C are used, and ATTC will reflect the output attm count.  Reports with a fixed
C record structure can be correctly output when {prnrpt} is used, with these
C caveats: (1) ATTI and ATTL must be set, when the attm data are entirely
C missing, or they will be printed blank; (2) ATTC will be set incorrectly if
C {prnskp} is used, but any of the attm data are extant.
C
C Additional notes on writing IMMA data:  With more extensive modifications,
C the program can be used to write IMMA data, using non-IMMA data as input.
C In this case the READ statement should be replaced by statements to read
C non-IMMA data, and {getrpt} deactivated.  Then the input data need to be
C transformed into the appropriate IMMA units, loaded into FTRUE, {putrpt}
C called, and the WRITE statement activated.  For writing IMMA, we recommend
C using feature (f), which ensures that data not compliant with the format
C are not output.
C 
C HUA, 5/6/05 -- for string fields (type 3) CTRUE need to be filled in the
C main program since FTRUE only holds ASCII value of the first charater of
C a string field and {putrpt} does not convert a character FTRUE to CTRUE.
C
C (f) Activate calls: to {minmax}, to set any `extreme` true values to error
C value FERR (by default equal to the missing value FMISS); to {savsum}, to
C save summary information for each field; and to {prnsum}, to print the
C following summary information on unit 10 (using field abbreviations, ABBR):
C      -- A summary of the numbers (and percentages) of each field that are
C         extant, missing, or erroneous.  Erroneous data are also counted
C         as a subset of the missing category.  Any field (or attm) entirely
C         missing in the input data is omitted from the summary.
C      -- A summary of any erroneous fields encountered in the input data,
C         with each unique pattern and its frequency listed.
C
C (g) The test for NREC greater than or equal to 50 can be activated to stop
C before reading/printing the entire file.  Regarding feature (f), note that
C the {prnsum} summary will only be output if statement 900 is reached.
C
C Data representation notes:
C (1) Printed data:  In the header, the field abbreviations (from ABBR) are
C     listed vertically.  The abbreviations are 1-4 characters in length, so
C     the header always occupies four lines (even if a selected subset of
C     fields includes no 4-character abbreviations).  All decimal points are
C     omitted for printing (i.e., each FTRUE value is divided by its FUNITS;
C     e.g., LON=33.80/0.01 = 3380 printed).  Missing data (FTRUE=FMISS) are
C     printed as blank, as are erroneous data, unless the default for FERR is
C     changed (see note 3).
C (2) Stored data (FTRUE, ITRUE, and CTRUE):  Some 1-character fields (i.e.,
C     those with ITYPE=2) have alphabetic base36 values defined (and printed)
C     as part of the legal range.  In ITRUE and FTRUE, these are stored as
C     the corresponding numeric values: A=10, B=11, ..., Z=35.  For character
C     (ITYPE=3) fields, note that ITRUE and CTRUE contain the ICHAR of the
C     first character of the field (e.g., if ID=WHRN, ITRUE(ID)=87).  This
C     simplifies the implementation of the program, but users should be aware
C     of the data type in processing character fields.
C (3) Erroneous data:  Erroneous data can be detected in two ways: (i) Data
C     that could not be read properly (e.g., a numeric field containing a
C     special character).  (ii) `Extreme` data, which read properly, but failed
C     to adhere to the ranges defined in {bdimma} (e.g., a numeric temperature
C     outside of -99.9 to 99.9).  Data of the first type are always set to
C     FERR, but data of the second type are only set to FERR if {minmax} is
C     called.  FERR equals FMISS by default.  If FERR is set to a non-default
C     value such as -888888., the printed output will contain all asterisks in
C     fields that contained erroneous data.  The non-default setting is also
C     used for quality control applications that need to distinguish between
C     actual missing data and data that were extant but erroneous.
C
C Machine dependencies:  None known.  Non-ANSI features: common block
C containing both character and non-character variables, and specification
C statements after data statements.
C For more information:  See <soft_info>; and see <lmr> and <stat_trim> for
C more information about the quality control and trimming flags (electronic
C documents).
C-----------------------------------------------------------------------3456789
      PROGRAM WIMMA0
      IMPLICIT INTEGER(A-E,G-Z)
C
      CHARACTER*14 PROGID
      DATA PROGID/'WIMMA_PMEL.01F'/
C
C CORE
      PARAMETER(YR=1,MO=2,DY=3,HR=4,LAT=5,LON=6,IM=7,ATTC=8,TI=9,LI=10
     +,DS=11,VS=12,NID=13,II=14,ID=15,C1=16,DI=17,D=18,WI=19,W=20,VI=21
     +,VV=22,WW=23,W1=24,SLP=25,A=26,PPP=27,IT=28,AT=29,WBTI=30,WBT=31
     +,DPTI=32,DPT=33,SI=34,SST=35,N=36,NH=37,CL=38,HI=39,H=40,CM=41
     +,CH=42,WD=43,WP=44,WH=45,SD=46,SP=47,SH=48)
C
C ICOADS ATTACHMENT
      PARAMETER(ATTI1=49,ATTL1=50,BSI=51,B10=52,B1=53,DCK=54,SID=55
     +,PT=56,DUPS=57,DUPC=58,TC=59,PB=60,WX=61,SX=62,C2=63,SQZ=64,SQA=65
     +,AQZ=66,AQA=67,UQZ=68,UQA=69,VQZ=70,VQA=71,PQZ=72,PQA=73,DQZ=74
     +,DQA=75,ND=76,SF=77,AF=78,UF=79,VF=80,PF=81,RF=82,ZNC=83,WNC=84
     +,BNC=85,XNC=86,YNC=87,PNC=88,ANC=89,GNC=90,DNC=91,SNC=92,CNC=93
     +,ENC=94,FNC=95,TNC=96,QCE=97,LZ=98,QCZ=99)
C
C IMMT-2/FM13 ATTACHMENT
      PARAMETER(ATTI2=100,ATTL2=101,OS=102,OP=103,FM=104,IX=105,W2=106
     +,SGN=107,SGT=108,SGH=109,WMI=110,SD2=111,SP2=112,SH2=113,IS=114
     +,ES=115,RS=116,IC1=117,IC2=118,IC3=119,IC4=120,IC5=121,IR=122
     +,RRR=123,TR=124,QCI=125,QI1=126,QI2=127,QI3=128,QI4=129,QI5=130
     +,QI6=131,QI7=132,QI8=133,QI9=134,QI10=135,QI11=136,QI12=137
     +,QI13=138,QI14=139,QI15=140,QI16=141,QI17=142,QI18=143,QI19=144
     +,QI20=145,QI21=146,HDG=147,COG=148,SOG=149,SLL=150,SLHH=151
     +,RWD=152,RWS=153)
C
C MODEL QUALITY CONTROL ATTACHMENT
      PARAMETER(ATTI3=154,ATTL3=155,CCCC=156,BUID=157,BMP=158,BSWU=159
     +,SWU=160,BSWV=161,SWV=162,BSAT=163,BSRH=164,SRH=165,SIX=166
     +,BSST=167,MST=168,MSH=169,BY=170,BM=171,BD=172,BH=173,BFL=174)
C
C SHIP METADATA ATTACHMENT
      PARAMETER(ATTI4=175,ATTL4=176,C1M=177,OPM=178,KOV=179,COR=180
     +,TOB=181,TOT=182,EOT=183,LOT=184,TOH=185,EOH=186,SIM=187,LOV=188
     +,DOS=189,HOP=190,HOT=191,HOB=192,HOA=193,SMF=194,SME=195,SMV=196)
C
C HISTORICAL ATTACHMENT
C
C SUPPLEMENTAL DATA ATTACHMENT
      PARAMETER(ATTI99=197,ATTL99=198,ATTE=199,SUPD=200)
C
      PARAMETER(NUM=200)
      CHARACTER*4 ABBR,RPTID
      COMMON /IMMA0/ILEN(NUM),ABBR(NUM),FMIN1(NUM),FMAX1(NUM)
     +,FMIN2(NUM),FMAX2(NUM),FUNITS(NUM),ITYPE(NUM),RPTID
C
      CHARACTER*1024 RPT,CTRUE
      DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM)
      DATA CTRUE/NUM*' '/,ITRUE/NUM*-999999/,FTRUE/NUM*-999999./
     +,FMISS/-999999./,FERR/-999999./,UNIT/10/
C
      DIMENSION QCFLG(14),TRFLG(23)
      EQUIVALENCE(ITRUE(ZNC),QCFLG)
      DATA TRFLG/23*0/
c
c decare variables for reading PMEL and JAMSTEC data files
c
      integer ntime, nblock
c time 
      integer iyr, imn, idy, ihr, imm
c norminal and high resolution locations
      integer ilat, ilon
      real nlat, nlon, rlat, rlon, mlat, mlon
      character*1 nulat, nulon, rulat, rulon
c variables
      real rsp, rdir, rat, rsst, rrh, rslp
c DEW POINT TEMPERATURE FUNCTION
      REAL DWPT
c quality codes
      integer qsp, qdir, qat, qsst, qrh, qslp
c depth
      integer du, dv, dsp, ddir, dat, dsst, drh, dslp
c 
      character infile*80, outfile*80, locfile*80, line*200
      logical ismin, ispre, isjam, isbad
      integer ili   ! lat/long indic.: 1 nearest hour, 5 high resolution
c vairiables for WMO number, missed if wnono = 0
      integer wmono
C
C PRINT PROGRAM HEADER
c      PRINT *,PROGID
C DO NOT PRINT CORE HEADER OR CORE
C      CALL PRNSKP(YR,SH)
C DO NOT PRINT ATTACHMENT HEADER OR ATTACHMENT
C      CALL PRNSKP(ATTI1,QCZ)
      CALL PRNSKP(ATTI2,RWS)
      CALL PRNSKP(ATTI3,BFL)
      CALL PRNSKP(ATTI4,SMV)
C      CALL PRNSKP(ATTI99,SUPD)
C
C PRINT REPORT HEADER
      CALL PRNHDR(ILEN,ABBR,YR,SUPD)
C PRINT CORE HEADER
C      CALL PRNHDR(ILEN,ABBR,YR,SH)
C PRINT ATTACHMENT HEADER
C      CALL PRNHDR(ILEN,ABBR,ATTI1,QCZ)
C      CALL PRNHDR(ILEN,ABBR,ATTI2,RWS)
C      CALL PRNHDR(ILEN,ABBR,ATTI3,BFL)
C      CALL PRNHDR(ILEN,ABBR,ATTI4,SMV)
C      CALL PRNHDR(ILEN,ABBR,ATTI99,SUPD)
C INITIALIZE NUMBER OF REPORTS READ
      NREC=0
c
c get infile and outfile names
c
      read(*, '(a)') infile
      read(*, '(a)') outfile
c
      isjam = (index(infile, "triton") .ne. 0)
      ispre = (index(infile, 'bp') .ne. 0)
      ismin = (index(infile, '10m') .ne. 0)
      if(.not. isjam) then
         read(*, '(a)') locfile  ! get location file name
      endif
c
c open PMEL or JAMSTEC input and IMMA0 output files
c
      open(1,file=infile,status='old',form='formatted')
      open(2,file=outfile,status='new',form='formatted', err = 901)
c
      lincnt = 0
c
c read the header info of pmel or jamstec data file
c
      if(isjam) then
         read(1, 1010) nlat, nulat, nlon, nulon
      else 
         if(ismin) then
            read(1, 1011) nlat, nulat, nlon, nulon, nblock
         else
            read(1, 1012) nlat, nulat, nlon, nulon, nblock
         endif
         print *, 'Number of Blocks To Process: ', nblock
         read(1, '(a)') line ! skip unit line
         if(.not. ispre) read(1, '(a)') line  ! skip convention line
         call setloc(locfile)   ! initialize high resolution location info
      endif
      ilat = NINT(10 * nlat)
      ilon = NINT(10 * nlon)
 1010 format(3x, f3.1, a1, x, f3.0, a1)
 1011 format(10x, f3.0, a1, f4.0, a1, 59x, i3)
 1012 format(10x, f3.0, a1, f4.0, a1, 54x, i3)
c
c set WMO number(s) for late use
c
      call setwmo(ilat, ilon, nulat, nulon)
C
 100  CONTINUE
      if(.not. isjam) then
         if(nblock .le. 0) goto 900 ! all blocks are processed, stop looping blocks
         nblock = nblock - 1
         if(ispre) then
            read(1, 1030) ntime
            read(1, 1050) dslp
         elseif(ismin) then
            read(1, 1031) ntime
            read(1, 1051) du, dv, dsp, ddir, dat, dsst, drh
         else 
            read(1, 1030) ntime
            read(1, 1052) du, dv, dsp, ddir, dat, dsst, drh
         endif
         print *, 'Number of Records In Block To Process: ', ntime 
      endif
 1030 format(68x,i7)
 1031 format(74x,i8)
 1050 format(14x,i7)
 1051 format(16x,5i7,i8,i7)
 1052 format(14x,7i7)
c
      read(1,'(a)') line !skip column header line
c
 1000 continue
      if(.not. isjam) then
         if(ntime .le. 0) goto 100 ! all records in block are processed, next block
         ntime = ntime - 1
      endif
c
c read in one record 
c
      read(1, '(a)', end=900) line
      isbad = .true.
c
      if(isjam) then
         read(line, 1060) iyr, imn, idy, ihr, rlat, mlat, rulat, 
     +                    rlon, mlon, rulon, rdir, rsp, rat, rrh,
     +                    rslp, rsst, qsp, qat, qrh, qslp, qsst
         if(rlat .eq. 99.0) goto 1000 ! skip this record
         qdir = qsp
         ili = 5
         rlat = rlat + NINT(100 * (mlat / 60)) / 100.0
         rlon = rlon + NINT(100 * (mlon / 60)) / 100.0
      else
         if(ispre) then
            read(line, 1061) iyr, imn, idy, ihr, rslp, qslp
            qsp = 0
            qdir = 0
            qat = 0
            qsst = 0
            qrh = 0
         elseif(ismin) then
            read(line, 1062) iyr, imn, idy, ihr, imm, rsp, rdir, rat, 
     +                       rsst, rrh, qsp, qdir, qat, qsst, qrh
            qslp = 0
         else
            read(line, 1063) iyr, imn, idy, ihr, rsp, rdir, rat, 
     +                       rsst, rrh, qsp, qdir, qat, qsst, qrh
            qslp = 0
         endif
c
         call getloc(ili, rlat, rlon, rulat, rulon, iyr, imn, idy)
         if(ili .eq. 1) then ! use norminal location
            rlat = nlat
            rlon = nlon
            rulat = nulat
            rulon = nulon
         endif
      endif
 1060 format(i4, 3(x, i2), 13x, f2.0, x, f5.2, a1, x, f3.0,
     +       x, f5.2, a1, 2(x, f7.1), 16x, 3(x, f7.1),
     +       37x, f7.2, 10x, 4(x, i1), 7x, i1)
 1061 format(x, i4, 2i2, x, i2, 2x, f7.1, x, i1)
 1062 format(x, i4, 2i2, x, 2i2, 16x, 2f7.1, f7.2, f8.3, f7.1, x, 5i1)
 1063 format(x, i4, 2i2, x, i2, 16x, 2f7.1, 2f7.2, f7.1, x, 5i1)
c
c one record read in, initialize and fill FTRUE array for IMMA0
c
      call init(ctrue, itrue, ftrue, fmiss, ilen, num)
c
c fill core location section
c
      ftrue(yr) = iyr
      ftrue(mo) = imn
      ftrue(dy) = idy
      if(ismin) then
         ftrue(hr) = ihr + nint(100.0 * imm / 60) / 100.0
         ftrue(ti) = 2
      else
         ftrue(hr) = ihr
         ftrue(ti) = 0
      endif
      if(rulat .eq. 'S') then
         ftrue(lat) = -rlat
      else
         ftrue(lat) = rlat
      endif
      if(rulon .eq. 'W') then
         ftrue(lon) = -rlon
         call east(itrue(lon), ftrue(lon), ferr) ! convert to 0-359.99E in case not
      else
         ftrue(lon) = rlon
      endif
      ftrue(im) = 0
      ftrue(attc) = 2
      ftrue(li) = ili
      call getwmo(wmono, iyr, imn, idy)
      if(wmono .gt. 10000) then
         write(ctrue(id), '(i5)') wmono
         ftrue(id) = wmono
         itrue(id) = ichar(ctrue(id)(:1))
         ftrue(ii) = 3
      endif
c
c fill core regular section
c
      if(qdir .ge. 1 .and. qdir .le. 3) then
         ftrue(di) = 6
         if(rdir .gt. 180) then
            ftrue(d) = nint(rdir - 180.0)
         else
            ftrue(d) = nint(rdir + 180.0)
         endif
         isbad = .false.
      endif
      if(qsp .ge. 1 .and. qsp .le. 3) then
         ftrue(wi) = 8
         ftrue(w) = rsp
         isbad = .false.
      endif
      if(qslp .ge. 1 .and. qslp .le. 3) then
         ftrue(slp) = rslp
         isbad = .false.
      endif
      if(qat .ge. 1 .and. qat .le. 3) then
         ftrue(it) = 8
         ftrue(at) = nint(10 * rat) / 10.0
         if(qrh .ge. 1 .and. qrh .le. 3) then
            ftrue(dpti) = 1
            ftrue(dpt) = DWPT(ftrue(at), rrh)
         endif
         isbad = .false.
      endif
      if(qsst .ge. 1 .and. qsst .le. 3) then
         ftrue(it) = 8
         ftrue(si) = 12
         ftrue(sst) = nint(10 * rsst) / 10.0
         isbad = .false.
      endif

      if(isbad) goto 1000  ! ignore bad record
c
c fill ICOADS attm section
c
      ftrue(atti1) = 1
      ftrue(attl1) = 65
      ftrue(dck) = 144
      if(isjam) then
         ftrue(sid) = 119
      elseif(ispre) then
         ftrue(sid) = 120
      elseif(ismin) then
         ftrue(sid) = 118
      else
         ftrue(sid) = 117
      endif
      ftrue(pt) = 6
c
c fill supplemental attm section, fill ctrue(supd) since it is a string
c
      ftrue(atti99) = 99
      ftrue(attl99) = 0
      if(isjam) then
         write(ctrue(supd), 1070) line(:174), nlat, nulat, nlon, nulon
      elseif(ispre) then
         write(ctrue(supd), 1071) line(2:69), nlat, nulat, nlon,
     +                            nulon, dslp
      elseif(ismin) then
         write(ctrue(supd), 1072) line(2:78), nlat, nulat, nlon, nulon,
     +                            du, dv, dsp, ddir, dat, dsst, drh
      else
         write(ctrue(supd), 1072) line(2:69), nlat, nulat, nlon, nulon,
     +                            du, dv, dsp, ddir, dat, dsst, drh
      endif
 1070 format(a, x, f4.1, a1, x, f5.1, a1)
 1071 format(a, x, f4.1, a1, x, f5.1, a1, x, i2)
 1072 format(a, x, f4.1, a1, x, f5.1, a1, 5i3, i2, i3)
c      
      itrue(supd) = ichar(ctrue(supd)(:1))
      ftrue(supd) = itrue(supd)
c
C      READ(*,'(A)',END=900)RPT
C INCREMENT NUMBER OF REPORTS READ
      NREC=NREC+1
C
C CONVERT CHARACTERS TO FLOATING POINT VALUES
c      CALL GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR
c     +,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM)
C
C CONVERT LONGITUDE TO DEGREES EAST
C      CALL EAST(ITRUE(LON),FTRUE(LON),FERR)
c GET AND PRINT TRIMMING AND OTHER QUALITY CONTROL FLAGS
      CALL GETTRF(ITRUE,QCFLG,NINT(FMISS),NINT(FERR)
     +,LAT,LON,D,W,B10,ND,SF,AF,UF,VF,PF,RF,QCE,LZ,QCZ,TRFLG)
C      CALL PRNTRF(TRFLG)
C SET EXTREME FLOATING POINT VALUES TO ERROR VALUE
      CALL MINMAX(CTRUE,ITRUE,FTRUE,FMISS,FERR
     +,ILEN,FMIN1,FMAX1,FMIN2,FMAX2,FUNITS,ITYPE,NUM)
C SAVE SUMMARY INFORMATION
      CALL SAVSUM(CTRUE,FTRUE,FMISS,FERR
     +,ILEN,ABBR,NUM)
C
C CONVERT FLOATING POINT VALUES TO CHARACTERS
      CALL PUTRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR,
     +            ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM)
C WRITE REPORT
C      WRITE(2,'(A)')RPT(:LENTRM(RPT))
C PRINT REPORT
      CALL PRNRPT(ILEN,CTRUE,YR,SUPD)
C PRINT CORE
C      CALL PRNRPT(ILEN,CTRUE,YR,SH)
C PRINT ATTACHMENT
C      CALL PRNRPT(ILEN,CTRUE,ATTI1,QCZ)
C      CALL PRNRPT(ILEN,CTRUE,ATTI2,RWS)
C      CALL PRNRPT(ILEN,CTRUE,ATTI3,BFL)
C      CALL PRNRPT(ILEN,CTRUE,ATTI4,SMV)
C      CALL PRNRPT(ILEN,CTRUE,ATTI99,SUPD)
C
c
C STOP AFTER SEVERAL REPORTS HAVE BEEN READ
C      IF (NREC.GE.50) STOP 'REMOVE STOP TO READ ALL REPORTS'
      GOTO 1000
c
c stop here if outfile exists already
c
 901  stop "Output IMMA0 file Exists Already" 
C
C END OF FILE
 900  CONTINUE
c
      close(1)  ! close input PMEL or JAMSTEC data file
      close(2)  ! close output IMMA0 file
c
C PRINT SUMMARY INFORMATION TO UNIT
      CALL PRNSUM(UNIT,PROGID,ABBR,NUM)
C
      PRINT *, 'REPORTS ', NREC
C
      END
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C   THIS FUNCTION RETURNS THE DEW POINT (CELSIUS) GIVEN THE TEMPERATURE
C   (CELSIUS) AND RELATIVE HUMIDITY (%). THE FORMULA IS USED IN THE
C   PROCESSING OF U.S. RAWINSONDE DATA AND IS REFERENCED IN PARRY, H.
C   DEAN, 1969: THE SEMIAUTOMATIC COMPUTATION OF RAWINSONDES,
C   TECHNICAL MEMORANDUM WBTM EDL 10, U.S. DEPARTMENT OF COMMERCE,
C   ENVIRONMENTAL SCIENCE SERVICES ADMINISTRATION, WEATHER BUREAU,
C   OFFICE OF SYSTEMS DEVELOPMENT, EQUIPMENT DEVELOPMENT LABORATORY,
C   SILVER SPRING, MD (OCTOBER), PAGE 9 AND PAGE II-4, LINE 460.
C   INCLUDE LIB_DEV:[GUDOC]EDFVAXBOX.FOR/LIST
C   Baker, Schlatter  17-MAY-1982     Original version.
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      FUNCTION DWPT(T, RH)
C
      REAL X, DPD, T, RH 
C
      X = 1. - 0.01 * RH

C   COMPUTE DEW POINT DEPRESSION.

      DPD =(14.55 + 0.114*T)*X + ((2.5 + 0.007*T)*X)**3
      if(X .gt. 0.02) then
         DPD = DPD + (15.9+0.117*T)*X**14
      end if
      DWPT = T-DPD
C
      RETURN
      END
C
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c subroutine setwmo() reads in the WMO number(s) for valid date range(s) from 
c file `wmoloc.txt`; entry getwmo() will get a valid WMO no by using the saved
c  WMO number(s).
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine setwmo(ilat, ilon, ulat, ulon)
      parameter (maxno = 10) 
      integer ilat, ilon
      character*1 ulat, ulon
      integer wmono, iyr, imn, idy, date, idx
      character*9 wmoloc, wloc
      integer wmocnt, wmonos(maxno), starts(maxno), ends(maxno)
      data wmocnt/0/, wmonos/maxno*0/, starts/maxno*0/, ends/maxno*0/
      save wmocnt, wmonos, starts, ends
c
      write(wmoloc, '(i3.3, a1, i4.4, a1)') ilat, ulat, ilon, ulon 
c
      open(3,file="wmoloc.txt",status='old',form='formatted', err=99)
c
      idx = 1
 10   read(3, 20, end=100) wloc, starts(idx), ends(idx), wmonos(idx)
c
 20   format(a9, x, i8, x, i8, x, i5)

      if(wmoloc .eq. wloc) then
         if(ends(idx) .eq. 0) then
            wmocnt = idx
            goto 100  ! found all valid WMO number(s)
         endif
         idx = idx + 1
         if(idx .gt. maxno) stop 'too many date ranges'
      endif
      goto 10
 99   stop 'error open wmoloc.txt'
 100  close(3)
      return
c
      entry getwmo(wmono, iyr, imn, idy)
      wmono = 0
      if(wmocnt .eq. 1) then
         wmono = wmonos(idx)
      elseif(wmocnt .gt. 1) then
         date = iyr * 10000 + imn * 100 + idy
         do idx = 1, wmocnt
            if(starts(idx) .eq. 0) then
               if(date .le. ends(idx)) wmono = wmonos(idx)
            elseif(ends(idx) .eq. 0) then
               if(date .ge. starts(idx)) wmono = wmonos(idx)
            elseif(date .ge. starts(idx) .and.
     +             date .le. ends(idx)) then
               wmono = wmonos(idx)
            endif
         enddo
      endif
c
      end
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c subroutine setloc() reads in the high resolution latitudes and logitudes from 
c file `pos*_dy.ascii`; entry getloc() will get values of deployment location
c by using the saved latitudes and longitudes.   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine setloc(locfile)
      parameter (maxno = 10000)
      character*80 locfile, rulat*1, rulon*1
      real rlat, rlon
      integer iyr, imn, idy, date, idx
      character*132 tmpstr
      integer nb, nt
      integer loccnt, qx, qy, dates(maxno)
      real lats(maxno), lons(maxno)
      character*1 ulats(maxno), ulons(maxno)
      data loccnt/0/, idx/0/, lats/maxno*0.0/, lons/maxno*0.0/,
     +     ulats/maxno*' '/, ulons/maxno*' '/, dates/maxno*0/
      save loccnt, idx, lats, lons, ulats, ulons, dates
c
      open(3, file=locfile, status='old', form='formatted', err=99)
      idx = 1
      print *, "get location info from ", locfile  
c
c read in block number
c
      read(3, '(62x, i2)') nb
      read(3, '(a)') tmpstr  ! skip one line
c
 1    continue
      if(nb .le. 0) goto 100 ! all blocks are processed, stop looping blocks
      nb = nb - 1
c
c read in record count in the block
c
      read(3, '(67x, i4)') nt
      read(3, '(a)') tmpstr  ! skip one line
      read(3, '(a)') tmpstr  ! skip one line
 2    continue
      if(nt .le. 0) goto 1 ! all records in block are processed, next block
      nt = nt - 1
c
 10   read(3, 20) dates(idx), lons(idx), ulons(idx),
     +            lats(idx), ulats(idx), qx, qy
 20   format(x, i8, 6x, f6.2, a1, 2x, f5.2, a1, x, i1, i1)

      if(qx .ge. 1 .and. qx .le. 3 .and. 
     +   qy .ge. 1 .and. qy .le. 3) then
         idx = idx + 1
         if(idx .gt. maxno) stop 'idx larger then maxno!'
      endif
      goto 2
 100  close(3)
      if(idx .gt. 1) then
         loccnt = idx
         idx = 1  ! reset idx
      endif
      print *, loccnt, " location records found!"
 99   return  ! if error open file, it means no location info
c
      entry getloc(ili, rlat, rlon, rulat, rulon, iyr, imn, idy)
c
      ili = 1
      date = iyr * 10000 + imn * 100 + idy
 200  if(idx .le. loccnt) then
         if(date .eq. dates(idx)) then
            ili = 5
            rlat = lats(idx)
            rlon = lons(idx)
            rulat = ulats(idx)
            rulon = ulons(idx)
         elseif(date .gt. dates(idx)) then
            idx = idx + 1
            goto 200
         endif
      endif
c
      end
c
c
C
C=============================================================================C
C WARNING:  Code beyond this point should not require any modification.       C
C=============================================================================C
C-----------------------------------------------------------------------3456789
      SUBROUTINE INIT(CTRUE,ITRUE,FTRUE,FMISS,ILEN,NUM)
C INITIALIZE CTRUE, ITRUE, AND FTRUE
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*(*) CTRUE
      DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM),ILEN(NUM)
C
      DO 190 I=1,NUM
        IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'INIT CTRUE LENGTH'
        CTRUE(I)(:ILEN(I))=' '
        ITRUE(I)=NINT(FMISS)
        FTRUE(I)=FMISS
  190 CONTINUE
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE EAST(ITRUE,FTRUE,FERR)
C CONVERT LONGITUDE TO DEGREES EAST
      IMPLICIT INTEGER(A-E,G-Z)
C
      IF(NINT(FTRUE*100.).GE.-36000 .AND. NINT(FTRUE*100.).LE.36000)THEN
        FTRUE=MOD(FTRUE+360.,360.)
        ITRUE=NINT(FTRUE*100.)
      ELSE
        FTRUE=FERR
        ITRUE=NINT(FERR)
      ENDIF
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE PRNSKP(BEG,END)
C DO NOT PRINT REPORT HEADER OR REPORT
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*(*) ABBR,CTRUE
      DIMENSION ILEN(*),ABBR(*),CTRUE(*)
      CHARACTER*1024 HDR,RPT*2048
      EQUIVALENCE(HDR,RPT)
      DIMENSION SKP(1024)
      DATA SKP/1024*0/
      SAVE SKP
C
      DO 190 I=BEG,END
        SKP(I)=1
  190 CONTINUE
      RETURN
C-----------------------------------------------------------------------3456789
      ENTRY PRNHDR(ILEN,ABBR,BEG,END)
C PRINT REPORT HEADER
C
      DO 295 J=1,4
        HDR=' '
        PTR=0
        DO 290 I=BEG,END
          IF (SKP(I).EQ.0) THEN
            IF (ILEN(I).EQ.1024) THEN
              PTR=PTR+1
            ELSE
              PTR=PTR+ILEN(I)
            ENDIF
            HDR(PTR:PTR)=ABBR(I)(J:J)
          ENDIF
  290   CONTINUE
        PRINT '(A)',HDR(:PTR)
  295 CONTINUE
      RETURN
C-----------------------------------------------------------------------3456789
      ENTRY PRNRPT(ILEN,CTRUE,BEG,END)
C PRINT REPORT
C
      RPT=' '
      PTR=0
      DO 390 I=BEG,END
        IF (SKP(I).EQ.0) THEN
          IF (ILEN(I).EQ.1024) THEN
            IF (PTR+1.GT.LEN(RPT)) STOP 'PRNRPT RPT LENGTH'
            RPT(PTR+1:)=CTRUE(I)
            IF (RPT(PTR+1:).NE.CTRUE(I)) STOP 'PRNRPT OVERFLOW'
            PTR=LENTRM(RPT)
          ELSE
            IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'PRNRPT RPT LENGTH'
            IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'PRNRPT CTRUE LENGTH'
            RPT(PTR+1:PTR+ILEN(I))=CTRUE(I)(:ILEN(I))
            PTR=PTR+ILEN(I)
          ENDIF
        ENDIF
  390 CONTINUE
c      PRINT '(A)',RPT(:PTR)
      write(2, '(A)') rpt(:ptr)
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR
     +,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM)
C CONVERT CHARACTERS TO FLOATING POINT VALUES
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*(*) RPT,CTRUE,ABBR,RPTID
      DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM)
     +,ILEN(NUM),ABBR(NUM),FMIN1(NUM),FUNITS(NUM),ITYPE(NUM)
      CHARACTER B36,IFMT(9)*8,STR*2048
      DATA IFMT/'(BZ,I1)','(BZ,I2)','(BZ,I3)','(BZ,I4)'
     +,'(BZ,I5)','(BZ,I6)','(BZ,I7)','(BZ,I8)','(BZ,I9)'/
      SAVE IFMT
C
      PTR=0
      RST=0
      ATTC=1000
      DO 180 I=1,NUM
        IF (ABBR(I).EQ.'ATTI') THEN
          ATTC=MOD(ATTC,1000)
          ATTI=NINT(FMIN1(I))
          ATTL=NINT(FMIN1(I+1))
          IF (RST+4.GT.LEN(STR)) STOP 'GETRPT STR LENGTH'
          IF (PTR+4.GT.LEN(RPT)) THEN
            STR(RST+1:)=' '
            RST=LEN(STR)
            GOTO 185
          ENDIF
          WRITE(STR(RST+1:RST+4),'(2I2)')ATTI,ATTL
          IF (ATTL.EQ.0) THEN
            IF (RPT(PTR+1:PTR+4).EQ.STR(RST+1:RST+4)) THEN
              STR(RST+1:)=RPT(PTR+1:)
              IF (STR(RST+1:).NE.RPT(PTR+1:)) STOP 'GETRPT OVERFLOW'
              PTR=LEN(RPT)
            ELSE
              STR(RST+1:)=' '
            ENDIF
            RST=LEN(STR)
            GOTO 185
          ELSE
            IF (RST+ATTL.GT.LEN(STR)) STOP 'GETRPT STR LENGTH'
            IF (RPT(PTR+1:PTR+4).EQ.STR(RST+1:RST+4)) THEN
            IF (PTR+ATTL.GT.LEN(RPT)) STOP 'GETRPT RPT LENGTH'
              STR(RST+1:RST+ATTL)=RPT(PTR+1:PTR+ATTL)
              PTR=PTR+ATTL
            ELSE
              STR(RST+1:RST+ATTL)=' '
            ENDIF
          ENDIF
        ELSE
          IF (ATTC.GE.1000) THEN
            IF (RST+ILEN(I).GT.LEN(STR)) STOP 'GETRPT STR LENGTH'
            IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'GETRPT RPT LENGTH'
            STR(RST+1:RST+ILEN(I))=RPT(PTR+1:PTR+ILEN(I))
            IF (ABBR(I).EQ.'  IM') THEN
              IF (RPT(PTR+1:PTR+2).NE.RPTID) STOP 'IMMA VERSION INVALID'
            ENDIF
            PTR=PTR+ILEN(I)
          ENDIF
        ENDIF
        RST=RST+ILEN(I)
  180 CONTINUE
  185 IF (PTR.LT.LEN(RPT)) THEN
        IF (RPT(PTR+1:).NE.' ') STOP 'GETRPT INCOMPLETE'
      ENDIF
C
      IF (RST.LT.LEN(STR)) STR(RST+1:)=' '
      RST=0
      DO 190 I=1,NUM
        IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'GETRPT CTRUE LENGTH'
C
        IF (ILEN(I).EQ.1024) THEN
          IF (RST+1.GT.LEN(STR)) STOP 'GETRPT STR LENGTH'
          CTRUE(I)=STR(RST+1:)
          IF (CTRUE(I).NE.STR(RST+1:)) STOP 'GETRPT OVERFLOW'
          RST=LEN(STR)
        ELSE
          IF (RST+ILEN(I).GT.LEN(STR)) STOP 'GETRPT STR LENGTH'
          CTRUE(I)(:ILEN(I))=STR(RST+1:RST+ILEN(I))
          RST=RST+ILEN(I)
        ENDIF
C
        IF (CTRUE(I)(:ILEN(I)).EQ.' ') THEN
          ITRUE(I)=NINT(FMISS)
        ELSE IF (ITYPE(I).EQ.1) THEN
          READ(CTRUE(I)(:ILEN(I)),IFMT(ILEN(I)),IOSTAT=IOS)ITRUE(I)
          IF (IOS.NE.0) ITRUE(I)=NINT(FERR)
        ELSE IF (ITYPE(I).EQ.2) THEN
          ITRUE(I)=IB36(CTRUE(I)(:ILEN(I)),NINT(FERR))
        ELSE
          ITRUE(I)=ICHAR(CTRUE(I)(:1))
        ENDIF
C
        IF (ITRUE(I).NE.NINT(FMISS) .AND. ITRUE(I).NE.NINT(FERR)
     +  .AND. ITYPE(I).LE.2) THEN
          FTRUE(I)=ITRUE(I)*FUNITS(I)
        ELSE
          FTRUE(I)=ITRUE(I)
        ENDIF
  190 CONTINUE
      RETURN
C-----------------------------------------------------------------------3456789
      ENTRY PUTRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR
     +,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM)
C CONVERT FLOATING POINT VALUES TO CHARACTERS
C
      RST=0
      DO 280 I=1,NUM
        IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'PUTRPT CTRUE LENGTH'
C
        IF (FTRUE(I).NE.FMISS .AND. FTRUE(I).NE.FERR
     +  .AND. ITYPE(I).LE.2) THEN
          ITRUE(I)=NINT(FTRUE(I)/FUNITS(I))
        ELSE
          ITRUE(I)=NINT(FTRUE(I))
        ENDIF
C
        IF (ITRUE(I).EQ.NINT(FMISS)) THEN
          CTRUE(I)(:ILEN(I))=' '
        ELSE IF (ITYPE(I).EQ.1) THEN
          WRITE(CTRUE(I)(:ILEN(I)),IFMT(ILEN(I)))ITRUE(I)
        ELSE IF (ITYPE(I).EQ.2) THEN
          CTRUE(I)(:ILEN(I))=B36(ITRUE(I),'*')
        ELSE
C          CTRUE(I)(:1)=CHAR(ITRUE(I))
        ENDIF
C
        IF (ILEN(I).EQ.1024) THEN
          IF (RST+1.GT.LEN(STR)) STOP 'PUTRPT STR LENGTH'
          STR(RST+1:)=CTRUE(I)
          IF (STR(RST+1:).NE.CTRUE(I)) STOP 'PUTRPT OVERFLOW'
          RST=LEN(STR)
        ELSE
          IF (RST+ILEN(I).GT.LEN(STR)) STOP 'PUTRPT STR LENGTH'
          STR(RST+1:RST+ILEN(I))=CTRUE(I)(:ILEN(I))
          RST=RST+ILEN(I)
        ENDIF
  280 CONTINUE
      IF (RST.LT.LEN(STR)) STR(RST+1:)=' '
C
      PTR=0
      RST=0
      ATTC=1000
      DO 290 I=1,NUM
        IF (ABBR(I).EQ.'ATTI') THEN
          ATTC=MOD(ATTC,1000)
          ATTI=NINT(FMIN1(I))
          ATTL=NINT(FMIN1(I+1))
          IF (RST+4.GT.LEN(STR)) STOP 'PUTRPT STR LENGTH'
          IF (PTR+4.GT.LEN(RPT)) THEN
            IF (STR(RST+1:).NE.' ') STOP 'PUTRPT INCOMPLETE'
            RST=LEN(STR)
            GOTO 295
          ENDIF
          WRITE(STR(RST+1:RST+4),'(2I2)')ATTI,ATTL
          IF (ATTL.EQ.0) THEN
            IF (STR(RST+5:).NE.' ') THEN
              RPT(PTR+1:)=STR(RST+1:)
              IF (RPT(PTR+1:).NE.STR(RST+1:)) STOP 'PUTRPT OVERFLOW'
              PTR=LEN(RPT)
              ATTC=ATTC+1
            ENDIF
            RST=LEN(STR)
            GOTO 295
          ELSE
            IF (RST+ATTL.GT.LEN(STR)) STOP 'PUTRPT STR LENGTH'
            IF (STR(RST+5:RST+ATTL).NE.' ') THEN
            IF (PTR+ATTL.GT.LEN(RPT)) STOP 'PUTRPT RPT LENGTH'
              RPT(PTR+1:PTR+ATTL)=STR(RST+1:RST+ATTL)
              PTR=PTR+ATTL
              ATTC=ATTC+1
            ENDIF
          ENDIF
        ELSE
          IF (ATTC.GE.1000) THEN
            IF (RST+ILEN(I).GT.LEN(STR)) STOP 'PUTRPT STR LENGTH'
            IF (PTR+ILEN(I).GT.LEN(RPT)) STOP 'PUTRPT RPT LENGTH'
            RPT(PTR+1:PTR+ILEN(I))=STR(RST+1:RST+ILEN(I))
            IF (ABBR(I).EQ.'  IM') THEN
              RPT(PTR+1:PTR+2)=RPTID
            ELSE IF (ABBR(I).EQ.'ATTC') THEN
              ATTC=1000+RST*10
            ENDIF
            PTR=PTR+ILEN(I)
          ENDIF
        ENDIF
        RST=RST+ILEN(I)
  290 CONTINUE
  295 IF (PTR.LT.LEN(RPT)) RPT(PTR+1:)=' '
      ATTC=MOD(ATTC,1000)
      IF (ATTC/10.GT.0)
     +WRITE(RPT(ATTC/10+1:ATTC/10+1),'(I1)')MOD(ATTC,10)
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE MINMAX(CTRUE,ITRUE,FTRUE,FMISS,FERR
     +,ILEN,FMIN1,FMAX1,FMIN2,FMAX2,FUNITS,ITYPE,NUM)
C SET EXTREME FLOATING POINT VALUES TO ERROR VALUE
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*(*) CTRUE
      DIMENSION CTRUE(NUM),ITRUE(NUM),FTRUE(NUM)
     +,ILEN(NUM),FMIN1(NUM),FMAX1(NUM),FMIN2(NUM),FMAX2(NUM)
     +,FUNITS(NUM),ITYPE(NUM)
C
      DO 190 I=1,NUM
        IF (ITYPE(I).GT.2) THEN
          IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'MINMAX CTRUE LENGTH'
          IF (CTRUE(I)(:ILEN(I)).EQ.' ') THEN
            ITRUE(I)=NINT(FMISS)
          ELSE
            ITRUE(I)=ICHAR(CTRUE(I)(:1))
          ENDIF
          FTRUE(I)=ITRUE(I)
        ENDIF
        IF (FTRUE(I).NE.FMISS .AND. FTRUE(I).NE.FERR) THEN
          IF (ITYPE(I).LE.2) THEN
            ITRUE(I)=NINT(FTRUE(I)/FUNITS(I))
            IF (ITRUE(I).GE.NINT(FMIN1(I)/FUNITS(I))
     +     .AND.ITRUE(I).LE.NINT(FMAX1(I)/FUNITS(I))
     +     .OR. ITRUE(I).GE.NINT(FMIN2(I)/FUNITS(I))
     +     .AND.ITRUE(I).LE.NINT(FMAX2(I)/FUNITS(I))) THEN
            ELSE
              FTRUE(I)=FERR
              ITRUE(I)=NINT(FERR)
            ENDIF
          ELSE
            DO 180 J=1,ILEN(I)
              IF (LGE(CTRUE(I)(J:J),'A')
     +       .AND.LLE(CTRUE(I)(J:J),'Z')
     +       .OR. NINT(FMIN1(I)).LE.48
     +       .AND.LGE(CTRUE(I)(J:J),'0')
     +       .AND.LLE(CTRUE(I)(J:J),'9')
     +       .OR. NINT(FMIN1(I)).EQ.32
     +       .AND.LGE(CTRUE(I)(J:J),' ')
     +       .AND.LLE(CTRUE(I)(J:J),'~')) THEN
              ELSE
                FTRUE(I)=FERR
                ITRUE(I)=NINT(FERR)
                GOTO 190
              ENDIF
  180       CONTINUE
          ENDIF
        ENDIF
  190 CONTINUE
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE SAVSUM(CTRUE,FTRUE,FMISS,FERR
     +,ILEN,ABBR,NUM)
C SAVE SUMMARY INFORMATION
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*(*) PROGID,ABBR,CTRUE
      DIMENSION CTRUE(NUM),FTRUE(NUM),ILEN(NUM),ABBR(NUM)
      CHARACTER*64 STR
      DIMENSION SUM1(1024),SUM2(1024),SUM3(1024)
      DATA SUM1,SUM2,SUM3/1024*0,1024*0,1024*0/
      SAVE SUM1,SUM2,SUM3
      PC(A1,A2)=NINT(FLOAT(A1*100)/MAX(A2,1))
C
      DO 190 I=1,NUM
        IF (FTRUE(I).NE.FMISS .AND. FTRUE(I).NE.FERR) THEN
          SUM1(I)=SUM1(I)+1
        ELSE
          SUM2(I)=SUM2(I)+1
          IF (ILEN(I).GT.LEN(CTRUE(I))) STOP 'SAVSUM CTRUE LENGTH'
          IF (CTRUE(I)(:ILEN(I)).NE.' ') THEN
            SUM3(I)=SUM3(I)+1
            WRITE(STR,'(I3,A6,2X,A53)')I,ABBR(I),CTRUE(I)
            CALL SAVSTR(STR)
          ENDIF
        ENDIF
  190 CONTINUE
      RETURN
C-----------------------------------------------------------------------3456789
      ENTRY PRNSUM(UNIT,PROGID,ABBR,NUM)
C PRINT SUMMARY INFORMATION TO UNIT
C
      WRITE(UNIT,'(A)')PROGID
      WRITE(UNIT,'(/1X,A)')'SUMMARY OF FIELDS'
      WRITE(UNIT,'(A6,2(2X,A10,A11,A13))')'FIELD'
     +,'# EXTANT','# MISSING','# ERRONEOUS'
     +,'% EXTANT','% MISSING','% ERRONEOUS'
      DO 290 I=1,NUM
        IF (SUM1(I).GT.0 .OR. SUM3(I).GT.0) THEN
          TOTAL=SUM1(I)+SUM2(I)
          WRITE(UNIT,'(A6,2(2X,I10,I11,I13))')ABBR(I)
     +    ,   SUM1(I)       ,   SUM2(I)       ,   SUM3(I)
     +    ,PC(SUM1(I),TOTAL),PC(SUM2(I),TOTAL),PC(SUM3(I),TOTAL)
        ENDIF
        SUM1(I)=0
        SUM2(I)=0
        SUM3(I)=0
  290 CONTINUE
      WRITE(UNIT,'(/1X,A)')'SUMMARY OF ERRORS'
      WRITE(UNIT,'(A6,2X,A,T70,A)')'FIELD','ERROR','FREQUENCY'
      CALL PRNSTR(UNIT)
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE SAVSTR(STR)
C SAVE FREQUENCY OF STRING
      IMPLICIT INTEGER(A-E,G-Z)
      PARAMETER(MMAX=10000)
      CHARACTER*64 STR,ARR1
      DIMENSION ARR1(MMAX),ARR2(MMAX)
      DATA M/0/
      SAVE
C
      DO 190 I=1,M
        IF (STR.NE.ARR1(I)) GOTO 190
        ARR2(I)=ARR2(I)+1
        RETURN
  190 CONTINUE
      IF (M+1.GE.MMAX) STOP 'INCREASE MMAX'
      M=M+1
      ARR1(M)=STR
      ARR2(M)=1
      RETURN
C-----------------------------------------------------------------------3456789
      ENTRY PRNSTR(UNIT)
C PRINT FREQUENCY OF STRING
C
      DO 290 K=1,M-1
        J=K
        DO 280 L=K+1,M
          IF (LLT(ARR1(L),ARR1(J))) J=L
  280   CONTINUE
        IF (J.NE.K) THEN
          ARR1(MMAX)=ARR1(K)
          ARR2(MMAX)=ARR2(K)
          ARR1(K)=ARR1(J)
          ARR2(K)=ARR2(J)
          ARR1(J)=ARR1(MMAX)
          ARR2(J)=ARR2(MMAX)
        ENDIF
  290 CONTINUE
      WRITE(UNIT,'(A,T70,I9)')(ARR1(I)(4:),ARR2(I),I=1,M)
      M=0
      END
C-----------------------------------------------------------------------3456789
      INTEGER FUNCTION IB36(B36,IERR)
C CONVERT BASE36 CHARACTER TO INTEGER
      CHARACTER B36
      INTEGER IERR
      CHARACTER*36 STR
      DATA STR/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
      SAVE STR
C
      IB36=INDEX(STR,B36)
      IF (IB36.NE.0) THEN
        IB36=IB36-1
      ELSE
        IB36=IERR
      ENDIF
      END
C-----------------------------------------------------------------------3456789
      CHARACTER FUNCTION B36(IB36,ERR)
C CONVERT INTEGER TO BASE36 CHARACTER
      INTEGER IB36
      CHARACTER ERR
      CHARACTER*36 STR
      DATA STR/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
      SAVE STR
C
      IF (IB36.GE.0 .AND. IB36.LE.35) THEN
        B36=STR(IB36+1:)
      ELSE
        B36=ERR
      ENDIF
      END
C-----------------------------------------------------------------------3456789
      FUNCTION LENTRM(STR)
C LENGTH OF A STRING MINUS TRAILING BLANKS
      CHARACTER STR*(*)
      DO 190 LENTRM=LEN(STR),1,-1
        IF (STR(LENTRM:LENTRM).NE.' ') RETURN
  190 CONTINUE
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE GETTRF(ITRUE,QCFLG,MISS,ERR
     +,LAT,LON,D,W,B10,ND,SF,AF,UF,VF,PF,RF,QCE,LZ,QCZ,TRFLG)
C GET TRIMMING FLAGS
      IMPLICIT INTEGER(A-E,G-Z)
      PARAMETER(ZNC=1,WNC=2,BNC=3,XNC=4,YNC=5,PNC=6,ANC=7,GNC=8,DNC=9
     +,SNC=10,CNC=11,ENC=12,FNC=13,TNC=14)
      DIMENSION ITRUE(*),QCFLG(14),TRFLG(23)
      LOGICAL B2QXY
C
      DO 190 I=1,23
        TRFLG(I)=0
  190 CONTINUE
      IF (ITRUE(LAT).NE.MISS .AND. ITRUE(LAT).NE.ERR .AND.
     +    ITRUE(LON).NE.MISS .AND. ITRUE(LON).NE.ERR .AND.
     +    ITRUE(B10).NE.MISS .AND. ITRUE(B10).NE.ERR) THEN
        IF (B2QXY(QB10(ITRUE(B10)),ITRUE(LON),ITRUE(LAT),B2))
     +  TRFLG( 1)=B2
      ENDIF
      IF (ITRUE(ND).NE.MISS) THEN
        TRFLG( 2)=ITRUE(ND)
      ENDIF
      IF (ITRUE(SF).NE.MISS) THEN
        TRFLG( 3)=ITRUE(SF)
        TRFLG( 4)=ITRUE(AF)
        TRFLG( 5)=ITRUE(UF)
        TRFLG( 6)=ITRUE(VF)
        TRFLG( 7)=ITRUE(PF)
        TRFLG( 8)=ITRUE(RF)
      ENDIF
      IF (QCFLG(ZNC).NE.MISS) THEN
        IF (QCFLG(ZNC).GE.7 .AND. QCFLG(ZNC).NE.10) TRFLG( 9)=1
        IF (QCFLG(SNC).GE.8 .AND. QCFLG(SNC).NE.10) TRFLG(10)=1
        IF (QCFLG(ANC).GE.8 .AND. QCFLG(ANC).NE.10) TRFLG(11)=1
        IF (ITRUE(D).GE.1 .AND. ITRUE(D).LE.360 .AND. ITRUE(W).EQ.0
     +                      .AND. QCFLG(WNC).EQ. 7) TRFLG(12)=1
        IF (QCFLG(PNC).GE.8 .AND. QCFLG(PNC).NE.10) TRFLG(13)=1
        IF (QCFLG(GNC).GE.8 .AND. QCFLG(GNC).NE.10) TRFLG(14)=1
        IF (QCFLG(DNC).GE.8 .AND. QCFLG(DNC).NE.10) TRFLG(14)=1
        IF (QCFLG(XNC).GE.2 .AND. QCFLG(XNC).NE.10) TRFLG(15)=1
        IF (QCFLG(XNC).GE.4 .AND. QCFLG(XNC).NE.10) TRFLG(15)=2
        IF (QCFLG(XNC).GE.7 .AND. QCFLG(XNC).NE.10) TRFLG(15)=3
        IF (QCFLG(CNC).GE.2 .AND. QCFLG(CNC).NE.10) TRFLG(16)=1
        IF (QCFLG(CNC).GE.4 .AND. QCFLG(CNC).NE.10) TRFLG(16)=2
        IF (QCFLG(CNC).GE.7 .AND. QCFLG(CNC).NE.10) TRFLG(16)=3
        IF (QCFLG(ENC).GE.2 .AND. QCFLG(ENC).NE.10) TRFLG(17)=1
        IF (QCFLG(ENC).GE.4 .AND. QCFLG(ENC).NE.10) TRFLG(17)=2
        IF (QCFLG(ENC).GE.7 .AND. QCFLG(ENC).NE.10) TRFLG(17)=3
      ENDIF
      IF (ITRUE(QCE).NE.MISS) THEN
        TRFLG( 9)=TRFLG( 9)+2*MOD(ITRUE(QCE)/2/2/2/2/2,2)
        TRFLG(10)=TRFLG(10)+2*MOD(ITRUE(QCE)/2/2/2/2,2)
        TRFLG(11)=TRFLG(11)+2*MOD(ITRUE(QCE)/2/2/2,2)
        TRFLG(12)=TRFLG(12)+2*MOD(ITRUE(QCE)/2/2,2)
        TRFLG(13)=TRFLG(13)+2*MOD(ITRUE(QCE)/2,2)
        TRFLG(14)=TRFLG(14)+2*MOD(ITRUE(QCE),2)
      ENDIF
      IF (ITRUE(LZ).NE.MISS) THEN
        TRFLG(18)=ITRUE(LZ)
      ENDIF
      IF (ITRUE(QCZ).NE.MISS) THEN
        TRFLG(19)=MOD(ITRUE(QCZ)/2/2/2/2,2)
        TRFLG(20)=MOD(ITRUE(QCZ)/2/2/2,2)
        TRFLG(21)=MOD(ITRUE(QCZ)/2/2,2)
        TRFLG(22)=MOD(ITRUE(QCZ)/2,2)
        TRFLG(23)=MOD(ITRUE(QCZ),2)
      ENDIF
      END
C$QB10------------------------------------------------------------------3456789
      FUNCTION QB10(B10)
      IMPLICIT INTEGER(A-E,G-Z)
      QB10=-1
      IF(B10.LT.1.OR.B10.GT.648)RETURN
      QB10=2+(B10-1)/324*2-MOD(B10-1+3,36)/18
      END
C$B2QXY-----------------------------------------------------------------3456789
      LOGICAL FUNCTION B2QXY(Q,X,Y,B2)
      IMPLICIT INTEGER(A-E,G-Z)
C
      B2QXY=.FALSE.
      IF(Q.LT.1.OR.Q.GT.4.OR.X.LT.0.OR.X.GT.35999.OR.ABS(Y).GT.9000)
     +RETURN
C
      IF(ABS(Y).LT.9000)THEN
        IF(MOD(Q,2).EQ.0)THEN
          C=MIN(X/200,89)
        ELSE
          C=179-MIN(MOD(36000-X,36000)/200,89)
        ENDIF
        IF(Q/3.EQ.0)THEN
          R=89-(9000+Y)/200
        ELSE
          R=(9000-Y)/200
        ENDIF
        B2=2+R*180+C
C
      ELSE IF(Y.EQ.9000)THEN
        B2=1
C
      ELSE
        B2=16202
      ENDIF
C
      B2QXY=.TRUE.
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE PRNTRF(TRFLG)
C     PRINT TRIMMING ATTACHMENT OR SECTION
C
      IMPLICIT INTEGER(A-E,G-Z)
      DIMENSION TRFLG(23)
      CHARACTER*8 ATT,FIELD(23)
      DATA ATT/' TRFLG'/
     +,FIELD/' B2=',' ND=',' SF=',' AF=',' UF=',' VF=',' PF=',' RF='
     +,' ZQ=',' SQ=',' AQ=',' WQ=',' PQ=',' RQ=',' XQ=',' CQ=',' EQ='
     +,' LZ=',' SZ=',' AZ=',' WZ=',' PZ=',' RZ='/
C
      WRITE(*,'(A6,A4,I5.0,A4,I1.0,6(A4,I2.0),15(A4,I1.0))')
     +ATT,(FIELD(I),TRFLG(I),I=1,23)
      END
C-----------------------------------------------------------------------3456789
      BLOCK DATA BDIMMA
C COMMON BLOCK DATA STATEMENTS
      IMPLICIT INTEGER(A-E,G-Z)
C
C     missing = -999999
C     ILEN    = field length
C     ABBR    = field abbreviation
C     FMIN1   = field range minimum (first, or only)
C     FMAX1   = field range maximum (first, or only)
C     FMIN2   = field range minimum (second, or missing)
C     FMAX2   = field range maximum (second, or missing)
C     FUNITS  = field units (missing, if itype=3)
C     ITYPE   = 1: numeric:   decimal range(s)
C               2: numeric:   decimal range(s), transformed to base36
C               3: character: decimal range(s), transformed to ascii
C     RPTID   = 0 (IMMA version that the program can read)
C
      PARAMETER(NUM=200)
      CHARACTER*4 ABBR,RPTID
      COMMON /IMMA0/ILEN(NUM),ABBR(NUM),FMIN1(NUM),FMAX1(NUM)
     +,FMIN2(NUM),FMAX2(NUM),FUNITS(NUM),ITYPE(NUM),RPTID
C
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=1,18)/
     +   4, '  YR', 1600.  , 2024.  ,-999999.,-999999., 1.     , 1,
     +   2, '  MO',    1.  ,   12.  ,-999999.,-999999., 1.     , 1,
     +   2, '  DY',    1.  ,   31.  ,-999999.,-999999., 1.     , 1,
     +   4, '  HR',    0.00,   23.99,-999999.,-999999., 0.01   , 1,
     +   5, ' LAT',  -90.00,   90.00,-999999.,-999999., 0.01   , 1,
     +   6, ' LON',    0.00,  359.99, -179.99,  180.00, 0.01   , 1,
     +   2, '  IM',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   1, 'ATTC',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, '  TI',    0.  ,    3.  ,-999999.,-999999., 1.     , 1,
     +   1, '  LI',    0.  ,    6.  ,-999999.,-999999., 1.     , 1,
     +   1, '  DS',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, '  VS',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   2, ' NID',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, '  II',    0.  ,   10.  ,-999999.,-999999., 1.     , 1,
     +   9, '  ID',   32.  ,  126.  ,-999999.,-999999.,-999999., 3,
     +   2, '  C1',   48.  ,   57.  ,   65.  ,   90.  ,-999999., 3,
     +   1, '  DI',    0.  ,    6.  ,-999999.,-999999., 1.     , 1,
     +   3, '   D',    1.  ,  362.  ,-999999.,-999999., 1.     , 1/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=19,36)/
     +   1, '  WI',    0.  ,    8.  ,-999999.,-999999., 1.     , 1,
     +   3, '   W',    0.0 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   1, '  VI',    0.  ,    2.  ,-999999.,-999999., 1.     , 1,
     +   2, '  VV',   90.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, '  WW',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   1, '  W1',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   5, ' SLP',  870.0 , 1074.6 ,-999999.,-999999., 0.1    , 1,
     +   1, '   A',    0.  ,    8.  ,-999999.,-999999., 1.     , 1,
     +   3, ' PPP',    0.0 ,   51.0 ,-999999.,-999999., 0.1    , 1,
     +   1, '  IT',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   4, '  AT',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   1, 'WBTI',    0.  ,    3.  ,-999999.,-999999., 1.     , 1,
     +   4, ' WBT',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   1, 'DPTI',    0.  ,    3.  ,-999999.,-999999., 1.     , 1,
     +   4, ' DPT',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   2, '  SI',    0.  ,   12.  ,-999999.,-999999., 1.     , 1,
     +   4, ' SST',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   1, '   N',    0.  ,    9.  ,-999999.,-999999., 1.     , 1/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=37,54)/
     +   1, '  NH',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, '  CL',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, '  HI',    0.  ,    1.  ,-999999.,-999999., 1.     , 1,
     +   1, '   H',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, '  CM',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, '  CH',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   2, '  WD',    0.  ,   38.  ,-999999.,-999999., 1.     , 1,
     +   2, '  WP',    0.  ,   30.  ,   99.  ,   99.  , 1.     , 1,
     +   2, '  WH',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, '  SD',    0.  ,   38.  ,-999999.,-999999., 1.     , 1,
     +   2, '  SP',    0.  ,   30.  ,   99.  ,   99.  , 1.     , 1,
     +   2, '  SH',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTI',    1.  ,    1.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTL',   65.  ,   65.  ,-999999.,-999999., 1.     , 1,
     +   1, ' BSI',-999999.,-999999.,-999999.,-999999., 1.     , 1,
     +   3, ' B10',    1.  ,  648.  ,-999999.,-999999., 1.     , 1,
     +   2, '  B1',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   3, ' DCK',    0.  ,  999.  ,-999999.,-999999., 1.     , 1/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=55,72)/
     +   3, ' SID',    0.  ,  999.  ,-999999.,-999999., 1.     , 1,
     +   2, '  PT',    0.  ,   15.  ,-999999.,-999999., 1.     , 1,
     +   2, 'DUPS',    0.  ,   14.  ,-999999.,-999999., 1.     , 1,
     +   1, 'DUPC',    0.  ,    2.  ,-999999.,-999999., 1.     , 1,
     +   1, '  TC',    0.  ,    1.  ,-999999.,-999999., 1.     , 1,
     +   1, '  PB',    0.  ,    2.  ,-999999.,-999999., 1.     , 1,
     +   1, '  WX',    1.  ,    1.  ,-999999.,-999999., 1.     , 1,
     +   1, '  SX',    1.  ,    1.  ,-999999.,-999999., 1.     , 1,
     +   2, '  C2',    0.  ,   40.  ,-999999.,-999999., 1.     , 1,
     +   1, ' SQZ',    1.  ,   35.  ,-999999.,-999999., 1.     , 2,
     +   1, ' SQA',    1.  ,   21.  ,-999999.,-999999., 1.     , 2,
     +   1, ' AQZ',    1.  ,   35.  ,-999999.,-999999., 1.     , 2,
     +   1, ' AQA',    1.  ,   21.  ,-999999.,-999999., 1.     , 2,
     +   1, ' UQZ',    1.  ,   35.  ,-999999.,-999999., 1.     , 2,
     +   1, ' UQA',    1.  ,   21.  ,-999999.,-999999., 1.     , 2,
     +   1, ' VQZ',    1.  ,   35.  ,-999999.,-999999., 1.     , 2,
     +   1, ' VQA',    1.  ,   21.  ,-999999.,-999999., 1.     , 2,
     +   1, ' PQZ',    1.  ,   35.  ,-999999.,-999999., 1.     , 2/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=73,90)/
     +   1, ' PQA',    1.  ,   21.  ,-999999.,-999999., 1.     , 2,
     +   1, ' DQZ',    1.  ,   35.  ,-999999.,-999999., 1.     , 2,
     +   1, ' DQA',    1.  ,   21.  ,-999999.,-999999., 1.     , 2,
     +   1, '  ND',    1.  ,    2.  ,-999999.,-999999., 1.     , 1,
     +   1, '  SF',    1.  ,   15.  ,-999999.,-999999., 1.     , 2,
     +   1, '  AF',    1.  ,   15.  ,-999999.,-999999., 1.     , 2,
     +   1, '  UF',    1.  ,   15.  ,-999999.,-999999., 1.     , 2,
     +   1, '  VF',    1.  ,   15.  ,-999999.,-999999., 1.     , 2,
     +   1, '  PF',    1.  ,   15.  ,-999999.,-999999., 1.     , 2,
     +   1, '  RF',    1.  ,   15.  ,-999999.,-999999., 1.     , 2,
     +   1, ' ZNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' WNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' BNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' XNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' YNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' PNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' ANC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' GNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=91,108)/
     +   1, ' DNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' SNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' CNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' ENC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' FNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' TNC',    1.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   2, ' QCE',    0.  ,   63.  ,-999999.,-999999., 1.     , 1,
     +   1, '  LZ',    1.  ,    1.  ,-999999.,-999999., 1.     , 1,
     +   2, ' QCZ',    0.  ,   31.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTI',    2.  ,    2.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTL',   76.  ,   76.  ,-999999.,-999999., 1.     , 1,
     +   1, '  OS',    0.  ,    6.  ,-999999.,-999999., 1.     , 1,
     +   1, '  OP',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   2, '  FM',    0.  ,    8.  ,-999999.,-999999., 1.     , 1,
     +   1, '  IX',    1.  ,    7.  ,-999999.,-999999., 1.     , 1,
     +   1, '  W2',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' SGN',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' SGT',    0.  ,   10.  ,-999999.,-999999., 1.     , 2/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=109,126)/
     +   2, ' SGH',    0.  ,   50.  ,   56.  ,   99.  , 1.     , 1,
     +   1, ' WMI',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   2, ' SD2',    0.  ,   38.  ,-999999.,-999999., 1.     , 1,
     +   2, ' SP2',    0.  ,   30.  ,   99.  ,   99.  , 1.     , 1,
     +   2, ' SH2',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   1, '  IS',    1.  ,    5.  ,-999999.,-999999., 1.     , 1,
     +   2, '  ES',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   1, '  RS',    0.  ,    4.  ,-999999.,-999999., 1.     , 1,
     +   1, ' IC1',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' IC2',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' IC3',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' IC4',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, ' IC5',    0.  ,   10.  ,-999999.,-999999., 1.     , 2,
     +   1, '  IR',    0.  ,    4.  ,-999999.,-999999., 1.     , 1,
     +   3, ' RRR',    0.  ,  999.  ,-999999.,-999999., 1.     , 1,
     +   1, '  TR',    1.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QCI',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QI1',    0.  ,    9.  ,-999999.,-999999., 1.     , 1/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=127,144)/
     +   1, ' QI2',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QI3',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QI4',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QI5',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QI6',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QI7',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QI8',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, ' QI9',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI10',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI11',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI12',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI13',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI14',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI15',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI16',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI17',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI18',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI19',    0.  ,    9.  ,-999999.,-999999., 1.     , 1/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=145,162)/
     +   1, 'QI20',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   1, 'QI21',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   3, ' HDG',    0.  ,  360.  ,-999999.,-999999., 1.     , 1,
     +   3, ' COG',    0.  ,  360.  ,-999999.,-999999., 1.     , 1,
     +   2, ' SOG',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, ' SLL',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   3, 'SLHH',  -99.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   3, ' RWD',    1.  ,  362.  ,-999999.,-999999., 1.     , 1,
     +   3, ' RWS',    0.0 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   2, 'ATTI',    3.  ,    3.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTL',   66.  ,   66.  ,-999999.,-999999., 1.     , 1,
     +   4, 'CCCC',   65.  ,   90.  ,-999999.,-999999.,-999999., 3,
     +   6, 'BUID',   48.  ,   57.  ,   65.  ,   90.  ,-999999., 3,
     +   5, ' BMP',  870.0 , 1074.6 ,-999999.,-999999., 0.1    , 1,
     +   4, 'BSWU',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   4, ' SWU',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   4, 'BSWV',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   4, ' SWV',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=163,180)/
     +   4, 'BSAT',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   3, 'BSRH',    0.  ,  100.  ,-999999.,-999999., 1.     , 1,
     +   3, ' SRH',    0.  ,  100.  ,-999999.,-999999., 1.     , 1,
     +   1, ' SIX',    2.  ,    3.  ,-999999.,-999999., 1.     , 1,
     +   4, 'BSST',  -99.9 ,   99.9 ,-999999.,-999999., 0.1    , 1,
     +   1, ' MST',    0.  ,    9.  ,-999999.,-999999., 1.     , 1,
     +   3, ' MSH',    0.  ,  999.  ,-999999.,-999999., 1.     , 1,
     +   4, '  BY',    0.  , 9999.  ,-999999.,-999999., 1.     , 1,
     +   2, '  BM',    1.  ,   12.  ,-999999.,-999999., 1.     , 1,
     +   2, '  BD',    1.  ,   31.  ,-999999.,-999999., 1.     , 1,
     +   2, '  BH',    0.  ,   23.  ,-999999.,-999999., 1.     , 1,
     +   2, ' BFL',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTI',    4.  ,    4.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTL',   57.  ,   57.  ,-999999.,-999999., 1.     , 1,
     +   2, ' C1M',   65.  ,   90.  ,-999999.,-999999.,-999999., 3,
     +   2, ' OPM',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, ' KOV',   32.  ,  126.  ,-999999.,-999999.,-999999., 3,
     +   2, ' COR',   65.  ,   90.  ,-999999.,-999999.,-999999., 3/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=181,198)/
     +   3, ' TOB',   32.  ,  126.  ,-999999.,-999999.,-999999., 3,
     +   3, ' TOT',   32.  ,  126.  ,-999999.,-999999.,-999999., 3,
     +   2, ' EOT',   32.  ,  126.  ,-999999.,-999999.,-999999., 3,
     +   2, ' LOT',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   1, ' TOH',   32.  ,  126.  ,-999999.,-999999.,-999999., 3,
     +   2, ' EOH',   32.  ,  126.  ,-999999.,-999999.,-999999., 3,
     +   3, ' SIM',   32.  ,  126.  ,-999999.,-999999.,-999999., 3,
     +   3, ' LOV',    0.  ,  999.  ,-999999.,-999999., 1.     , 1,
     +   2, ' DOS',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   3, ' HOP',    0.  ,  999.  ,-999999.,-999999., 1.     , 1,
     +   3, ' HOT',    0.  ,  999.  ,-999999.,-999999., 1.     , 1,
     +   3, ' HOB',    0.  ,  999.  ,-999999.,-999999., 1.     , 1,
     +   3, ' HOA',    0.  ,  999.  ,-999999.,-999999., 1.     , 1,
     +   5, ' SMF',    0.  ,99999.  ,-999999.,-999999., 1.     , 1,
     +   5, ' SME',    0.  ,99999.  ,-999999.,-999999., 1.     , 1,
     +   2, ' SMV',    0.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTI',   99.  ,   99.  ,-999999.,-999999., 1.     , 1,
     +   2, 'ATTL',    0.  ,    0.  ,-999999.,-999999., 1.     , 1/
      DATA (ILEN(I),ABBR(I),FMIN1(I),FMAX1(I),FMIN2(I),FMAX2(I)
     +,FUNITS(I),ITYPE(I),I=199,200)/
     +   1, 'ATTE',-999999.,-999999.,-999999.,-999999., 1.     , 1,
     +1024, 'SUPD',   32.  ,  126.  ,-999999.,-999999.,-999999., 3/
      DATA RPTID/' 0'/
      END
