w3miscan.f

Go to the documentation of this file.

C> @file
C> @brief Reads 1 ssm/i scan line from bufr d-set
C> @author Dennis Keyser @date 1996-07-30
 
C> Reads one ssm/i scan line (64 retrievals) from the NCEP
C> bufr ssm/i dump file. Each scan is time checked against the
C> user-requested time window and satellite id combinations. When a
C> valid scan is read the program returns to the calling program.
C> the user must pass in the type of the input ssm/i dump file,
C> either derived products (regardless of source) or brightness
C> temperatures (7-channels). If the latter is chosen, the user
C> has the further option of processing, in addition to the
C> brightness temperatures, in-line calculation of wind speed
C> product via the goodberlet algorithm, and/or in-line calculation
C> of both wind speed and total column precipitable water (tpw)
C> products using the neural net 3 algorithm. If the wind speed
C> or tpw is calculated here (either algorithm), this subroutine
C> will check for brightness temperatures outside of a preset range
C> and will return a missing wind speed/tpw if any b. temp is
C> unreasonable. Also, for calculated wind speeds and tpw, this
C> program will check to see if the b. temps are over land or ice,
C> and if they are it will also return missing values since these
C> data are valid only over ocean.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1996-07-30 | Dennis Keyser | Original author - subroutine is a modified version of w3lib w3fi86 which read one scan line from the 30-orbit shared processing data sets
C> 1997-05-22 | Dennis Keyser | Crisis fix to account for clon now returned from bufr as -180 to 0 (west) or 0 to 180 (east), used to return as 0 to 360 east which was not the bufr standard
C> 1998-01-28 | Dennis Keyser | Replaced neural net 2 algorithm which calculated only wind speed product with neural net 3 algorithm which calculates both wind speed and total precipitable water products (among others) but, unlike nn2, does not return a rain flag value (it does set all retrievals to missing that fail rain flag and ice contamination tests)
C> 1998-03-30 | Dennis Keyser | Modified to handle neural net 3 ssm/i products input in a products bufr data dump file; now prints out number of scans processed by satellite number in final summary
C> 1998-10-23 | Dennis Keyser | Subroutine now y2k and fortran 90 compliant
C> 1999-02-18 | Dennis Keyser | Modified to compile and run properly on ibm-sp
C> 2000-06-08 | Dennis Keyser | Corrected mnemonic for rain rate to "reqv" (was "prer" for some unknown reason)
C> 2001-01-03 | Dennis Keyser | Changed units of returned rain rate from whole mm/hr to 10**6 mm/sec, changed units of returned surface temp from whole kelvin to 10**2 kelvin (to incr. precision to that orig. in input bufr file)
C> 2004-09-12 | Dennis Keyser | Now decodes sea-surface temperature if valid into same location as surface temperature, quantity is surface temperature if surface tag is not 5, otherwise quantity is sea-surface temperature (ncep products data dump file now contains sst); checks to see if old or new version of mnemonic table bufrtab.012 is being used here (old version had "ph2o" instead of "tpwt", "sndp" instead of "tosd", "wsos" instead of "wspd" and "ch2o" instead of the sequence "metfet vilwc metfet"), and decodes using whichever mnemonics are found {note: a further requirement for "vilwc" is that the first "metfet" (meteorological feature) in the sequence must be 12 (=cloud), else cloud water set to missing, regardless of "vilwc" value}
C> 2011-08-04 | Dennis Keyser | Add ibdate (input bufr message date) to output argument list (now used by calling program prepobs_prepssmi)
C>
C> @param[in] INDTA Unit number of ncep bufr ssm/i dump data set
C> @param[in] INLSF Unit number of direct access nesdis land/sea file
C> (valid only if lbrit and either nnalg or gbalg true).
C> @param[in] INGBI Unit number of grib index file for grib file
C> Containing global 1-degree sea-surface temp field.
C> (valid only if lbrit and either nnalg or gbalg true).
C> @param[in] INGBD Unit number of grib file containing global 1-degree
C> Sea-surface temp field (valid only if lbrit and either.
C> Nnalg or gbalg true).
C> @param[in] LSAT 10-word logical array (240:249) indicating which
C> Satellite ids should be processed (see remarks)
C> @param[in] LPROD Logical indicating if the input bufr file contains
C> Products (regardless of source) - in this case one or.
C> More available products can be processed and returned.
C> @param[in] LBRIT Logical indicating if the input bufr file contains
C> Brightness temperatures - in this case b. temps are.
C> Processed and returned along with, if requested, in-.
C> Line generated products from one or both algorithms.
C> (see next two switches).
C> - The following two switches apply only if lbrit is true -----
C> @param[in] NNALG Indicating if the subroutine should
C> calculate and return ssm/i wind speed and tpw
C> via the neural net 3 algorithm (note: b o t h
C> wind speed and tpw are returned here)
C> @param[in] GBALG Indicating if the subroutine should
C> calculate and return ssm/i wind speed via the
C> goodberlet algorithm
C> @param[in] KDATE Requested earliest year(yyyy), month, day, hour,
C> Min for accepting scans.
C> @param[in] LDATE Requested latest   year(yyyy), month, day, hour,
C> Min for accepting scans.
C> @param[in] IGNRTM Switch to indicate whether scans should be time-
C> Checked (= 0) or not time checked (=1) {if =1, all.
C> Scans read in are processed regardless of their time..
C> The input arguments "kdate" and "ldate" (earliest and.
C> Latest date for processing data) are ignored in the.
C> Time checking for scans. (note: the earliest and.
C> Latest dates should still be specified to the.
C> "expected" time range, but they will not be used for.
C> Time checking in this case)}.
C> @param[out] IBUFTN Output buffer holding data for a scan (1737 words -
C> See remarks for format. some words may be missing
C> Depending upon lprod, lbrit, nnalg and gbalg
C> @param[out] IBDATE Input bufr message section 1 date (yyyymmddhh)
C> @param[out] IER Error return code (see remarks)
C>
C> @remark
C> Return code ier can have the following values:
C> - IER = 0  Successful return of scan
C> - IER = 1  All scans have been read, all done
C> - IER = 2  Abnormal return - input bufr file in unit
C> 'indta' is either empty (null) or is not bufr
C> - IER = 3  Abnormal return - requested earliest and
C> latest dates are backwards
C> - IER = 4  Abnormal return - error opening random
C> access file holding land/sea tags
C> - IER = 5  Abnormal return - the number of decoded
C> "levels" is not what is expected
C> - IER = 6  Abnormal return - sea-surface temperature
C> not found in grib index file - error returned
C> from grib decoder getgb is 96
C> - IER = 7  Abnormal return - sea-surface temperature
C> grib message has a date that is either:
C> 1) more than 7-days prior to the earliest
C> requested date or 2) more than 7-days after
C> the latest requested date
C> - IER = 8  Abnormal return - byte-addressable read error
C> for grib file containing sea-surface
C> temperature field - error returned from grib
C> decoder getgb is 97-99
C> - IER = 9  Abnormal return - error returned from grib
C> decoder - getgb - for sea-surface
C> temperature field - > 0 but not 96-99
C>
C> Input argument lsat is set-up as follows:
C> - LSAT(X) = TRUE -- Process scans from satellite id x (where x is code figure from bufr code table 0-01-007)
C> - LSAT(X) = FALSE - Do not process scans from satellite id x
C>  - X = 240 is f-7  dmsp satellite (this satellite is no longer available)
C>  - X = 241 is f-8  dmsp satellite (this satellite is no longer available)
C>  - X = 242 is f-9  dmsp satellite (this satellite is no longer available)
C>  - X = 243 is f-10 dmsp satellite (this satellite is no longer available)
C>  - X = 244 is f-11 dmsp satellite (this is available as of 8/96 but is not considered to be an operational dmsp ssm/i satellite)
C>  - X = 245 is f-12 dmsp satellite (this satellite is no longer available)
C>  - X = 246 is f-13 dmsp satellite (this is available and is considered to be an operational odd dmsp ssm/i satellite as of 8/1996)
C>  - X = 247 is f-14 dmsp satellite (this is available as of 5/97 but is not considered to be an operational dmsp ssm/i satellite)
C>  - X = 248 is f-15 dmsp satellite (this is available as of 2/2000 and is considered to be an operational odd dmsp ssm/i satellite as of 2/2000)
C>  - X = 249 is reserved for a future dmsp satellite
C>
C> @note Here "even" means value in ibuftn(1) is an odd number while "odd" means value in ibuftn(1) is an even number
C> Contents of array 'ibuftn' holding one complete scan (64 individual retrievlas (1737 words)
C>
C> #### Always returned:
C> WORD |  CONTENTS
C> ---- |  --------
C>   1  |  Satellite id (244 is f-11; 246 is f-13; 247 is f-14; 248 is f-15)
C>   2  |  4-digit year for scan
C>   3  |  2-digit month of year for scan
C>   4  |  2-digit day of month for scan
C>   5  |  2-digit hour of day for scan
C>   6  |  2-digit minute of hour for scan
C>   7  |  2-digit second of minute for scan
C>   8  |  Scan number in orbit
C>   9  |  Orbit number for scan
C>  10  |  Retrieval #1 latitude  (*100 degrees: + n, - s)
C>  11  |  Retrieval #1 longitude (*100 degrees east)
C>  12  |  Retrieval #1 position number
C>  13  |  Retrieval #1 surface tag (code figure)
C>
C> #### For LPROD = TRUE {Input products file: note all products below except sea-surface temperature are available in the fnoc "operational" products data dump; most ncep products data dumps contain only wind speed, total precipitable water, cloud water and sea-surface temperature (all over ocean only)}:
C> WORD |  CONTENTS
C> ---- |  --------
C> 14  |  Retrieval #1 cloud water (*100 kilogram/meter**2)
C> 15  |  Retrieval #1 rain rate (*1000000 millimeters/second)
C> 16  |  Retrieval #1 wind speed (*10 meters/second)
C> 17  |  Retrieval #1 soil moisture (millimeters)
C> 18  |  Retrieval #1 sea-ice concentration (per cent)
C> 19  |  Retrieval #1 sea-ice age (code figure)
C> 20  |  Retrieval #1 ice edge (code figure)
C> 21  |  Retrieval #1 total precip. water (*10 millimeters)
C> 22  |  Retrieval #1 surface temp (*100 k) if not over ocean -OR-
C> 22  |  Retrieval #1 sea-surface temp (*100 k) if over ocean
C> 23  |  Retrieval #1 snow depth (millimeters)
C> 24  |  Retrieval #1 rain flag (code figure)
C> 25  |  Retrieval #1 calculated surface type (code figure)
C>
C> #### For LBRIT = TRUE (Input brightness temperature file):
C> WORD |  CONTENTS
C> ---- |  --------
C> 26  |  Retrieval #1 19 ghz v brightness temp (*100 deg. k)
C> 27  |  Retrieval #1 19 ghz h brightness temp (*100 deg. k)
C> 28  |  Retrieval #1 22 ghz v brightness temp (*100 deg. k)
C> 29  |  Retrieval #1 37 ghz v brightness temp (*100 deg. k)
C> 30  |  Retrieval #1 37 ghz h brightness temp (*100 deg. k)
C> 31  |  Retrieval #1 85 ghz v brightness temp (*100 deg. k)
C> 32  |  Retrieval #1 85 ghz h brightness temp (*100 deg. k)
C>
C> #### For LBRIT = TRUE and NNALG = TRUE (Input brightness temperature file):
C> WORD |  CONTENTS
C> ---- |  --------
C> 33  |  Retrieval #1 Neural net 3 algorithm wind speed (generated in-line) (*10 meters/second)
C> 34  |  Retrieval #1 Neural net 3 algorithm total precip. water (generated in-line) (*10 millimeters)
C>
C> #### For LBRIT = TRUE and GBALG = TRUE (Input brightness temperature file):
C> WORD |  CONTENTS
C> ---- |  --------
C> 35  |  Retrieval #1 goodberlet algorithm wind speed (generated in-line) (*10 meters/second)
C> 36  |  Retrieval #1 goodberlet algorithm rain flag (code figure)
C> 37-1737 | Repeat 10-36 for 63 more retrievals
C>
C> @note All missing data or data not selected by calling program are set to 99999
C>
C> @author Dennis Keyser @date 1996-07-30
 
      SUBROUTINE w3miscan(INDTA,INLSF,INGBI,INGBD,LSAT,LPROD,LBRIT,
     $ NNALG,GBALG,KDATE,LDATE,IGNRTM,IBUFTN,IBDATE,IER)
 
      LOGICAL  LPROD,LBRIT,NNALG,GBALG,LSAT(240:249)
 
      CHARACTER*1  CDUMMY
      CHARACTER*2  ATXT(2)
      CHARACTER*8  SUBSET
      CHARACTER*20 RHDER,PROD2,BRITE
      CHARACTER*46 SHDER,PROD1
 
      REAL  SHDR(9),RHDR(4,64),PROD(13,64),BRIT(2,448),RINC(5),
     $ metfet(64)
 
      REAL(8)  SHDR_8(9),RHDR_8(4,64),PROD_8(13,64),BRIT_8(2,448),
     $ ufbint_8(64)
 
      INTEGER  IBUFTN(1737),KDATA(7),KDATE(5),LDATE(5),LBTER(7),
     $ kspsat(239:249),kntsat(239:249),iflag(64),kdat(8),ldat(8),
     $ mdat(8),icdate(5),iddate(5)
 
      common/misccc/sstdat(360,180)
      common/miscee/lflag,licec
 
      SAVE
 
      DATA  shder /'SAID  YEAR MNTH DAYS HOUR MINU SECO SCNN ORBN '/
      DATA  rhder /'CLAT CLON POSN SFTG '/
      DATA  prod1 /'VILWC REQV WSPD SMOI ICON ICAG ICED TPWT TMSK '/
      DATA  prod2 /'TOSD RFLG SFTP SST1 '/
      DATA  brite /'CHNM TMBR           '/
      DATA  atxt  /'NN','GB'/
      DATA  imsg  /99999/,kntscn/0/,knttim/0/,laerr/0/,
     $ loerr/0/,lbter/7*0/,itimes/0/,nlr/0/,nir/0/,dmax/-99999./,
     $ dmin/99999./,kspsat/11*0/,kntsat/11*0/,ilflg/0/,bmiss/10.0e10/
 
      IF(itimes.EQ.0)  THEN
 
C***********************************************************************
C FIRST CALL INTO SUBROUTINE DO A FEW THINGS .....
         itimes = 1
         lflag = 0
         licec = 0
         print 65, indta
   65    FORMAT(//' ---> W3MISCAN: Y2K/F90 VERSION 08/04/2011: ',
     $    'PROCESSING SSM/I DATA FROM BUFR DATA SET READ FROM UNIT ',
     $    i4/)
         IF(lprod)  print 66
   66    FORMAT(//'  ===> WILL READ FROM BUFR PRODUCTS DATA DUMP ',
     $    'FILE (EITHER FNOC OR NCEP) AND PROCESS ONE OR MORE SSM/I ',
     $    'PRODUCTS'//)
         IF(lbrit)  THEN
            print 167
  167       FORMAT(//'  ===> WILL READ FROM BUFR BRIGHTNESS ',
     $       'TEMPERATURE DATA DUMP FILE AND PROCESS BRIGHTNESS ',
     $       'TEMPERATURES'//)
            IF(nnalg)  print 169
  169       FORMAT('  ===>  IN ADDITION, WILL PERFORM IN-LINE ',
     $       'CALCULATION OF NEURAL NETWORK 3 WIND SPEED AND TOTAL ',
     $       'PRECIPITABLE WATER AND PROCESS THESE'/)
            IF(gbalg)  print 170
  170       FORMAT('  ===>  IN ADDITION, WILL PERFORM IN-LINE ',
     $       'CALCULATION OF GOODBERLET WIND SPEED AND PROCESS THESE'/)
         END IF
         IF(ignrtm.EQ.1)  print 704
  704    FORMAT(' W3MISCAN: INPUT ARGUMENT "IGNRTM" IS SET TO 1 -- NO ',
     $    'TIME CHECKS WILL BE PERFORMED ON SCANS - ALL SCANS READ IN ',
     $    'ARE PROCESSED'/)
 
         print 104, kdate,ldate
  104    FORMAT(' W3MISCAN: REQUESTED EARLIEST DATE:',i7,4i5/
     $          '           REQUESTED LATEST   DATE:',i7,4i5)
 
         kdat = 0
         kdat(1:3) = kdate(1:3)
         kdat(5:6) = kdate(4:5)
         ldat = 0
         ldat(1:3) = ldate(1:3)
         ldat(5:6) = ldate(4:5)
 
C DO REQUESTED EARLIEST AND LATEST DATES MAKE SENSE?
 
         CALL w3difdat(ldat,kdat,3,rinc)
         IF(rinc(3).LT.0)  THEN
C.......................................................................
            print 103
  103       FORMAT(' ##W3MISCAN: REQUESTED EARLIEST AND LATEST DATES ',
     $       'ARE BACKWARDS!! - IER = 3'/)
            ier = 3
            RETURN
C.......................................................................
         END IF
 
C DETERMINE MACHINE WORD LENGTH IN BYTES AND TYPE OF CHARACTER SET
C  {ASCII(ICHTP=0) OR EBCDIC(ICHTP=1)}
 
         CALL w3fi04(iendn,ichtp,lw)
         print 2213, lw, ichtp, iendn
 2213    FORMAT(/' ---> W3MISCAN: CALL TO W3FI04 RETURNS: LW = ',i3,
     $    ', ICHTP = ',i3,', IENDN = ',i3/)
 
         CALL datelen(10)
 
         CALL dumpbf(indta,icdate,iddate)
cppppp
         print *,'CENTER DATE (ICDATE) = ',icdate
         print *,'DUMP DATE (IDDATE)   = ',iddate
cppppp
 
C COME HERE IF CENTER DATE COULD NOT BE READ FROM FIRST DUMMY MESSAGE
C  - RETURN WITH IRET = 2
 
         IF(icdate(1).LE.0)  GO TO 998
 
C COME HERE IF DUMP DATE COULD NOT BE READ FROM SECOND DUMMY MESSAGE
C  - RETURN WITH IRET = 2
 
         IF(iddate(1).LE.0)  GO TO 998
         IF(icdate(1).LT.100)  THEN
 
C IF 2-DIGIT YEAR RETURNED IN ICDATE(1), MUST USE "WINDOWING" TECHNIQUE
C  TO CREATE A 4-DIGIT YEAR
 
C IMPORTANT: IF DATELEN(10) IS CALLED, THE DATE HERE SHOULD ALWAYS
C            CONTAIN A 4-DIGIT YEAR, EVEN IF INPUT FILE IS NOT
C            Y2K COMPLIANT (BUFRLIB DOES THE WINDOWING HERE)
 
            print *, '##W3MISCAN - THE FOLLOWING SHOULD NEVER ',
     $       'HAPPEN!!!!!'
            print *, '##W3MISCAN - 2-DIGIT YEAR IN ICDATE(1) RETURNED ',
     $       'FROM DUMPBF (ICDATE IS: ',icdate,') - USE WINDOWING ',
     $       'TECHNIQUE TO OBTAIN 4-DIGIT YEAR'
            IF(icdate(1).GT.20)  THEN
               icdate(1) = 1900 + icdate(1)
            ELSE
               icdate(1) = 2000 + icdate(1)
            ENDIF
            print *, '##W3MISCAN - CORRECTED ICDATE(1) WITH 4-DIGIT ',
     $       'YEAR, ICDATE NOW IS: ',icdate
         ENDIF
 
         IF(iddate(1).LT.100)  THEN
 
C IF 2-DIGIT YEAR RETURNED IN IDDATE(1), MUST USE "WINDOWING" TECHNIQUE
C  TO CREATE A 4-DIGIT YEAR
 
C IMPORTANT: IF DATELEN(10) IS CALLED, THE DATE HERE SHOULD ALWAYS
C            CONTAIN A 4-DIGIT YEAR, EVEN IF INPUT FILE IS NOT
C            Y2K COMPLIANT (BUFRLIB DOES THE WINDOWING HERE)
 
            print *, '##W3MISCAN - THE FOLLOWING SHOULD NEVER ',
     $       'HAPPEN!!!!!'
            print *, '##W3MISCAN - 2-DIGIT YEAR IN IDDATE(1) RETURNED ',
     $       'FROM DUMPBF (IDDATE IS: ',iddate,') - USE WINDOWING ',
     $       'TECHNIQUE TO OBTAIN 4-DIGIT YEAR'
            IF(iddate(1).GT.20)  THEN
               iddate(1) = 1900 + iddate(1)
            ELSE
               iddate(1) = 2000 + iddate(1)
            ENDIF
            print *, '##W3MISCAN - CORRECTED IDDATE(1) WITH 4-DIGIT ',
     $       'YEAR, IDDATE NOW IS: ',iddate
         END IF
 
C  OPEN BUFR FILE - READ IN DICTIONARY MESSAGES (TABLE A, B, D ENTRIES)
 
         CALL openbf(indta,'IN',indta)
 
         print *, '                 '
         print *, 'OPEN NCEP BUFR SSM/I DUMP FILE'
         print *, '                 '
 
C  Check to see if the old (pre 9/2004) version of the mnemonic
C   table is being used here (had "PH2O" instead of "TPWT",
C   "SNDP" instead of "TOSD", "WSOS" instead of "WSPD")
C  ------------------------------------------------------------
 
         CALL status(indta,lun,idummy1,idummy2)
         CALL nemtab(lun,'PH2O',idummy1,cdummy,iret_ph2o)
         CALL nemtab(lun,'SNDP',idummy1,cdummy,iret_sndp)
         CALL nemtab(lun,'WSOS',idummy1,cdummy,iret_wsos)
         CALL nemtab(lun,'CH2O',idummy1,cdummy,iret_ch2o)
 
         IF(lbrit.AND.(nnalg.OR.gbalg))  THEN
 
C-----------------------------------------------------------------------
C         IF IN-LINE CALC. OF WIND SPEED FROM GOODBERLET ALG. OR
C    IN-LINE CALCULATION OF WIND SPEED AND TPW FROM NEURAL NET 3 ALG.
C  FIRST CALL TO THIS SUBROUTINE WILL READ IN SEA-SURFACE TEMPERATURE
C                    FIELD AS A CHECK FOR ICE LIMITS
C            WILL ALSO OPEN DIRECT ACCESS NESDIS LAND SEA FILE
C-----------------------------------------------------------------------
 
            CALL misc06(ingbi,ingbd,kdate,ldate,*993,*994,*995,*996)
            print 67, inlsf
   67       FORMAT(//4x,'** W3MISCAN: OPEN R. ACCESS NESDIS LAND/SEA ',
     $       'FILE IN UNIT ',i2/)
         OPEN(unit=inlsf,err=997,access='DIRECT',iostat=ierr,recl=10980)
         END IF
 
C READ THE FIRST BUFR MESSAGE IN THE BUFR FILE
 
         CALL readmg(indta,subset,ibdate,iret)
 
         print *, 'READ FIRST BUFR MESSAGE: SUBSET = ',subset,
     $    '; IBDATE = ',ibdate,'; IRET = ',iret
 
         IF(iret.NE.0)  GO TO 998
 
C***********************************************************************
 
      END IF
 
   30 CONTINUE
 
C TIME TO DECODE NEXT SUBSET (SCAN) OUT OF BUFR MESSAGE
 
      ibuftn = imsg
      CALL readsb(indta,iret)
      IF(iret.NE.0)  THEN
 
C ALL SUBSETS OUT OF THIS MESSAGE READ, TIME TO MOVE ON TO NEXT MESSAGE
 
         CALL readmg(indta,subset,ibdate,iret)
 
         print *, 'READ NEXT BUFR MESSAGE: SUBSET = ',subset,
     $    '; IBDATE = ',ibdate,'; IRET = ',iret
 
         IF(iret.NE.0)  THEN
c.......................................................................
 
C NON-ZERO IRET IN READMG MEANS ALL BUFR MESSAGES IN FILE HAVE BEEN READ
C  - ALL FINISHED, NO OTHER SCANS W/I DESIRED TIME RANGE -- SET IER TO 1
C  AND RETURN TO CALLING PROGRAM
 
            print 124, kntscn
  124       FORMAT(/' W3MISCAN: +++++ ALL VALID SCANS UNPACKED AND ',
     $       'RETURNED FROM THIS NCEP BUFR SSM/I DUMP FILE'//34x,
     $       '** W3MISCAN: SUMMARY **'//35x,'TOTAL NUMBER OF SCANS ',
     $       'PROCESSED AND RETURNED',11x,i7)
            DO jj = 239,249
               IF(kntsat(jj).GT.0)  THEN
                  print  294, jj,kntsat(jj)
  294             FORMAT(35x,'......NO. OF SCANS PROCESSED AND ',
     $             'RETURNED FROM SAT',i4,':',i7)
               END IF
            END DO
            DO jj = 239,249
               IF(kspsat(jj).GT.0)  THEN
                  ii = jj
                  IF(jj.EQ.239)  ii = 1
                  print  224, ii,kspsat(jj)
  224             FORMAT(35x,'NO. OF SCANS SKIPPED DUE TO BEING FROM ',
     $             'NON-REQ SAT',i4,':',i7)
               END IF
            END DO
            print 194, knttim
  194       FORMAT(35x,'NUMBER OF SCANS SKIPPED DUE TO BEING OUTSIDE ',
     $       'TIME INT.:',i7)
            print 324, laerr,loerr
  324 FORMAT(
     $/35x,'NUMBER OF RETRIEVALS WITH LATITUDE OUT OF RANGE:       ',i7/
     $ 35x,'NUMBER OF RETRIEVALS WITH LONGITUDE OUT OF RANGE:      ',i7)
            IF(lbrit)  THEN
               IF(nnalg.OR.gbalg)  print 780, lbter,nlr,nir
  780 FORMAT(
     $ 35x,'NUMBER OF RETRIEVALS W/ ERROR IN 19 GHZ V BRIGHT. TEMP:',i7/
     $ 35x,'NUMBER OF RETRIEVALS W/ ERROR IN 19 GHZ H BRIGHT. TEMP:',i7/
     $ 35x,'NUMBER OF RETRIEVALS W/ ERROR IN 22 GHZ V BRIGHT. TEMP:',i7/
     $ 35x,'NUMBER OF RETRIEVALS W/ ERROR IN 37 GHZ V BRIGHT. TEMP:',i7/
     $ 35x,'NUMBER OF RETRIEVALS W/ ERROR IN 37 GHZ H BRIGHT. TEMP:',i7/
     $ 35x,'NUMBER OF RETRIEVALS W/ ERROR IN 85 GHZ V BRIGHT. TEMP:',i7/
     $ 35x,'NUMBER OF RETRIEVALS W/ ERROR IN 85 GHZ H BRIGHT. TEMP:',i7/
     $ 35x,'NUMBER OF RETRIEVALS REJECTED DUE TO BEING OVER LAND:  ',i7/
     $ 35x,'NUMBER OF RETRIEVALS REJECTED DUE TO BEING OVER ICE:   ',i7)
               IF(nnalg)  print 781, lflag,licec
  781 FORMAT(
     $ 35x,'NUMBER OF NN3 RETR. REJECTED DUE TO FAILING RAIN FLAG: ',i7/
     $ 35x,'NUMBER OF NN3 RETR. REJECTED DUE TO ICE CONTAMINATION: ',i7)
               IF(nnalg.OR.gbalg)  print 782, dmax,dmin
  782 FORMAT(/'  ** FOR SEA-SFC TEMP AT ALL RETRIEVAL LOCATIONS: FIELD',
     $ ' MAX =',f8.3,' DEG K, FIELD MIN =',f8.3,' DEG K'/)
            END IF
            ier = 1
            RETURN
C.......................................................................
         END IF
 
         GO TO 30
      END IF
 
C***********************************************************************
C         COME HERE FOR BOTH PRODUCTS AND BRIGHTNESS TEMPERATURES
C***********************************************************************
      shdr = bmiss
      CALL ufbint(indta,shdr_8,09,1,nlev,shder) ; shdr = shdr_8
      ilflg = 1
      IF(nlev.NE.1)  GO TO 999
 
C STORE THE SCAN'S SATELLITE ID IN WORD 1
C STORE SCAN'S YEAR (YYYY), MONTH, DAY, HOUR, MIN, SEC INTO WORDS 2-7
C STORE THE SCAN NUMBER IN WORD 8
C STORE THE SCAN'S ORBIT NUMBER IN WORD 9
 
      ibuftn(1:9) = min(imsg,nint(shdr(1:9)))
 
C CHECK TO SEE IF SCAN IS FROM REQUESTED SATELLITE ID
 
      IF(ibuftn(1).LT.240.OR.ibuftn(1).GT.249) THEN
         print 523, (ibuftn(ii),ii=1,9)
         kspsat(239) = kspsat(239) + 1
         GO TO 30
      END IF
      IF(.NOT.lsat(ibuftn(1))) THEN
CDAK     PRINT 523, (IBUFTN(II),II=1,9)
  523    FORMAT(' ##W3MISCAN: SCAN NOT FROM REQ. SAT. ID -SAT. ID',i4,
     $   ', SCAN TIME:',6i4,', SCAN',i6,', ORBIT',i8,'-GO TO NEXT SCAN')
         kspsat(ibuftn(1)) = kspsat(ibuftn(1)) + 1
         GO TO 30
      END IF
 
      IF(ignrtm.EQ.0)  THEN
 
C TIME CHECK THIS SCAN IF USER REQUESTS SUCH
 
         mdat = 0
         mdat(1:3) = ibuftn(2:4)
         mdat(5:7) = ibuftn(5:7)
         CALL w3difdat(kdat,mdat,4,rinc)
         ksec = rinc(4)
         CALL w3difdat(ldat,mdat,4,rinc)
         lsec = rinc(4)
         IF(ksec.GT.0.OR.lsec.LT.0)  THEN
 
C TIME CHECK FOR SCAN FAILED: GO ON TO NEXT SCAN
 
CDAK        PRINT 123, (IBUFTN(II),II=2,9)
  123       FORMAT(' ##W3MISCAN: SCAN NOT IN REQUESTED TIME WINDOW-',
     $    'SCAN TIME:',6i5,' SCAN',i6,', ORBIT',i8,' - GO TO NEXT SCAN')
            knttim = knttim + 1
            GO TO 30
         END IF
      END IF
      rhdr = bmiss
      CALL ufbint(indta,rhdr_8,04,64,nlev,rhder) ; rhdr = rhdr_8
      ilflg = 2
      IF(nlev.NE.64)  GO TO 999
      iflag = 0
      DO irt = 1,64
 
C THIS ROUTINE EXPECTS LONGITUDE TO BE 0-360 E; BUFR NOW RETURNS -180-0
C  FOR WEST AND 0-180 FOR EAST
 
         IF(rhdr(2,irt).LT.0.0)  rhdr(2,irt) = rhdr(2,irt) + 360.
C-----------------------------------------------------------------------
C             LOOP THROUGH THE 64 RETRIEVALS IN A SCAN
C-----------------------------------------------------------------------
C STORE THE LATITUDE (*100 DEGREES; + : NORTH, - : SOUTH)
         IF(nint(rhdr(1,irt)*100.).GE.-9000.AND.nint(rhdr(1,irt)*100.)
     $    .LE.9000)  THEN
            ibuftn((27*irt)-17) = nint(rhdr(1,irt)*100.)
         ELSE
 
C.......................................................................
 
C BAD LATITUDE
 
            laerr = laerr + 1
            print 777, irt,ibuftn(8),ibuftn(9),nint(rhdr(1,irt)*100.)
  777       FORMAT(' ##W3MISCAN: BAD LAT: RETR.',i3,', SCAN',i6,
     $       ', ORBIT',i8,'; INPUT LAT=',i7,' - ALL DATA IN THIS ',
     $       'RETRIEVAL SET TO MISSING')
            iflag(irt) = 1
C.......................................................................
 
         END IF
 
C STORE THE LONGITUDE (*100 DEGREES EAST)
 
         IF(nint(rhdr(2,irt)*100.).GE.0.AND.nint(rhdr(2,irt)*100.).LE.
     $    36000)  THEN
            IF(iflag(irt).EQ.0)
     $       ibuftn((27*irt)-16) = nint(rhdr(2,irt)*100.)
         ELSE
 
C.......................................................................
 
C BAD LONGITUDE
 
            loerr = loerr + 1
            print 778, irt,ibuftn(8),ibuftn(9),nint(rhdr(2,irt)*100.)
  778       FORMAT(' ##W3MISCAN: BAD LON: RETR.',i3,', SCAN',i6,
     $       ', ORBIT',i8,'; INPUT LON=',i7,' - ALL DATA IN THIS ',
     $       'RETRIEVAL SET TO MISSING')
            iflag(irt) = 1
C.......................................................................
 
         END IF
         IF(iflag(irt).NE.0)  GO TO 110
 
C STORE THE POSITION NUMBER
 
         ibuftn((27*irt)-15) = min(imsg,nint(rhdr(3,irt)))
 
C STORE THE SURFACE TAG (0-6)
 
         ibuftn((27*irt)-14) = min(imsg,nint(rhdr(4,irt)))
  110    CONTINUE
C-----------------------------------------------------------------------
      END DO
 
      IF(lprod)  THEN
C***********************************************************************
C      COME HERE TO PROCESS PRODUCTS FROM INPUT SSM/I PRODUCTS FILE
C***********************************************************************
 
         prod = bmiss
         CALL ufbint(indta,prod_8,13,64,nlev,prod1//prod2)
         ufbint_8 = bmiss
         IF(iret_ph2o.GT.0) THEN  ! Prior to 9/2004
            CALL ufbint(indta,ufbint_8,1,64,nlev,'PH2O')
            prod_8(8,:) = ufbint_8(:)
         END IF
         ufbint_8 = bmiss
         IF(iret_sndp.GT.0) THEN  ! Prior to 9/2004
            CALL ufbint(indta,ufbint_8,1,64,nlev,'SNDP')
            prod_8(10,:) = ufbint_8(:)
         END IF
         ufbint_8 = bmiss
         IF(iret_wsos.GT.0) THEN  ! Prior to 9/2004
            CALL ufbint(indta,ufbint_8,1,64,nlev,'WSOS')
            prod_8(3,:) = ufbint_8(:)
         END IF
         ufbint_8 = bmiss
         IF(iret_ch2o.GT.0) THEN  ! Prior to 9/2004
            CALL ufbint(indta,ufbint_8,1,64,nlev,'CH2O')
            prod_8(1,:) = ufbint_8(:)
         ELSE
            CALL ufbint(indta,ufbint_8,1,64,nlev,'METFET')
            metfet = ufbint_8
            DO irt = 1,64
               IF(nint(metfet(irt)).NE.12)  prod_8(1,irt) = bmiss
            END DO
         END IF
 
         prod=prod_8
         ilflg = 3
         IF(nlev.EQ.0)  THEN
            print 797, ibuftn(8),ibuftn(9)
  797       FORMAT(' ##W3MISCAN: PRODUCTS REQ. BUT SCAN',i6,', ORBIT',
     $       i8,' DOES NOT CONTAIN PRODUCT DATA - CONTINUE PROCESSING ',
     $       'SCAN (B.TEMPS REQ.?)')
            GO TO 900
         ELSE  IF(nlev.NE.64)  THEN
            GO TO 999
         END IF
         DO irt = 1,64
C-----------------------------------------------------------------------
C             LOOP THROUGH THE 64 RETRIEVALS IN A SCAN
C-----------------------------------------------------------------------
            IF(iflag(irt).NE.0)  GO TO 111
 
C STORE THE CLOUD WATER (*100 KG/M**2) IF AVAILABLE
 
            IF(nint(prod(01,irt)).LT.imsg)
     $       ibuftn((27*irt)-13) = nint(prod(01,irt)*100.)
 
C STORE THE RAIN RATE (*1000000 KG/((M**2)*SEC)) IF AVAILABLE
C  (THIS IS ALSO RAIN RATE (*1000000 MM/SEC))
 
            IF(nint(prod(02,irt)).LT.imsg)
     $       ibuftn((27*irt)-12) = nint(prod(02,irt)*1000000.)
 
C STORE THE WIND SPEED (*10 M/SEC) IF AVAILABLE
 
            ibuftn((27*irt)-11) = min(imsg,nint(prod(03,irt)*10.))
 
C STORE THE SOIL MOISTURE (MM) IF AVAILABLE
 
            IF(nint(prod(04,irt)).LT.imsg)
     $       ibuftn((27*irt)-10) = nint(prod(04,irt)*1000.)
 
C STORE THE SEA ICE CONCENTRATION (PERCENT) IF AVAILABLE
 
            ibuftn((27*irt)-09) = min(imsg,nint(prod(05,irt)))
 
C STORE THE SEA ICE AGE (0,1) IF AVAILABLE
 
            ibuftn((27*irt)-08) = min(imsg,nint(prod(06,irt)))
 
C STORE THE ICE EDGE (0,1) IF AVAILABLE
 
            ibuftn((27*irt)-07) = min(imsg,nint(prod(07,irt)))
 
C STORE THE WATER VAPOR (*10 KG/M**2) IF AVAILABLE
C  (THIS IS ALSO TOTAL PRECIPITABLE WATER SCALED AS *10 MM)
 
            ibuftn((27*irt)-06) = min(imsg,nint(prod(08,irt)*10.))
 
            IF(ibuftn((27*irt)-14).NE.5)  THEN
 
C STORE THE SURFACE TEMPERATURE (*100 DEGREES KELVIN) IF AVAILABLE
C  (NOTE: SURFACE TAG MUST NOT BE 5)
 
               ibuftn((27*irt)-05) = min(imsg,nint(prod(09,irt)*100.))
 
            ELSE
 
C STORE THE SEA-SURFACE TEMPERATURE (*100 DEGREES KELVIN) IF AVAILABLE
C  (NOTE: SURFACE TAG MUST BE 5)
 
               ibuftn((27*irt)-05) = min(imsg,nint(prod(13,irt)*100.))
 
            END IF
 
C STORE THE SNOW DEPTH (MM) IF AVAILABLE
 
            IF(nint(prod(10,irt)).LT.imsg)
     $       ibuftn((27*irt)-04) = nint(prod(10,irt)*1000.)
 
C STORE THE RAIN FLAG (0-3) IF AVAILABLE
 
            ibuftn((27*irt)-03) = min(imsg,nint(prod(11,irt)))
 
C STORE THE CALCULATED SURFACE TYPE (1-20) IF AVAILABLE
 
            ibuftn((27*irt)-02) = min(imsg,nint(prod(12,irt)))
  111       CONTINUE
C-----------------------------------------------------------------------
         END DO
      END IF
  900 CONTINUE
 
      IF(lbrit)  THEN
C***********************************************************************
C    COME HERE TO PROCESS BRIGHTNESS TEMPERATURES FROM INPUT SSM/I
C                   BRIGHTNESS TEMPERATURE FILE
C   AND POSSIBLY FOR IN-LINE CALC. OF WIND SPEED VIA GOODBERLET ALG.
C AND POSSIBLY FOR IN-LINE CALC. OF WIND SPEED AND TPW VIA N. NET 3 ALG.
C***********************************************************************
 
         brit = bmiss
         CALL ufbrep(indta,brit_8,2,448,nlev,brite) ; brit = brit_8
         ilflg = 4
         IF(nlev.EQ.0)  THEN
            print 798, ibuftn(8),ibuftn(9)
  798       FORMAT(' ##W3MISCAN: B. TEMPS REQ. BUT SCAN',i6,', ORBIT',
     $       i8,' DOES NOT CONTAIN B. TEMP DATA - DONE PROCESSING THIS',
     $       ' SCAN')
            GO TO 901
         ELSE  IF(nlev.NE.448)  THEN
            GO TO 999
         END IF
         DO irt = 1,64
C-----------------------------------------------------------------------
C             LOOP THROUGH THE 64 RETRIEVALS IN A SCAN
C-----------------------------------------------------------------------
            IF(iflag(irt).NE.0)  GO TO 112
 
C STORE THE 7 BRIGHTNESS TEMPS (*100 DEGREES KELVIN)
C  -- CHANNELS ARE IN THIS ORDER FOR A PARTICULAR RETRIEVAL:
C  19 GHZ V, 19 GHZ H, 22 GHZ V, 37 GHZ V, 37 GHZ H, 85 GHZ V, 85 GHZ H
 
            igood = 0
            mindx = (irt * 7) - 6
            DO lch = mindx,mindx+6
               ichnn = nint(brit(1,lch))
               IF(ichnn.GT.7)  GO TO 79
               IF(nint(brit(2,lch)).LT.imsg)  THEN
                  ibuftn((27*irt)-02+ichnn) = nint(brit(2,lch)*100.)
                  igood = 1
               END IF
   79          CONTINUE
            END DO
 
            IF(nnalg.OR.gbalg)  THEN
               kdata = imsg
               IF(igood.EQ.1)  THEN
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  COME HERE FOR IN-LINE CALC. OF WIND SPEED VIA GOODBERLET ALG. AND/OR
C      FOR IN-LINE CALC. OF WIND SPEED AND TPW VIA NEURAL NET 3 ALG.
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
C GET LAND/SEA TAG AND CHECK FOR LAT/LON OVER LAND OR ICE
 
             balon=real(mod(ibuftn((27*irt)-16)+18000,36000)-18000)/100.
                  ialon = mod(36000-ibuftn((27*irt)-16),36000)
                  ix = 361. - real(ialon)/100.
                  jy = 91 - nint(real(ibuftn((27*irt)-17))/100. + 0.50)
                  dmin = min(dmin,sstdat(ix,jy))
                  dmax = max(dmax,sstdat(ix,jy))
           CALL misc04(inlsf,real(ibuftn((27*irt)-17))/100.,balon,lstag)
 
C      ..... REJECT IF OVER LAND (USE LAND/SEA TAG HERE)
 
                  IF(lstag.NE.0)  THEN
                     nlr = nlr + 1
                     GO TO 112
                  END IF
 
C      ..... REJECT IF OVER ICE (USE SEA-SURFACE TEMPERATURE HERE)
 
                  IF(sstdat(ix,jy).LE.272.96)  THEN
                     nir = nir + 1
                     GO TO 112
                  END IF
 
                  kdata = ibuftn((27*irt)-01:(27*irt)+05)
                  DO it = 1,7
                     IF((it.NE.2.AND.kdata(it).LT.10000).OR.
     $                  (it.EQ.2.AND.kdata(it).LT. 8000))  THEN
                        lbter(it) = lbter(it) + 1
                       print 779,it,ibuftn(8),ibuftn(9),kdata
  779 FORMAT(' ##W3MISCAN: BT, CHN',i2,' BAD: SCAN',i6,', ORBIT',i8,
     $ '; BT:',7i6,'-CANNOT CALC. PRODS VIA ALG.')
                        GO TO 112
                     END IF
                  END DO
 
C CALL SUBR. MISC01 TO INITIATE IN-LINE PRODUCT CALCULATION
 
                  CALL misc01(nnalg,gbalg,kdata,swnn,tpwnn,swgb,nrfgb)
 
                  IF(nnalg)  THEN
CDAK                 IF(MOD(KNTSCN,100).EQ.0)  PRINT 6021, ATXT(1),SWNN,
CDAK $                TPWNN,REAL(KDATA(1))/100.,(REAL(KDATA(KKK))/100.,
CDAK $                KKK=3,5),(REAL(KDATA(4)-KDATA(5)))/100.
 6021 FORMAT(' W3MISCAN: ',a2,' SPD',f6.1,'  TPW',f6.1,'  TB19V',f6.1,
     $ '  TB22V',f6.1,'  TB37V',f6.1,'  TB37H',f6.1,'  TD37',f5.1)
 
C STORE THE CALCULATED NEURAL NET 3 WIND SPEED (*10 M/SEC)
 
                     ibuftn((27*irt)+6) = min(imsg,nint(swnn*10.))
 
C STORE THE CALCULATED NEURAL NET 3 TPW (*10 MILLIMETERS)
 
                     ibuftn((27*irt)+7) = min(imsg,nint(tpwnn*10.))
                  END IF
 
                  IF(gbalg)  THEN
CDAK                 IF(MOD(KNTSCN,100).EQ.0)  PRINT 602, ATXT(2),NRFGB,
CDAK $                SWGB,REAL(KDATA(1))/100.,(REAL(KDATA(KKK))/100.,
CDAK $                KKK=3,5),(REAL(KDATA(4)-KDATA(5)))/100.
  602 FORMAT(' W3MISCAN: ',a2,' RF, SPD',i2,f6.1,'  TB19V',f6.1,
     $ '  TB22V',f6.1,'  TB37V',f6.1,'  TB37H',f6.1,'  TD37',f5.1)
 
C STORE THE CALCULATED GOODBERLET WIND SPEED (*10 M/SEC)
 
                     ibuftn((27*irt)+8) = min(imsg,nint(swgb*10.))
 
C STORE THE GOODBERLET RAIN FLAG (0-3)
 
                     ibuftn((27*irt)+9) = min(imsg,nrfgb)
                  END IF
 
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
               ELSE
 
C......................................................................
 
C PROBLEM - CAN'T CALCULATE PRODUCTS VIA ANY ALG., ALL B.TEMPS MISSING
 
                  print 879, ibuftn(8),ibuftn(9),kdata
  879             FORMAT(' ##W3MISCAN: ALL B.TMPS MSSNG: SCAN',i6,', ',
     $             'ORBIT',i8,'; BT:',7i6,'-CANNOT CALC PRODS VIA ALG.')
C......................................................................
 
               END IF
            END IF
 
  112       CONTINUE
C-----------------------------------------------------------------------
         END DO
      END IF
C***********************************************************************
  901 CONTINUE
 
C RETURN TO CALLING PROGRAM - IER = 0 SCAN SUCCESSFULLY READ
 
      kntscn = kntscn + 1
      kntsat(ibuftn(1)) = kntsat(ibuftn(1)) + 1
      ier = 0
      RETURN
 
C.......................................................................
  993 CONTINUE
 
C PROBLEM: SEA-SURFACE TEMPERATURE NOT FOUND IN GRIB INDEX FILE - ERROR
C          RETURNED FROM GRIB DECODER GETGB IS 96 - SET IER = 6 & RETURN
 
      print 2008, ingbi
 2008 FORMAT(/' ##W3MISCAN: SEA-SURFACE TEMPERATURE NOT FOUND IN GRIB ',
     $ 'INDEX FILE IN UNIT ',i2,' - IER = 6'/)
      ier = 6
      RETURN
 
C.......................................................................
  994 CONTINUE
 
C PROBLEM: SEA-SURFACE TEMPERATURE GRIB MESSAGE HAS A DATE THAT IS
C          EITHER: 1) MORE THAN 7-DAYS PRIOR TO THE EARLIEST REQ. DATE
C          (INPUT ARG. "KDATE") OR 2) MORE THAN 7-DAYS AFTER THE LATEST
C          REQ. DATE (INPUT ARG. "LDATE") - SET IER = 7 AND RETURN
 
      print 2009
 2009 FORMAT('           SST GRIB MSG HAS DATE WHICH IS EITHER 7-DAYS',
     $ ' PRIOR TO EARLIEST REQ. DATE'/14x,'OR 7-DAYS LATER THAN LATEST',
     $ ' REQ. DATE - IER = 7'/)
      ier = 7
      RETURN
 
C.......................................................................
  995 CONTINUE
 
C PROBLEM: BYTE-ADDRESSABLE READ ERROR FOR GRIB FILE CONTAINING SEA-
C          SURFACE TEMPERATURE FIELD - ERROR RETURNED FROM GRIB DECODER
C          GETGB IS 97-99 - SET IER = 8 AND RETURN
 
      print 2010
 2010 FORMAT('           BYTE-ADDRESSABLE READ ERROR FOR GRIB FILE ',
     $ 'CONTAINING SEA-SURFACE TEMPERATURE FIELD - IER = 8'/)
      ier = 8
      RETURN
 
C.......................................................................
  996 CONTINUE
 
C PROBLEM: ERROR RETURNED FROM GRIB DECODER - GETGB - FOR SEA-SURFACE
C          TEMPERATURE FIELD - > 0 BUT NOT 96-99 - SET IER = 9 & RETURN
 
      print 2011
 2011 FORMAT('           - IER = 9'/)
      ier = 9
      RETURN
 
C.......................................................................
  997 CONTINUE
 
C PROBLEM: ERROR OPENING R. ACCESS FILE HOLDING LAND/SEA TAGS - SET IER
C          = 4 AND RETURN
 
      print 2012, ierr,inlsf
 2012 FORMAT(/' ##W3MISCAN: ERROR OPENING R. ACCESS LAND/SEA FILE IN ',
     $ 'UNIT ',i2,' -- IOSTAT =',i5,' -- NO SCANS PROCESSED - IER = 4'/)
      ier = 4
      RETURN
 
C.......................................................................
  998 CONTINUE
 
C PROBLEM: THE INPUT DATA SET IS EITHER EMPTY (NULL), NOT BUFR, OR
C          CONTAINS NO DATA MESSAGES - SET IER = 2 AND RETURN
 
      print 14, indta
   14 FORMAT(/' ##W3MISCAN: SSM-I DATA SET IN UNIT',i3,' IS EITHER ',
     $'EMPTY (NULL), NOT BUFR, OR CONTAINS NO DATA MESSAGES - IER = 2'/)
      ier = 2
      RETURN
 
C.......................................................................
  999 CONTINUE
 
C PROBLEM: THE NUMBER OF DECODED "LEVELS" IS NOT WHAT IS EXPECTED - SET
C          IER = 5 AND RETURN
 
      print 217, nlev,ilflg
  217 FORMAT(/' ##W3MISCAN: THE NUMBER OF DECODED "LEVELS" (=',i5,') ',
     $ 'IS NOT WHAT IS EXPECTED (ILFLG=',i1,') - IER = 5'/)
      ier = 5
      RETURN
 
C.......................................................................
      END
C> @brief Prepares for in-line caluclation of prods.
C> @author Dennis Keyser @date 1995-01-04
 
C> Based on input 7-channel ssm/i brightness temperatures,
C> determines the rain flag category for wind speed product for the
C> goodberlet algorithm. Then calls the appropriate function to
C> calculate either the wind speed product for the goodberlet
C> algorithm (if requested) or the wind speed and tpw products for
C> the neural net 3 algorithm (if requested).
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> ????-??-?? | W. Gemmill | (w/nmc21) -- original author
C> 1995-01-04 | Dennis Keyser | -- incorporated into w3miscan and
C> streamlined code
C> 1996-05-07 | Dennis Keyser | (np22) -- in-line neural network 1 algoritm
C> replaced by neural network 2 algorithm
C> 1996-07-30 | Dennis Keyser | (np22) -- can now process wind speed from
C> both algorithms if desired
C> 1998-01-28 | Dennis Keyser | (np22) -- replaced neural net 2 algorithm
C> which calculated only wind speed product with neural net 3
C> algorithm which calculates both wind speed and total
C> precipitable water products (among others) but, unlike nn2,
C> does not return a rain flag value (it does set all retrievals
C> to missing that fail rain flag and ice contamination tests)
C>
C> @param[in] NNALG Process wind speed and tpw via neural net 3 algorithm if true
C> @param[in] GBALG Process wind speed via goodberlet algorithm if true
C> @param[in] KDATA 7-word array containing 7 channels of brightness temperature (kelvin x 100)
C> @param[out] SWNN  alculated wind speed based on neural net 3 algorithm (meters/second)
C> @param[out] TPWNN Calculated total column precipitable water based on neural net 3 algorithm (millimeters)
C> @param[out] SWGB Calculated wind speed based on goodberlet algorith (meters/second)
C> @param[out] NRFGB Rain flag category for calculated wind speed from goodberlet algorithm
C>
C> @remark If an algorithm is not chosen, the output products are set
C> to values of 99999. for that algorithm and, for the goodberlet
C> algorithm only, the rain flag is set to 99999. Called by
C> subroutine w3miscan().
C>
C> @author Dennis Keyser @date 1995-01-04
      SUBROUTINE misc01(NNALG,GBALG,KDATA,SWNN,TPWNN,SWGB,NRFGB)
      LOGICAL  NNALG,GBALG
      REAL  BTA(4),BTAA(7)
      INTEGER  KDATA(7)
 
      common/miscee/lflag,licec
 
      SAVE
 
      swnn  = 99999.
      tpwnn = 99999.
      swgb  = 99999.
      nrfgb = 99999
 
      tb19v = real(kdata(1))/100.
      tb19h = real(kdata(2))/100.
      tb22v = real(kdata(3))/100.
      tb37v = real(kdata(4))/100.
      tb37h = real(kdata(5))/100.
      tb85v = real(kdata(6))/100.
      tb85h = real(kdata(7))/100.
      td37  = tb37v - tb37h
 
      IF(nnalg)  THEN
C COMPUTE WIND SPEED FROM NEURAL NET 2 ALGORITHM (1995)
C  (no longer a possibility - subr. expects dim. of 5 on BTAA)
cdak     NRFNN = 1
cdak     IF(TB19H.LE.185.0.AND.TB37H.LE.210.0.AND.TB19V.LT.TB37V)
cdak $      NRFNN = 0
cdak     BTAA(1) = TB19V
cdak     BTAA(2) = TB22V
cdak     BTAA(3) = TB37V
cdak     BTAA(4) = TB37H
cdak     BTAA(5) = TB85V
cdak     SWNN = RISC02xx(BTAA)
 
C COMPUTE WIND SPEED AND TPW FROM NEURAL NET 3 ALGORITHM (1997)
         btaa(1) = tb19v
         btaa(2) = tb19h
         btaa(3) = tb22v
         btaa(4) = tb37v
         btaa(5) = tb37h
         btaa(6) = tb85v
         btaa(7) = tb85h
         swnn = risc02(btaa,tpwnn,lqwnn,sstnn,jerr)
         IF(jerr.EQ.1)  lflag = lflag + 1
         IF(jerr.EQ.2)  licec = licec + 1
      END IF
 
      IF(gbalg)  THEN
C COMPUTE WIND SPEED FROM GOODBERLET ALGORITHM
         nrfgb = 0
         IF(td37.LE.50.0.OR.tb19h.GE.165.0)  THEN
            IF(td37.LE.50.0.OR.tb19h.GE.165.0)  nrfgb = 1
            IF(td37.LE.37.0)  nrfgb = 2
            IF(td37.LE.30.0)  nrfgb = 3
         END IF
         bta(1) = tb19v
         bta(2) = tb22v
         bta(3) = tb37v
         bta(4) = tb37h
         swgb = risc03(bta)
      END IF
 
      RETURN
      END
C> @brief Calc. ssm/i prods from neural net 3 alg.
C> @author V. Krasnopolsky @date 1997-02-02
 
C> This retrieval algorithm is a neural network implementation
C> of the ssm/i transfer function. It retrieves the wind speed (w)
C> at the height 20 meters, columnar water vapor (v), columnar liquid
C> water (l) and sst. The nn was trained using back-propagation
C> algorithm. Transfer function is described and compared with
C> cal/val and other algorithms in omb technical note no. 137. See
C> remarks for detailed info on this algorithm. This is an improved
C> version of the earlier neural network 2 algorithm.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1997-02-02 | V. Krasnopolsky | Initial.
C>
C> @param[in] XT 7-word array containing brightness temperature in the order:
C> t19v (word 1), t19h (word 2), t22v (word 3), t37v (word 4), t37h (word 5),
C> t85v (word 6), t85h (word 7) (all in kelvin)
C> @param[in] V Columnar water vapor (total precip. water) (mm)
C> @param[in] L Columnar liquid water (mm)
C> @param[in] SST Sea surface temperature (deg. c)
C> @param[in] JERR Error return code:
C> - = 0 -- Good retrievals
C> - = 1 -- Retrievals could not be made due to one or
C> more brightness temperatures out of range
C> (i.e, failed the rain flag test)
C> - = 2 -- Retrievals could not be made due to ice
C> contamination
C> {for either 1 or 2 above, all retrievals set to
C> 99999. (missing)}
C>
C> @remark Function, called by subroutine misc01.
C> Description of training and test data set:
C> ------------------------------------------
C> The training set consists of 3460 matchups which were received
C> from two sources:
C> - 1.  3187 F11/SSMI/buoy matchups were filtered out from a
C> preliminary version of the new NRL database which was
C> kindly provided by G. Poe (NRL). Maximum available wind
C> speed is 24 m/s.
C> - 2.  273 F11/SSMI/OWS matchups were filtered out from two
C> datasets collected by high latitude OWS LIMA and MIKE.
C> These data sets were kindly provided by D. Kilham
C> (University of Bristol).  Maximum available wind speed
C> is 26.4 m/s.
C>
C> Satellite data are collocated with both buoy and OWS data in
C> space within 15 km and in time within 15 min.
C>
C> The test data set has the same structure, the same number of
C> matchups and maximum buoy wind speed.
C>
C> Description of retrieval flags:
C> -------------------------------
C> Retrieval flags by Stogryn et al. are used.  The algorithm
C> produces retrievals under CLEAR + CLOUDY conditions, that is
C> if:
C> - T37V - T37H > 50.   => CLEAR condition -or-
C> - T37V - T37H =< 50.|
C> - T19H =< 185.  and |
C> - T37H =< 210.  and | => CLOUDY conditions
C> - T19V  < T37V      |
C>
C> @author V. Krasnopolsky @date 1997-02-02
      FUNCTION risc02(XT,V,L,SST,JERR)
      parameter(iout =4)
      LOGICAL  lq1,lq2,lq3,lq4
      REAL  xt(7),y(iout),v,l,sst
      equivalence(y(1),spn)
 
      jerr = 0
 
C --------  Retrieval flag (Stogryn) -------------------------
 
C  T19H =< 185
 
      lq1 = (xt(2).LE.185.)
 
C  T37H =< 210
 
      lq2 = (xt(5).LE.210.)
 
C  T19V < T37V
 
      lq3 = (xt(1).LT.xt(4))
 
C  T37V - T37H =< 50.
 
      lq4 = ((xt(4) - xt(5)).LE.50.)
      lq1 = (lq1.AND.lq2.AND.lq3)
      IF(.NOT.lq1.AND.lq4) THEN
         spn  = 99999.
         v    = 99999.
         l    = 99999.
         sst  = 99999.
         jerr = 1
         GO TO 111
      END IF
 
C --------------- Call NN ----------------------
 
C  NN WIND SPEED
 
      CALL misc10(xt,y)
      v   = y(2)
      l   = y(3)
      sst = y(4)
 
C --------- Remove negative values  ----------------------------
 
      IF(spn.LT.0.0)  spn = 0.0
      IF(sst.LT.0.0)  sst = 0.0
      IF(v  .LT.0.0)  v   = 0.0
 
C ------ Remove ice contamination ------------------------------------
 
      ice = 0
      si85 = -174.4 + (0.715 * xt(1)) + (2.439 * xt(3)) - (0.00504 *
     $  xt(3) * xt(3)) - xt(6)
      tt = 44. + (0.85 * xt(1))
      IF(si85.GE.10.)  THEN
         IF(xt(3).LE.tt)  ice = 1
         IF((xt(3).GT.264.).AND.((xt(3)-xt(1)).LT.2.))  ice = 1
      END IF
      IF(ice.EQ.1)  THEN
         spn = 99999.
         v   = 99999.
         l   = 99999.
         sst = 99999.
         jerr = 2
      END IF
 
  111 CONTINUE
 
      risc02 = spn
 
      RETURN
      END
C> @brief Calc. ssm/i prods from neural net 3 alg.
C> @author V. Krasnopolsky @date 1996-07-15
 
C> This nn calculates w (in m/s), v (in mm), l (in mm), and
C> sst (in deg c). This nn was trained on blended f11 data set
C> (ssmi/buoy matchups plus ssmi/ows matchups 15 km x 15 min) under
C> clear + cloudy conditions.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1996-07-15 | V. Krasnopolsky | Initial.
C>
C> @param[in] X 5-word array containing brightness temperature in the
C> order: t19v (word 1), t19h (word 2), t22v (word 3),
C> t37v (word 4), t37h (word 5) (all in kelvin)
C> @param[out] Y 4-word array containing calculated products in the
C> order: wind speed (m/s) (word 1), columnar water
C> vapor (total precip. water) (mm) (word 2),  columnar
C> liquid water (mm) (word 3), sea surface temperature
C> (deg. c) (word 4)
C>
C> @remark Called by subroutine risc02().
C>
C> @author V. Krasnopolsky @date 1996-07-15
      SUBROUTINE misc10(X,Y)
      INTEGER  HID,OUT
 
C IN IS THE NUMBER OF NN INPUTS, HID IS THE NUMBER OF HIDDEN NODES,
C  OUT IS THE NUMBER OF OUTPUTS
 
      parameter(in =5, hid =12, out =4)
      dimension  x(in),y(out),w1(in,hid),w2(hid,out),b1(hid),b2(out),
     $ o1(in),x2(hid),o2(hid),x3(out),o3(out),a(out),b(out)
 
C W1 HOLDS INPUT WEIGHTS
 
      DATA ((w1(i,j),j = 1,hid),i = 1,in)/
     $-0.0435901, 0.0614709,-0.0453639,-0.0161106,-0.0271382, 0.0229015,
     $-0.0650678, 0.0704302, 0.0383939, 0.0773921, 0.0661954,-0.0643473,
     $-0.0108528,-0.0283174,-0.0308437,-0.0199316,-0.0131226, 0.0107767,
     $ 0.0234265,-0.0291637, 0.0140943, .00567931,-.00931768,
     $-.00860661, 0.0159747,-0.0749903,-0.0503523, 0.0524172, 0.0195771,
     $ 0.0302056, 0.0331725, 0.0326714,-0.0291429, 0.0180438, 0.0281923,
     $-0.0269554, 0.102836,  0.0591511, 0.134313, -0.0109854,-0.0786303,
     $ 0.0117111, 0.0231543,-0.0205603,-0.0382944,-0.0342049,
     $ 0.00052407,0.110301, -0.0404777, 0.0428816, 0.0878070, 0.0168326,
     $ 0.0196183, 0.0293995, 0.00954805,-.00716287,0.0269475,
     $-0.0418217,-0.0165812, 0.0291809/
 
C W2 HOLDS HIDDEN WEIGHTS
 
      DATA ((w2(i,j),j = 1,out),i = 1,hid)/
     $-0.827004, -0.169961,-0.230296, -0.311201, -0.243296, 0.00454425,
     $ 0.950679,  1.09296,  0.0842604, 0.0140775, 1.80508, -0.198263,
     $-0.0678487, 0.428192, 0.827626,  0.253772,  0.112026, 0.00563793,
     $-1.28161,  -0.169509, 0.0019085,-0.137136, -0.334738, 0.224899,
     $-0.189678,  0.626459,-0.204658, -0.885417, -0.148720, 0.122903,
     $ 0.650024,  0.715758, 0.735026, -0.123308, -0.387411,-0.140137,
     $ 0.229058,  0.244314,-1.08613,  -0.294565, -0.192568, 0.608760,
     $-0.753586,  0.897605, 0.0322991,-0.178470,  0.0807701,
     $-0.781417/
 
C B1 HOLDS HIDDEN BIASES
 
      DATA (b1(i), i=1,hid)/
     $ -9.92116,-10.3103,-17.2536,  -5.26287, 17.7729,-20.4812,
     $ -4.80869,-11.5222,  0.592880,-4.89773,-17.3294, -7.74136/
 
C B2 HOLDS OUTPUT BIAS
 
      DATA (b2(i), i=1,out)/-0.882873,-0.0120802,-3.19400,1.00314/
 
C A(OUT), B(OUT) HOLD TRANSFORMATION COEFFICIENTS
 
      DATA (a(i), i=1,out)/18.1286,31.8210,0.198863,37.1250/
      DATA (b(i), i=1,out)/13.7100,32.0980,0.198863,-5.82500/
 
C INITIALIZE
 
      o1 = x
 
C START NEURAL NETWORK
 
C  - INITIALIZE X2
 
      DO i = 1,hid
         x2(i) = 0.
         DO j = 1,in
            x2(i) = x2(i) + (o1(j) * w1(j,i))
         END DO
         x2(i) = x2(i) + b1(i)
         o2(i) = tanh(x2(i))
      END DO
 
C - INITIALIZE X3
 
      DO k = 1,out
         x3(k) = 0.
         DO j = 1,hid
            x3(k) = x3(k) + (w2(j,k) * o2(j))
         END DO
 
         x3(k) = x3(k) + b2(k)
 
C --- CALCULATE O3
 
         o3(k) = tanh(x3(k))
         y(k) = (a(k) * o3(k)) + b(k)
      END DO
 
      RETURN
      END
C> @brief Calc. wspd from neural net 2 algorithm
C> @author V. Krasnopolsky @date 1996-05-07
 
C> Calculates a single neural network output for wind speed.
C> the network was trained on the whole data set without any
C> separation into subsets. It gives rms = 1.64 m/s for training set
C> and 1.65 m/s for testing set. This is an improved version of the
C> earlier neural network 1 algorithm.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1994-03-20 | V. Krasnopolsky | Initial.
C> 1995-05-07 | V. Krasnopolsky | Replaced with neural net 2 algorithm.
C>
C> @param[in] X 5-Word array containing brightness temperature in the
C> order: t19v (word 1), t22v (word 2), t37v (word 3),
C> t37h (word 4), t85v (word 5) (all in kelvin)
C> @return XX Wind speed (meters/second)
C>
C> @remark Function, no longer called by this program. It is here
C> simply to save neural net 2 algorithm for possible later use
C> (has been replaced by neural net 3 algorithm, see subr. risc02
C> and misc10).
C>
C> @author V. Krasnopolsky @date 1996-05-07
      FUNCTION risc02xx(X)
      INTEGER  hid
C IN IS THE NUMBER OF B. TEMP. CHNLS, HID IS THE NUMBER OF HIDDEN NODES
      parameter(in =5, hid =2)
      dimension  x(in),w1(in,hid),w2(hid),b1(hid),o1(in),x2(hid),o2(hid)
 
      SAVE
 
C W1 HOLDS INPUT WEIGHTS
      DATA ((w1(i,j),j=1,hid),i=1,in)/
     $ 4.402388e-02, 2.648334e-02, 6.361322e-04,-1.766535e-02,
     $ 7.876555e-03,-7.387260e-02,-2.656543e-03, 2.957161e-02,
     $-1.181134e-02, 4.520317e-03/
C W2 HOLDS HIDDEN WEIGHTS
      DATA (w2(i),i=1,hid)/8.705661e-01,1.430968/
C B1 HOLDS HIDDEN BIASES
      DATA (b1(i),i=1,hid)/-6.436114,8.799655/
C B2 HOLDS OUTPUT BIAS
C AY AND BY HOLD OUTPUT TRANSFORMATION COEFFICIENTS
      DATA  b2/-0.736255/,ay/16.7833/,by/11.08/
      o1 = x
C INITIALIZE
      x3 = 0.
      DO i = 1, hid
         o2(i) = 0.
         x2(i) = 0.
         DO j = 1,in
            x2(i) = x2(i) + (o1(j) * w1(j,i))
         END DO
         x2(i) = x2(i) + b1(i)
         o2(i) = tanh(x2(i))
         x3 = x3 + (o2(i)* w2(i))
      END DO
      x3 = x3 + b2
      o3 = tanh(x3)
      risc02xx = (ay * o3) + by
      risc02xx = max(risc02xx,0.0)
C BIAS CORRECTION
      bias = 0.5 + 0.004*((risc02xx-10.)**3)*(1.-exp(-0.5*risc02xx))
      risc02xx = risc02xx + bias
      RETURN
      END
C> @brief Calc. w.spd from b temp.- goodberlet alg.
C> @author W. Gemmill @date 1994-08-15
 
C> Calculates a single goodberlet output for wind speed.
C> This is a linear regression algorithm from 1989.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1994-08-15 | W. Gemmill | Initial.
C>
C> @param[in] X 4-word array containing brightness temperature in the
C> order: t19v (word 1), t22v (word 2), t37v (word 3),
C> t37h (word 4) (all in kelvin)
C> @return XX Wind speed (meters/second)
C>
C> @remark Function, called by subroutine misc01.
C>
C> @author W. Gemmill @date 1994-08-15
      FUNCTION risc03(X)
      dimension  x(4)
 
      SAVE
 
      risc03 = 147.90 + (1.0969 * x(1)) - (0.4555 * x(2)) -
     $ (1.76 * x(3)) + (0.7860 * x(4))
      RETURN
      END
C> @brief Returns land/sea tag for given lat/lon
C> @author Dennis Keyser @date 1995-01-04
 
C> Finds and returns the low resolution land/sea tag nearest
C> to the requested latitude and longitude.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1978-01-20 | J. K. Kalinowski (S11213) | Original author
C> 1978-10-03 | J. K. Kalinowski (S1214) | Changes unknown
C> 1985-03-01 | N. Digirolamo (SSAI) | Conversion to vs fortran
C> 1995-01-04 | Dennis Keyser | Incorporated into w3miscan and streamlined code
C>
C> @param[in] INLSF Unit number of direct access nesdis land/sea file
C> @param[in] BLAT Latitude (whole degrees: range is 0. to +90. north,
C> 0. to -90. south)
C> @param[in] BLNG Longitude (whole degrees: range is 0. to +179.99 east,
C> 0. to -180. west)
C> @param[out] LSTAG Land/sea tag {=0 - sea; =1 - land; =2 - coastal
C> interface (higher resolution tags are available);
C> =3 - coastal interface (no higher resolution tags
C> exist)}
C>
C> @remark Called by subroutine w3miscan.
C>
C> @author Dennis Keyser @date 1995-01-04
      SUBROUTINE misc04(INLSF,BLAT,BLNG,LSTAG)
      CHARACTER*1  LPUT
      REAL  RGS(3)
C LPUT CONTAINS A REGION OF LAND/SEA TAGS (RETURNED FROM CALL TO MISC05)
      common/miscdd/lput(21960)
 
      SAVE
 
C RGS IS ARRAY HOLDING SOUTHERN BOUNDARIES OF EACH LAND/SEA TAG REGION
      DATA  rgs/-85.,-30.,25./,numrgl/0/,iflag/0/
C INITIALIZE LAND/SEA TAG AS 1 (OVER LAND)
      lstag = 1
C FIND NEAREST POINT OF A HALF-DEGREE (LAT,LONG) GRID
C ..ALAT IS LATITUDE TO THE NEAREST HALF-DEGREE
      alat = int((blat+sign(.25,blat))/.5) * .5
C ..ALNG IS LONGITUDE TO THE NEAREST HALF-DEGREE
      alng = int((blng+sign(.25,blng))/.5) * .5
      IF(nint(alng*10.).EQ.1800)  alng = -180.
C IDENTIFY DATABASE REGION IN WHICH TO FIND CORRECT TAG
      numrgn = 1
      IF(iabs(nint(alat*10)).GT.850)  THEN
         RETURN
      ELSE  IF(nint(alat*10).GT.275)  THEN
         numrgn = 3
      ELSE  IF(nint(alat*10.).GE.-275)  THEN
         numrgn = 2
      END IF
      IF(numrgn.NE.numrgl.OR.iflag.EQ.1)  THEN
         numrgl = numrgn
         CALL misc05(inlsf,numrgn,*99)
      END IF
C FIND THE BYTE & BIT PAIR W/I DATA BASE REGION CONTAINING DESIRED TAG
      trm1  = ((alat - rgs(numrgn)) * 1440.) + 360.
      lstpt = trm1 + (2. * alng)
C ..NBYTE IS THE BYTE IN LPUT CONTAINING THE TAG
      nbyte = (180 * 8) + (lstpt/4 * 8)
      nshft = (2 * (mod(lstpt,4) + 1)) - 2
C PULL OUT THE TAG
      CALL gbyte(lput,lstag,nbyte+nshft,2)
      iflag = 0
      RETURN
C-----------------------------------------------------------------------
   99 CONTINUE
C COME HERE IF LAND/SEA TAG COULD NOT BE RETURNED FROM SUBR. W3MISCAN
C  (IN THIS CASE IT WILL REMAIN SET TO 1 INDICATING OVER LAND)
      iflag = 1
      RETURN
C-----------------------------------------------------------------------
      END
C> @brief Reads 2 records from land/sea tag database
C> @author Dennis Keyser @date 195-01-04
 
C> Reads two records from a low resolution land/sea database and stores into common.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1978-01-20 | J. K. Kalinowski (S11213) | Original author
C> 1995-01-04 | Dennis Keyser | Incorporated into w3miscan and
C> streamlined code; modified to be machine independent thru
C> use of standard fortran direct access read
C>
C> @param[in] INLSF Unit number of direct access nesdis land/sea file
C> @param[in] NUMRGN The region (1,2 or 3) of the database to be accessed
C> (dependent on latitude band)
C>
C> @remark Called by subroutne misc04.
C>
C> @author Dennis Keyser @date 195-01-04
      SUBROUTINE misc05(INLSF,NUMRGN,*)
      CHARACTER*1  LPUT
 
C LPUT CONTAINS A REGION OF LAND/SEA TAGS (COMPRISED OF 2 RECORDS FROM
C  LAND/SEA FILE) -- 180 BYTES OF DOCUMENTATION FOLLOWED BY 21780 BYTES
C  OF LAND/SEA TAGS
 
      common/miscdd/lput(21960)
 
      SAVE
 
      nrec = (2 * numrgn) - 1
      READ(inlsf,rec=nrec,err=10)  (lput(ii),ii=1,10980)
      nrec = nrec + 1
      READ(inlsf,rec=nrec,err=10)  (lput(ii),ii=10981,21960)
      RETURN
C-----------------------------------------------------------------------
   10 CONTINUE
C ERROR READING IN A RECORD FROM LAND-SEA FILE -- RETURN (TAG WILL BE
C  SET TO 1 MEANING OVER LAND IN THIS CASE)
      print 1000, nrec,inlsf
 1000 FORMAT(' ##W3MISCAN/MISC05: ERROR READING IN LAND-SEA DATA ',
     $ 'RECORD',i7,' IN UNIT ',i2,' -- SET TAG TO LAND'/)
      RETURN 1
C-----------------------------------------------------------------------
      END
C> @brief Reads in nh and sh 1-deg. sea-sfc temps.
C> @author Dennis Keyser @date 200-02-18
 
C> Reads in global sea-surface temperature field on a one-degree grid from grib file.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> ????-??-?? | W. Gemmill (NP21) | Original author
C> 1995-01-04 | Dennis Keyser | Incorporated into w3miscan and
C> streamlined code; converted sst input file from vsam/on84 to
C> grib to allow code compile and run on the cray machines.
C> 2000-02-18 | Dennis Keyser | Modified to call w3lib routine "getgb",
C> this allows code to compile and run properly on ibm-sp
C>
C> @param[in] INGBI Unit number of grib index file for grib file
C> containing global 1-degree sea-surface temp field
C> @param[in] INGBD Unit number of grib file containing global 1-degree
C> sea-surface temp field
C> @param[in] IDAT1 Requested earliest year(yyyy), month, day, hour, min
C> @param[in] IDAT2 Requested latest   year(yyyy), month, day, hour, min
C>
C> @remark Called by subroutine w3miscan.
C>
C> @author Dennis Keyser @date 200-02-18
      SUBROUTINE misc06(INGBI,INGBD,IDAT1,IDAT2,*,*,*,*)
      parameter(maxpts=360*180)
      LOGICAL*1  LBMS(360,180)
      INTEGER  KPDS(200),KGDS(200),LPDS(200),LGDS(200),IDAT1(5),
     $ idat2(5),jdat1(8),jdat2(8),kdat(8),ldat(8),mdate(8)
      REAL  RINC(5)
      CHARACTER*11 ENVVAR
      CHARACTER*80 FILEB,FILEI
      common/misccc/sstdat(360,180)
 
      SAVE
 
      envvar='XLFUNIT_   '
      WRITE(envvar(9:10),fmt='(I2)') ingbd
      CALL getenv(envvar,fileb)
      envvar='XLFUNIT_   '
      WRITE(envvar(9:10),fmt='(I2)') ingbi
      CALL getenv(envvar,filei)
      CALL baopenr(ingbd,fileb,iret1)
ccccc PRINT *,'SAGT: ',INGBD,FILEB,IRET1
      CALL baopenr(ingbi,filei,iret2)
ccccc PRINT *,'SAGT: ',INGBI,FILEI,IRET2
 
      kpds = -1
      kgds = -1
      n = -1
      kpds(5)  = 11
      kpds(6)  =  1
      kpds(7)  =  0
      kpds(8)  = -1
      kpds(9)  = -1
      kpds(10) = -1
      print 68, ingbd
   68 FORMAT(//4x,'** W3MISCAN/MISC06: READ IN "CURRENT" SEA-SURFACE ',
     $ 'TEMPERATURE DATA FROM GRIB MESSAGE IN UNIT',i3)
      CALL getgb(ingbd,ingbi,maxpts,0,kpds,kgds,kf,k,lpds,lgds,lbms,
     $ sstdat,iret)
C.......................................................................
C ABNORMAL RETURN IF PROBLEM WITH SST IN GRIB FILE
      IF(iret.NE.0)  THEN
        WRITE(6,*)' ERROR READING SST USING GETGB.  IRET = ',iret
        IF (iret.EQ.96) RETURN 1
        IF (iret.EQ.97) RETURN 3
        IF (iret.EQ.98) RETURN 3
        IF (iret.EQ.99) RETURN 3
        RETURN 4
      ENDIF
C.......................................................................
C READ SUCCESSFUL
      jdat1 = 0
      jdat2 = 0
      jdat1(1:3) = idat1(1:3)
      jdat1(5:6) = idat1(4:5)
      jdat2(1:3) = idat2(1:3)
      jdat2(5:6) = idat2(4:5)
      mdate = 0
      mdate(1) = ((lpds(21) - 1) * 100) + lpds(8)
      mdate(2:3) = lpds(9:10)
      mdate(5:6) = lpds(11:12)
      CALL w3movdat((/-7.,0.,0.,0.,0./),jdat1,kdat)
      CALL w3movdat((/ 7.,0.,0.,0.,0./),jdat2,ldat)
cppppp
      print *, '** W3MISCAN/MISCO6: SST GRIB FILE MUST HAVE DATE ',
     $ 'BETWEEN ',(kdat(iii),iii=1,3),(kdat(iii),iii=5,6),' AND ',
     $ (ldat(iii),iii=1,3),(ldat(iii),iii=5,6)
      print *, '                    RETURNED FROM GRIB FILE IS YEAR ',
     $ 'OF CENTURY = ',lpds(8),' AND CENTURY = ',lpds(21)
      print *, '                    CALULATED 4-DIGIT YEAR IS = ',
     $ mdate(1)
cppppp
      CALL w3difdat(kdat,mdate,3,rinc)
      kmin = rinc(3)
      CALL w3difdat(ldat,mdate,3,rinc)
      lmin = rinc(3)
      IF(kmin.GT.0.OR.lmin.LT.0)  THEN
C.......................................................................
C COME HERE IF SST GRIB MSG HAS A DATE THAT IS EITHER: 1) MORE THAN 7-
C  DAYS PRIOR TO THE EARLIEST REQ. DATE (INPUT ARG. "IDAT1" TO W3MISCAN)
C  OR 2) MORE THAN 7-DAYS AFTER THE LATEST REQ. DATE (INPUT ARG.
C  "IDAT2" TO W3MISCAN)
         print 27, (mdate(iii),iii=1,3),(mdate(iii),iii=5,6)
   27    FORMAT(/' ##W3MISCAN/MISC06: SST GRIB MSG HAS DATE:',i5,4i3,
     $    ' - AS A RESULT......')
         RETURN 2
C.......................................................................
      END IF
      print 60, (mdate(iii),iii=1,3),(mdate(iii),iii=5,6)
   60 FORMAT(/4x,'** W3MISCAN/MISC06: SEA-SFC TEMP SUCCESSFULLY READ ',
     $ 'IN FROM GRIB FILE, DATE IS: ',i5,4i3/)
      RETURN
 
      CALL baclose(ingbi,iret)
      CALL baclose(ingbd,iret)
 
      END