program trakmain
c
c$$$  MAIN PROGRAM DOCUMENTATION BLOCK
c
c Main Program: GETTRK       Track model vortices   
C   PRGMMR: MARCHOK          ORG: NP22        DATE: 2002-05-20
c
c ABSTRACT: This program tracks the average of the max or min
c   of several parameters in the vicinity of an input
c   first guess (lat,lon) position of a vortex in order to give  
c   forecast position estimates for that vortex for a given numerical
c   model.  For the levels 700 & 850 mb, the tracked parameters are:
c   Relative vorticity (max), wind magnitude (min), and geopotential
c   height (min).  Also tracked is the min in the MSLP.  So many
c   parameters are tracked in order to provide more accurate position
c   estimates for weaker storms, which often have poorly defined
c   structures/centers.  Currently, the system is set up to be able
c   to process GRIB input data files from the GFS, MRF, UKMET, GDAS,
c   ECMWF, NGM, NAM and FNMOC/NAVGEM models.  Two 1-line files
c   are  output from this program, both containing the forecast fix
c   positions that the  tracker has obtained.  One of these  output 
c   files contains the positions at every 12 hours from forecast 
c   hour 0 to the end of the forecast. The other file is in ATCF 
c   format, which is the particular format needed by the Tropical
c   Prediction Center, and provides the positions at forecast hours
c   12, 24, 36, 48 and 72, plus the maximum wind near the storm center
c   at each of those forecast hours.
c
c Program history log:
c   98-03-16  Marchok - Original operational version.
c   98-07-15  Marchok - Added code to calculate radii of gale-, storm-,
c                       and hurricane-force winds in each quadrant.
c   99-04-01  Marchok - Added code to be able to read in 4-digit years
c                       off of the TC Vitals records.
c                       Added code, including subroutine  is_it_a_storm,
c                       to make a better determination of whether or 
c                       not the center that was found at each time is
c                       the center of a storm, and not just a passing
c                       vort max, etc.
c   99-06-15  Marchok - Fixed a bug in calcdist that was triggered by a
c                       rounding error sending a number just above 1 
c                       into ACOS to get the distance between 2 
c                       identical points (which, obviously, is 0).
c   00-06-20  Marchok - Added GDAS option for vortex relocation work.
c                       Changed nhalf from 3 to 5.  Relaxed the 
c                       requirements for pthresh and vthresh.
c   00-11-30  Marchok - Added ability to handle GFDL and NCEP Ensemble
c                       model data.  Extended time range to be able to
c                       handle 5-day capability.  Forecast hours are 
c                       now input via a namelist (easiest way to account
c                       for NAM, GFS and GFDL having different forecast
c                       lengths at 00/12z and 06/18z).  Model ID's are 
c                       now input via a namelist (makes it easier, for
c                       example, to run for many different ensemble 
c                       members).  Added new output, the atcfunix 
c                       format, needed for 5-day forecasts.
c   01-08-24  Marchok   Fixed a bug in rvcal and getgridinfo.  When a 
c                       grid that was south-->north is flipped in 
c                       conv1d2d_real to be north-->south, the scanning 
c                       mode flag remains 64 and what we would consider
c                       the max and min latitudes are reversed, so I 
c                       added code to correct this in both routines.
c   02-05-20  Marchok   Weakened the mslp gradient threshold and v850
c                       threshold in is_it_a_storm to cut down on the
c                       number of dropped storms.
c   03-03-18  Marchok   Fixed a bug in get_ij_bounds that was allowing
c                       a cos(90) and cos(-90), which then led to a
c                       divide by zero.
c   05-08-01  Marchok   Updated to allow tracking of ECMWF hi-res, ECMWF
c                       ensemble, CMC hi-res, CMC ensemble, NCEP
c                       ensemble.
c   06-11-07  Marchok   Updated to locate, and report to the atcfunix
c                       file, the value of the gridpoint minimum value
c                       of mslp.  Previously, the  barnes-averaged
c                       value had been used.
c   08-01-10  Marchok   Changed the storm ID for genesis tracking so
c                       that the ID includes info
c                       on storm detection location & time.  Added
c                       algorithms for Hart's cyclone phase space.
c                       Added new output fields to the atcfunix
c                       records, actually creating a modified atcfunix
c                       record, to include things such as the mean &
c                       max values of zeta850 & zeta700 centered on
c                       the storm, the speed & direction of storm
c                       translation, and the Hart CPS parameters.
c   10-01-07  Marchok   - input grib lead time can be hrs or minutes
c                       - added code for warm core check
c                       - added code to detect genesis
c                       - added code to report on sfc wind structure
c                       - added buffer ("grid_buffer") to avoid fixing
c                         center to boundaries on regional grids
c                       - modified rvcal to report missing zeta values
c                         as background coriolis instead of -999, since
c                         the -999 was messing up center-fixing
c                       - added 10-m wind and sfc zeta as center-fixing
c                         parms.
c
c   10-05-25  Slocum    Add verbose feature to code
c                       0 = Not terminal output, 1 = error messages only
c                       2 = all output
c
c   10-05-26  Marchok   - added flags and code to check the temporal 
c                         consistency of the mslp closed contour and 
c                         Vt850 checks for tcgen and midlat cases.
c
c   13-04-01  Marchok   Added code to upgrade the wind radii diagnosid.
c                       Hurricane Sandy exposed an issue with the
c                       tracker for large storms.  The code was modified
c                       to use an iterative technique that can 
c                       diagnose radii for large storms but still 
c                       accurately diagnost radii for small storms.  See
c                       subroutine  getradii for more details.
c
c   15-11-01  Marchok   Replaced the routine which tracks the wind 
c                       minimum at the center of a storm, as that 
c                       routine proved troublesome with very hi-res 
c                       grids (0.02-deg) from HWRF for very small 
c                       storms.  This has been replaced with a routine
c                       that looks for "wind circulation difference", 
c                       whereby the center for this parm is located at
c                       the spot where the tangential wind circulation
c                       minus the wind magnitude at the candidate 
c                       center position is maximized.  ALSO: Added in 
c                       tracking of thickness as an additional 
c                       tracked parm. ALSO: Added a separate verbose
c                       flag for only the GRIB2 read diagnostics, which
c                       can be voluminous.
c
c   16-09-01  Marchok   Added in the ability to read in NetCDF files.
c                       As with GRIB data, the NetCDF data must be on 
c                       a lat/lon grid.
c
c   17-08-31  Marchok   Added a logical bitmap capability for NetCDF 
c                       files to prevent the accessing of missing data.
c                       Also modified the code to permit more accurate
c                       reporting of the grid point value of the 
c                       minimum SLP for reporting to the atcfunix file.
c                       Finally, fixed a bug (reported by JTWC) whereby
c                       radii were being reported for thresholds that
c                       were in exceedance of the tracker-diagnosed
c                       Vmax (e.g., 34-kt radii for a storm with 
c                       Vmax = 25 kts).
c
c Input files:
c   unit   11    Unblocked GRIB1 file containing model data
c   unit   12    Text file containing TC Vitals card for current time
c   unit   31    Unblocked GRIB index file
c
c Output files:
c   unit   61    Output file with forecast positions every 12h from 
c                vt=00h to the end of the forecast
c   unit   62    Output file in ATCF format, with forecast positions
c                at vt = 12, 24, 36, 48 and 72h, plus wind speeds.
c   unit   63    Output file with forecast wind radii for 34, 50 and
c                64 knot thresholds in each quadrant of each storm.
c
c Subprograms called:
c   read_nlists  Read input namelists for input date & storm number info
c   read_tcv_card Read TC vitals file to get initial storm position
c   getgridinfo  Read GRIB file to get basic grid information
c   tracker      Begin main part of tracking algorithm
c
c Attributes:
c   Language: Standard Fortran_90
c
c$$$
c
c-------
c
c     LOCAL:
c
c     ifhours:   Integer array holding numerical forecast times for
c                the input model (99 = no more times available).
c                These values are read in via a namelist.
c     Model numbers used: (1) GFS, (2) MRF, (3) UKMET, (4) ECMWF,
c                (5) NGM, (6) NAM, (7) NAVGEM, (8) GDAS,
c                (10) NCEP Ensemble, (11) ECMWF Ensemble (13) SREF
c                Ensemble, (14) NCEP Ensemble (from ensstat mean
c                fields), (15) CMC, (16) CMC Ensemble, (17) HWRF,
c                (18) HWRF Ensemble, (19) HWRF-DAS (HDAS),
c                (20) Ensemble RELOCATION (21) UKMET hi-res (NHC)
c                (23) FNMOC Ensemble
c     stormswitch:  This switch tells how to handle each storm in 
c                the TCV file:
c                1 = process this storm for this forecast hour.
c                2 = Storm was requested to be tracked, but either
c                    the storm went off the grid (regional models),
c                    the storm dissipated, or the program was
c                    unable to track it.
c                3 = Storm was NOT requested to be tracked at all.
c     storm:     An array of type tcvcard.  Each member of storm 
c                contains a separate TC Vitals card.
c     maxstorm:  Maximum number of storms the system is set up to 
c                handle at any 1 time.
c     slonfg,slatfg:  Holds first guess positions for storms.  The 
c                very first, first guess position is read from the
c                TC vitals card. (maxstorm,maxtime)
c     clon,clat: Holds the coordinates for the center positions for
c                all storms at all times for all parameters.
c                (max_#_storms, max_fcst_times, max_#_parms)
c
      USE def_vitals; USE inparms; USE set_max_parms; USE level_parms
      USE trig_vals; USE atcf; USE trkrparms; USE verbose_output
      USE netcdf_parms
c
      implicit none
c
      logical(1) file_open
      integer date_time(8)
      character (len=10) big_ben(3)
      character :: ncfile*180,ncfile_has_hour0*1
      integer itret,iggret,iicret,igcret,iret,ifhmax,maxstorm,numtcv
      integer iocret,enable_timing,ncfile_id,ncfile_tmax,irnhret
      integer, parameter :: lugb=11,lugi=31,lucard=12,lgvcard=14,lout=51
c
      type (datecard) inp
      type (trackstuff) trkrinfo
      type (netcdfstuff) netcdfinfo

c     --------------------------------------------------------

      call date_and_time (big_ben(1),big_ben(2),big_ben(3),date_time)
      write (6,31) date_time(5),date_time(6),date_time(7)
  31  format (1x,'TIMING: beginning ...  ',i2.2,':',i2.2,':',i2.2)

      call w3tagb('GETTRK  ',1999,0104,0058,'NP22   ')

      pi = 4. * atan(1.)   ! Both pi and dtr were declared in module 
      dtr = pi/180.0       ! trig_vals, but were not yet defined.
      ncfile_has_hour0 = 'n'  ! Default value; set in read_netcdf_hours
c
      call read_nlists (inp,trkrinfo,netcdfinfo)
      enable_timing=trkrinfo%enable_timing

      call read_fhours (ifhmax)

      call read_tcv_card (lucard,maxstorm,trkrinfo,numtcv,iret)

      if (iret == 0) then
        if ( verb .ge. 3 ) then
          print *,'After read_tcv_card, num vitals = ',numtcv
        endif
      else
        if ( verb .ge. 1 ) then
         print '(/,a50,i4,/)','!!! ERROR: in read_tcv_card, rc= ',iret
        endif
        goto 890
      endif

      call read_gen_vitals (lgvcard,maxstorm,trkrinfo,numtcv,iret)

      if (iret == 0) then
        if ( verb .ge. 3 ) then
          print *,'After read_gen_vitals, total number of vitals (both'
     &         ,' TC and non-TC) now = ',numtcv
        endif
      else
        if ( verb .ge. 1 ) then
          print '(/,a50,i4,/)','!!! ERROR: in read_gen_vitals, rc= '
     &         ,iret
        endif
        goto 890
      endif

      if (inp%file_seq == 'onebig') then
        if (trkrinfo%inp_data_type == 'netcdf') then
          ncfile = netcdfinfo%netcdf_filename
          print *,' '
          print *,'before open_ncfile call, ncfile= ',ncfile
          call open_ncfile (ncfile,ncfile_id)
          print *,'after open_ncfile call, ncfile_id= ',ncfile_id
          call read_netcdf_hours (ncfile,ncfile_id,ncfile_tmax,ifhmax
     &                           ,ncfile_has_hour0,netcdfinfo,irnhret)
          if (irnhret /= 0) then
            print *,'(/,a32,a5,i4,/)','!!! ERROR: in read_netcdf_hours,'
     &             ,' rc= ',irnhret
            goto 890
          endif
        else
          call open_grib_files (inp,lugb,lugi,'dummy','dummy',lout,iret)
          if (iret /= 0) then
            print '(/,a50,i4,/)','!!! ERROR: in open_grib_files, rc= '
     &             ,iret
            goto 890
          endif
        endif
      endif

      call tracker (inp,maxstorm,numtcv,ifhmax,trkrinfo,ncfile
     &             ,ncfile_id,netcdfinfo,ncfile_has_hour0
     &             ,ncfile_tmax,itret)
c
890   continue

      igcret=0
      iicret=0
      iocret=0

      inquire (unit=lugb, opened=file_open)
      if (file_open) call baclose(lugb,igcret)
      inquire (unit=lugi, opened=file_open)
      if (file_open) call baclose(lugi,iicret)
      inquire (unit=lout, opened=file_open)
      if (file_open) call baclose(lout,iocret)
      if ( verb .ge. 3 ) then
        print *,'baclose: igcret= ',igcret,' iicret= ',iicret
        print *,'baclose: iocret= ',iocret
      endif
      call w3tage('GETTRK  ')
c
      stop
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine tracker (inp,maxstorm,numtcv,ifhmax,trkrinfo,ncfile
     &                   ,ncfile_id,netcdfinfo,ncfile_has_hour0
     &                   ,ncfile_tmax,itret)
c
c     ABSTRACT: This subroutine is the core of the program.  It contains
c     the main loop for looping through all the forecast hours and all
c     the storms.  Basically, the way it works is that it has an outer 
c     loop that loops on the forecast hour.  At the beginning of this 
c     loop, the data are read in for all parameters and levels needed
c     for tracking.  The full regional or global grid is read in. 
c     If vorticity was not read in (some of the centers do not send us
c     vorticity), then vorticity calculations are done on the whole 
c     grid at both 850 and 700 mb.  Then the program goes into the inner
c     loop, which loops on storm number (program originally set up to 
c     handle a max of 15 storms).  For each storm, subroutine 
c     find_maxmin is called for the following parameters: Rel Vort and  
c     geopotential hgt at 700 & 850 mb, and MSLP.  Within find_maxmin,
c     a barnes analysis is performed over the guess position of the 
c     storm to find the max or min value, and then iteratively, the 
c     grid size is cut in half several times and the  barnes analysis
c     rerun to refine the positioning of the max or min location.  After
c     the center positions for these parameters have been obtained, 
c     subroutine  get_uv_center is called to get a center fix for the 
c     minimum in the wind field, specifically, a minimum in the
c     magnitude of the wind speed (vmag).  The calculation of the vmag
c     minimum is done differently than the calculation for the other
c     parameters;  for vmag, the grid near the storm center guess 
c     position is interpolated down to a very fine grid, and then 
c     find_maxmin is called and a barnes analysis is done on that 
c     smaller grid.  For vmag, there are no further calls made to barnes
c     with a smaller grid, since the grid has already been interpolated 
c     down to a smaller grid.  Once all of the parameter center fixes 
c     have been made, subroutine  fixcenter is called to average these 
c     positions together to get a best guess fix position.  Then a check
c     is done with a call to subroutine  is_it_a_storm to make sure that
c     the center that we have found does indeed resemble a tropical 
c     cyclone.  Finally, subroutine  get_next_ges is called to make a 
c     guess position for the next forecast time for this storm.
c
c     INPUT:
c     inp        contains input date and model number information
c     maxstorm   maximum # of storms to be handled
c     numtcv     number of storms read off of the tcvitals file
c     ifhmax     max number of analysis & forecast times to be handled
c     trkrinfo   derived type that holds/describes various tracker parms
c     ncfile     if the input data type is netcdf, then this ncfile 
c                variable contains the name of the netcdf file
c     ncfile_id  if the input data type is netcdf, then this ncfile_id
c                variable contains an integer id assigned to the netcdf
c                file from the open_ncfile subroutine
c     ncfile_has_hour0  character flag (y|n) that, if the tracker is 
c                running on NetCDF data, tells if the NetCDF file 
c                actually contains hour0 data or not (some, like the 
c                2016 version of FV3, do not).
c     ncfile_tmax integer with max number of time levels in the input
c                NetCDF file, as read in from the NetCDF file itself in
c                subroutine  read_netcdf_fhours.
c
c     OUTPUT:
c     itret      return code from this subroutine
c 
c     LOCAL PARAMETERS:
c     storm      contains the tcvitals for the storms
c     stormswitch 1,2 or 3 (see more description under Main pgm section)
c     slonfg     first guess array for longitude
c     slatfg     first guess array for latitude
c     maxtime    Max number of forecast times program can track
c     maxtp      Max number of tracked parameters program will track.
c                Currently (7/2015), this maxtp is 11, and these 11 are
c                listed just a few lines below.
c     readflag   L  Indicates status of read for each of 16 parms:
c                1: 850 mb absolute vorticity
c                2: 700 mb absolute vorticity
c                3: 850 mb u-comp
c                4: 850 mb v-comp
c                5: 700 mb u-comp
c                6: 700 mb v-comp
c                7: 850 mb gp hgt
c                8: 700 mb gp hgt
c                9: MSLP
c                10: near-surface u-comp
c                11: near-surface v-comp
c                12: 500 mb u-comp
c                13: 500 mb v-comp
c                14: Mean temperature, centered at 400 mb
c                15: 500 mb gp hgt
c                16: 200 mb gp hgt
c                17: Land-Sea Mask (for use in tcgen applications, and 
c                                   even there, it's optional)
c
c     calcparm   L  indicates which parms to track and which not to.
c                Array positions are defined exactly as for clon
c                and clat, listed next, except that, in general, when
c                flag 3 is set to a value, flag 4 is set to the same 
c                value as 3, and when flag 5 is set to a value, flag
c                6 is set to the same value as 5.  This is because 
c                3 & 4 are for the 850 mb winds, and if either u or
c                v is missing, we obviously can't calculate the 
c                magnitude of the wind.  The same applies for 5 & 6,
c                which are for the 700 mb winds. And also for reference,
c                here is a list of all the variables & levels for the 
c                tracked parameters (i.e., the "calcparm" elements):
c
c                 1: 850 mb relative vorticity
c                 2: 700 mb relative vorticity
c                 3: 850 mb wind circulation difference
c                 4: NOT USED
c                 5: 700 mb wind circulation differenc
c                 6: NOT USED
c                 7: 850 mb geopotential height
c                 8: 700 mb geopotential height
c                 9: MSLP
c                10: 10-m wind circulation difference
c                11: 10-m relative vorticity
c                12: 500-850 mb thickness (lower level)
c                13: 200-500 mb thickness (upper level)
c                14: 200-850 mb thickness (deep-layer)
c 
c     clon,clat: Holds the coordinates for the center positions for
c                all storms at all times for all parameters.
c                (max_#_storms, max_fcst_times, max_#_parms).
c                For the third position (max_#_parms), here they are:
c                 1: Relative vorticity at 850 mb
c                 2: Relative vorticity at 700 mb
c                 3: Wind circulation difference at 850 mb
c                 4: NOT CURRENTLY USED
c                 5: Wind circulation difference at 700 mb
c                 6: NOT CURRENTLY USED
c                 7: Geopotential height at 850 mb
c                 8: Geopotential height at 700 mb
c                 9: Mean Sea Level Pressure
c                10: Wind circulation difference at 10 m
c                11: Relative vorticity at 10 m
c                12: Lower-level thickness (500-850)
c                13: Upper-level thickness (200-500)
c                14: Deep-Layer thickness (200-850)
c
c     xmaxwind   Contains maximum near-surface wind near the storm
c                center for each storm at each forecast hour.
c     stderr     Standard deviation of the position "errors" of the 
c                different parameters for each storm at each time.
c     fixlat,fixlon: Contain the final coordinates for each storm at
c                each forecast hour.  These coordinates are a 
c                weighted average of all the individual parameter
c                positions (hgt, zeta, mslp, vmag).
c     cvort_maxmin: Contains the characters 'max' or 'min', and is 
c                used when calling the  find_maxmin routine for the
c                relative vorticity (Look for max in NH, min in SH).
c     vradius    Contains the distance from the storm fix position to
c                each of the various near-surface wind threshhold 
c                distances in each quadrant. 
c                (3,4) ==> (# of threshholds, # of quadrants)
c                See subroutine  getradii for further details.
c     wfract_cov Fractional coverage (areal coverage) of winds
c                exceeding a certain threshold (34, 50, 64 kts) in
c                each quadrant.
c                (5,5,3) ==> (# of quadrants + 1, # of distance bins,
c                             # of thresholds).
c                The "extra" array size for quadrants (5, instead of 4)
c                is there to hold the total (i.e., "whole disc")
c                statistics.
c                See subroutine  get_fract_wind_cov for further details
c
c     er_wind    Quadrant winds in earth-relative framework
c     sr_wind    Quadrant winds in storm-relative framework
c     er_vr      Quadrant radial winds in earth-relative framework
c     sr_vr      Quadrant radial winds in storm-relative framework
c     er_vt      Quadrant tangential winds in earth-relative framework
c     sr_vt      Quadrant tangential winds in storm-relative framework
c
c     isastorm   Character array used in the call to is_it_a_storm,
c                tells whether the minimum requirement for an MSLP
c                gradient was met (isastorm(1)), whether for the midlat
c                and tcgen cases if a closed mslp contour was found
c                (isastorm(2)), and if a circulation exists at 850 mb
c                (isastorm(3)).  Can have a value of 'Y' (requirement
c                met), 'N' (requirement not met) or 'U' (requirement
c                undetermined, due to the fact that no center location
c                was found for this parameter).
c     maxmini    These 2 arrays contain the i and j indeces for the
c     maxminj    max/min centers that are found using the rough check
c                in first_ges_ctr and subsequent routines.  Only needed
c                for a midlatitude or a genesis run, NOT needed for a
c                TC tracker run.
c     stormct    Integer: keeps and increments a running tab of the
c                number of storms that have been tracked at any time
c                across all forecast hours.  Used only for midlat or
c                tcgen runs.
c     gridprs    This contains the actual value of the minimum pressure
c                at a gridpoint.  The  barnes analysis will return an
c                area-averaged value of pressure; this variable will
c                contain the actual minimum value at a gridpoint near
c                the lat/lon found by the  barnes analysis.
c     closed_mslp_ctr_flag  This flag keeps track of the value of the 
c                closed contour flag returned from subroutine
c                check_closed_contour.
c     vt850_flag This flag keeps track of the value of the flag for 
c                the 850 mb Vt check.
c-----
c
      USE def_vitals; USE inparms; USE tracked_parms; USE error_parms
      USE set_max_parms; USE level_parms; USE grid_bounds; USE trkrparms
      USE contours; USE atcf; USE radii; USE trig_vals; USE phase
      USE gen_vitals; USE structure; USE verbose_output 
      USE waitfor_parms; USE module_waitfor; USE netcdf_parms
      USE tracking_parm_prefs
c         
      implicit none
c
      type (datecard) inp
      type (trackstuff) trkrinfo
      type (netcdfstuff) netcdfinfo
      type (cint_stuff) contour_info
c
      character, allocatable :: closed_mslp_ctr_flag(:,:)*1
      character, allocatable :: vt850_flag(:,:)*1
      character :: r34_check_okay*1,had_to_try_backup_850_vt_check*1
      character :: need_to_expand_r34(4)*1,ncfile_has_hour0*1
      character*(*), intent(in) :: ncfile
      integer :: ncfile_id
      integer, parameter :: nreadparms=17
      real, allocatable :: prstemp(:),iwork(:)
      integer, parameter :: numdist=14,numquad=4,lout=51
      integer, allocatable :: prsindex(:)
      integer   imax,jmax,ifh,ist,irf,jj,istmp,ifhtemp,itret,ivpa
      integer   isiret1,isiret2,isiret3,idum,m,iix,jjx,imode,numtcv
      integer   iha,isa,iua,iva,iza,maxstorm,ivort,ifix,jfix,issret
      integer   imoa,imoca,iksa,isda,ileadtime,leadtime_check
      integer   ioaret,ioaxret,ifgcret,ifmret,igugret,isoiret,icccret
      integer   igrret,igmwret,iorret,ignret,iovret,icbret,igucret,ita
      integer   ifilret,ifret,iaret,isret,iotmret,iwa,iisa,sl_counter
      integer   iicret,igcret,pfcret,igwcret,imbowret,iatret
      logical(1), allocatable :: valid_pt(:,:)
      logical(1), allocatable :: masked_outc(:,:),masked_out(:,:)
      logical(1) readflag(nreadparms),calcparm(maxtp,maxstorm)
      logical(1) tracking_previously_known_storms
      logical(1) need_to_flip_lats,need_to_flip_lons
      logical(1) file_open,first_time_thru_getradii
      character cvort_maxmin*3,isastorm(3)*1,ccflag*1,gotten_avg_value*1
      character cmaxmin*3,get_last_isobar_flag*1,wcore_flag*1
      character gfilename*120,ifilename*120,gridmove_status*7
      integer   vradius(3,4),igridzeta(nlevgrzeta),imeanzeta(nlevgrzeta)
      integer   maxmini(maxstorm),maxminj(maxstorm),pdf_ct_bin(16)
      integer   ifcsthour,stormct,prevstormct,kf,istmspd,istmdir,iggret
      integer   igiret,iuret,jdum,icount,ilonfix,jlatfix,igpret,ifhmax
      integer   ibeg,jbeg,iend,jend,ix1,ix2,n,ilev,npts,icpsa,igzvret
      integer   igfwret,ioiret,igisret,iofwret,iowsret,igwsret,igscret
      integer   pdf_ct_tot,lugb,lugi,iret,icmcf,iccfh,ivt8f
      integer   waitfor_gfile_status,waitfor_ifile_status,ncfile_tmax
      integer   wait_max_ifile_wait,ivr,r34_good_ct,itha,ilma,inctcv
      integer   date_time(8)
      character (len=10) big_ben(3)
      real      fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real      gridprs(maxstorm,maxtime)
      real      wfract_cov(5,5,3)
      real      er_wind(numquad,numdist)
      real      sr_wind(numquad,numdist)
      real      er_vr(numquad,numdist)
      real      er_vt(numquad,numdist)
      real      sr_vr(numquad,numdist)
      real      sr_vt(numquad,numdist)
      real      ike(max_ike_cats)
      real      clon(maxstorm,maxtime,maxtp)
      real      clat(maxstorm,maxtime,maxtp)
      real      xmaxwind(maxstorm,maxtime),xmeanzeta
      real      stderr(maxstorm,maxtime),xval(maxtp),cps_vals(3)
      real      gridpoint_maxmin,dist,distnm,xknots,xmaxspeed
      real      uvgeslon,uvgeslat,xavg,stdv,search_cutoff,re,ri,dx,dy
      real      xinp_fixlat,xinp_fixlon,degrees,plastbar,rlastbar
      real      xinterval_fhr,cc_time_sum_tot,cc_time_sum_yes
      real      rmax,sdp,wdp,paramb,vtl_slope,vtu_slope
      real      xsfclon,xsfclat,cc_time_pct,radmax,r34_dist_thresh
      real      prev_latmax,prev_latmin,prev_lonmax,prev_lonmin
      real      vradius_km,hold_old_contint,tcv_max_wind_ms
      real      tcv_mslp_pa,r34_from_tcv,roci_from_tcv
      real      proci_from_tcv,prs_contint_thresh
      integer   enable_timing,igrct
      character(pfc_cmd_len) :: pfc_final
c
      prev_latmax = -999.0
      prev_latmin = -999.0
      prev_lonmax = -999.0
      prev_lonmin = -999.0
      enable_timing=trkrinfo%enable_timing
      icmcf = 0
      ivt8f = 0
      if (trkrinfo%type == 'midlat' .or. trkrinfo%type == 'tcgen') then
        allocate (closed_mslp_ctr_flag(maxstorm,ifhmax),stat=icmcf)
        allocate (vt850_flag(maxstorm,ifhmax),stat=ivt8f)
        ! Initialize flags to 'u', not 'n'.  That way, 
        ! when we are evaluating its value back over recent past hours,
        ! we can distinguish a "no" value from an initialized value of
        ! 'u' for which a storm hadn't yet been detected.
        closed_mslp_ctr_flag = 'u'
        vt850_flag = 'u'
      endif
   
      allocate (prsindex(maxstorm),stat=iisa)
      allocate (prstemp(maxstorm),stat=iva)
      allocate (iwork(maxstorm),stat=iwa)
      if (iisa /= 0 .or. iva /= 0 .or. iwa /= 0 .or. icmcf /= 0 .or.
     &     ivt8f /= 0) then
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in sub tracker allocating prsindex,'
          print *,'!!! prstemp or iwork array for storms: iisa = ',iisa
          print *,'!!! iva= ',iva,' iwa= ',iwa,' icmcf= ',icmcf
          print *,'!!! ivt8f= ',ivt8f
        endif
        itret = 94
        return    
      endif

      ike = 0.0
      sdp = 0.0
      wdp = 0.0

      clon = 0.0
      clat = 0.0
      stderr = stermn    ! initialize stderr to 0.1 (error_parms)
      itret = 0
      xmaxwind = 0.0
      stormct = 0

      ! It is critical to initialize the gridprs array to something
      ! greater than normal atmospheric pressures (I've chosen 9999.99 
      ! mb).  This is so that in the  sort on pressure before stormloop,
      ! the top of the  sorting index array will be filled with pressure
      ! values from active storms, while those inactive 9999 storms 
      ! will fill the bottom of the  sorting index array (prsindex).

      gridprs =  999999.0
      fixlon  =    -999.0
      fixlat  =    -999.0

      if (inp%file_seq == 'multi') then
        ! Each tau will have a separate file, starting with unit 
        ! number 200 (GRIB data) and 5200 (GRIB index file) and 
        ! incrementing upwards from there for each tau.
        if (trkrinfo%gribver == 1) then
          lugb =  200
c          lugi = 5200
          lugi = 600 ! 3/2017: w3lib on Jet cannot handle unit #'s >999
        else
          lugb =  200
c          lugi = 5200
          lugi = 600 ! 3/2017: w3lib on Jet cannot handle unit #'s >999
        endif
      else
        ! All lead times are included in one big file.  These values
        ! for lugb and lugi will remain static for all taus.
        lugb = 11
        lugi = 31
      endif

      ifh = 1

      if ( verb .ge. 3 ) then
        print *,'top of tracker, ifh= ',ifh,' ifhmax= ',ifhmax
      endif

      ifhloop: do while (ifh <= ifhmax)

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'*-------------------------------------------*'
          write (6,402) ifhours(ifh),ifclockmins(ifh)
  402     format (1x,'*   New forecast hour: ',i4,':',i2.2)
          print *,'*-------------------------------------------*'
        endif

        if (inp%file_seq == 'multi') then

          lugb = lugb + 1
          lugi = lugi + 1
        
          call get_grib_file_name (ifh,gfilename,ifilename)

          if (use_waitfor == 'y') then

            ! First check for existence of grib file....

            call waitfor(trim(gfilename),waitfor_gfile_status
     &                  ,wait_min_age,wait_min_size,wait_max_wait
     &                  ,wait_sleeptime)
            if (waitfor_gfile_status /= 0) then
              print *,' '
              write(6,405) 
              write(6,406) wait_max_wait,trim(gfilename)
  405         format('ERROR: TIMEOUT from waitfor for GRIB file.') 
  406         format('Waited longer than ',I0,' seconds for "',A,'"')
              stop 91
            endif

            ! Now check for existence of index file.  Use a separate 
            ! max_wait time -- a much shorter one -- since once the 
            ! grib file is there, the index file should appear within
            ! a matter of seconds.  Also, the index file is much 
            ! smaller, so set the wait_min_size accordingly.

            wait_max_ifile_wait = 180
            wait_min_size = 500
            call waitfor(trim(ifilename),waitfor_ifile_status
     &                  ,wait_min_age,wait_min_size,wait_max_ifile_wait
     &                  ,wait_sleeptime)
            if (waitfor_ifile_status /= 0) then
              print *,' '
              write(6,415)
              write(6,416) wait_max_ifile_wait,trim(ifilename)
  415         format('ERROR: TIMEOUT from waitfor for INDEX file.')
  416         format('Waited longer than ',I0,' seconds for "',A,'"')
              stop 91
            endif

          endif

          call open_grib_files (inp,lugb,lugi,gfilename,ifilename
     &         ,lout,iret)
        
          if (iret /= 0) then
            print '(/,a50,i4,/)','!!! ERROR: from open_grib_files, rc= '
     &           ,iret
            print *,'!!! Files after hour0 are missing, '
     &             ,'exiting normally'
            stop 0
          endif
        endif

        if (trkrinfo%inp_data_type == 'grib') then
          inquire (unit=lugb, opened=file_open)
          if (file_open) then
            print *,'TEST b4 getgridinfo, unit lugb= ',lugb,' is OPEN'
          else
            print *,'TEST b4 getgridinfo, unit lugb= ',lugb,' is CLOSED'
          endif
  
          inquire (unit=lugi, opened=file_open)
          if (file_open) then
            print *,'TEST b4 getgridinfo, unit lugi= ',lugi,' is OPEN'
          else
            print *,'TEST b4 getgridinfo, unit lugi= ',lugi,' is CLOSED'
          endif
        endif

        !--------------------------------------------------------------
        ! Within this next IF statement, we deal with writing out atcf
        ! records for storms for the case in which we have netcdf data,
        ! but that netcdf data does not have hour0 data (as of Nov 2016,
        ! this is the case for FV3 data).  In this case, we write out 
        ! missing values for the hour0 time, and then we update the 
        ! guess for next lead time by extrapolating data from TC Vitals.
        ! Note in the IF statement itself, "iftotalmins" is the array 
        ! of *user-requested* lead times, meaning that the user has 
        ! requested to look at hour0, but the ncfile_has_hour0 flag
        ! indicates the hour0 time is not in the NetCDF data.
        !--------------------------------------------------------------

        if (ifh == 1 .and. iftotalmins(ifh) == 0 .and.
     &      trkrinfo%inp_data_type == 'netcdf'   .and.
     &      ncfile_has_hour0 == 'n') then

          null_netcdf_hour0_storm_loop: do inctcv = 1,numtcv

            call output_atcfunix (-999.0
     &                      ,-999.0,inp,inctcv
     &                      ,0,0.0
     &                      ,0.0,vradius,maxstorm,trkrinfo
     &                      ,-99.0,-99.0,-99.0
     &                      ,cps_vals,wcore_flag,ioaxret)
            imeanzeta = -99
            igridzeta = -99
            if (trkrinfo%type == 'midlat' .or.
     &          trkrinfo%type == 'tcgen') then
              call output_atcf_gen (-999.0   
     &           ,-999.0,inp,inctcv
     &           ,0,0.0
     &           ,0.0,vradius,maxstorm,trkrinfo
     &           ,-99,-99,-999.0,-999.0,-99.0
     &           ,cps_vals,'u',imeanzeta,igridzeta,ioaxret)
            endif 
            call output_atcf_sink (-999.0
     &                ,-999.0,inp,inctcv
     &                ,0,0.0
     &                ,0.0,vradius,maxstorm,trkrinfo
     &                ,-99,-99,imeanzeta,igridzeta
     &                ,cps_vals,-999.0,-999.0,ioaxret)
            call output_hfip (-999.0
     &                ,-999.0,inp,inctcv
     &                ,ifh,0.0
     &                ,0.0,vradius,-99.0,ioaxret)

            if (verb .ge. 3) then
              print *,' ' 
              print *,'++ NOTE: Even though a fix could not be'
              print *,'   made for this storm at 00h, we will '
              print *,'   use the storm heading info from tc'
              print *,'   vitals to create a guess for the next'
              print *,'   lead time and attempt to track again'
              print *,'   at that time.'
              print *,'   ifh= ',ifh,' ist= ',inctcv
              write (6,431) storm(inctcv)%tcv_storm_id
     &                     ,storm(inctcv)%tcv_storm_name
 431          format (1x,'  storm_id = ',a4,' storm_name = ',a9)
            endif 

            call advect_tcvitals_from_hour0 (slonfg,slatfg,maxstorm
     &                             ,inctcv,ifh,trkrinfo,iatret)

            if (iatret /= 0) then
              fixlon (inctcv,ifh) = -999.0
              fixlat (inctcv,ifh) = -999.0
              stormswitch(inctcv) = 2
              cycle null_netcdf_hour0_storm_loop
            endif 

            stormswitch(inctcv) = 1

          enddo null_netcdf_hour0_storm_loop

          ifh = ifh + 1
          cycle ifhloop

        endif

        !--------------------------------------------------------------
        ! Make call to getgridinfo in order to get info on the imax,
        ! jmax, as well as the x- and y-increments, and also to see if
        ! the grid is correctly oriented for the tracker so that the 
        ! data go north to south and west to east or if we need to flip
        ! either the lats or the lons.
        !--------------------------------------------------------------

        if (trkrinfo%inp_data_type == 'grib') then
          call getgridinfo_grib (imax,jmax,ifh,dx,dy,lugb,lugi
     &                 ,trkrinfo,need_to_flip_lats,need_to_flip_lons
     &                 ,inp,iggret)
        elseif (trkrinfo%inp_data_type == 'netcdf') then
          call getgridinfo_netcdf (ncfile_id,imax,jmax,dx,dy
     &                 ,trkrinfo,need_to_flip_lats,need_to_flip_lons
     &                 ,inp,netcdfinfo,iggret)
        else
          print *,' '
          print *,'!!! ERROR: trkrinfo%inp_data_type NOT VALID '
          print *,'!!! trkrinfo%inp_data_type= ',trkrinfo%inp_data_type
          print *,'!!! Should have value of grib or netcdf.'
          print *,'!!! EXITING....'
          print *,' '
          stop 93
        endif

        if (iggret == 0) then
          if ( verb .ge. 1 ) then
            print *,'TEST after getgridinfo in sub tracker, '
     &             ,'iggret= ',iggret
          endif
        else
          if ( verb .ge. 1 ) then
            print '(/,a50,i4,/)','!!! ERROR: in getgridinfo, rc= '
     &            ,iggret
          endif
          stop 95
        endif

        if (inp%modtyp == 'regional' .and. inp%nesttyp == 'moveable') 
     &  then 
          if (glatmax == prev_latmax .and. glatmin == prev_latmin .and.
     &        glonmax == prev_lonmax .and. glonmin == prev_lonmin) then
            ! The moveable, nested regional grid has not moved since 
            ! the last lead time.  This could be an indication that the
            ! model lost the storm and so the grid has not moved to 
            ! stay with the cyclone center. Set a flag to indicate this.
            gridmove_status = 'stopped'
          else
            gridmove_status = 'moving'
          endif
        else
          gridmove_status = 'notappl'
        endif

        prev_latmax = glatmax
        prev_latmin = glatmin
        prev_lonmax = glonmax
        prev_lonmin = glonmin

        gotten_avg_value = 'n'

c       First, allocate the working data arrays....
      
        if (allocated(valid_pt)) deallocate (valid_pt)
        if (allocated(zeta))     deallocate (zeta) 
        if (allocated(u))        deallocate (u)
        if (allocated(v))        deallocate (v)
        if (allocated(hgt))      deallocate (hgt) 
        if (allocated(slp))      deallocate (slp)
        if (allocated(tmean))    deallocate (tmean)
        if (allocated(cpshgt))   deallocate (cpshgt)
        if (allocated(thick))    deallocate (thick)
        if (allocated(lsmask))   deallocate (lsmask)
        if (allocated(masked_out))  deallocate (masked_out)
        if (allocated(masked_outc)) deallocate (masked_outc)
      
        ! Allocate all of the allocatable arrays....
      
        allocate (valid_pt(imax,jmax),stat=ivpa)
        allocate (zeta(imax,jmax,nlevzeta),stat=iza)
        allocate (u(imax,jmax,nlevs),stat=iua)
        allocate (v(imax,jmax,nlevs),stat=iva)
        allocate (hgt(imax,jmax,nlevhgt),stat=iha)
        allocate (slp(imax,jmax),stat=isa)
        allocate (tmean(imax,jmax),stat=ita)
        allocate (thick(imax,jmax,nlevthick),stat=itha)
        allocate (lsmask(imax,jmax),stat=ilma)
        allocate (masked_out(imax,jmax),stat=imoa)
        allocate (masked_outc(imax,jmax),stat=imoca)
      
        ita=0
        icpsa=0 
        if (phaseflag == 'y') then
          if (phasescheme == 'cps' .or. phasescheme == 'both') then
            if (allocated(cpshgt)) deallocate (cpshgt)
            allocate (cpshgt(imax,jmax,nlevs_cps),stat=icpsa)
          endif
        endif   

        if (iza /= 0 .or. iua /= 0 .or. iha /= 0 .or. ivpa /= 0 .or.
     &      iva /= 0 .or. isa /= 0 .or. icpsa /= 0 .or. ita /= 0 .or.
     &      itha /= 0 .or. imoa /= 0 .or. imoca /= 0 .or. ilma /= 0) 
     &     then
          
          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in sub tracker allocating arrays.'
            print *,'!!! iza = ',iza,' iua= ',iua,' iha= ',iha
            print *,'!!! iva = ',iva,' isa= ',isa,' icpsa= ',icpsa
            print *,'!!! iksa = ',iksa,' isda= ',isda,' ivpa= ',ivpa
            print *,'!!! ita = ',ita,' imoa= ',imoa,' imoca= ',imoca
            print *,'!!! itha = ',itha,' ilma= ',ilma
          endif
          itret = 94
          return
        endif

        masked_out  = .false.   ! Initialize all pts to false at each hr
        masked_outc = .false.   ! Initialize all pts to false at each hr

        if ( verb .ge. 3 ) then 
          print *,'in beginning of tracker, imax= ',imax,' jmax= ',jmax
        endif

c       Initialize all readflags to NOT FOUND for this forecast time,
c       then call subroutine to read data for this forecast time.

        zeta  = -9999.0 
        u     = -9999.0
        hgt   = -9999.0 
        v     = -9999.0
        slp   = -9999.0 
        tmean = -9999.0

        readflag = .FALSE.


        if(enable_timing/=0) then
        call date_and_time (big_ben(1),big_ben(2),big_ben(3),date_time)
        write (6,31) date_time(5),date_time(6),date_time(7)
 31     format (1x,'TIMING: b4 getdata ... ',i2.2,':',i2.2,':',i2.2)
        endif

        if (trkrinfo%inp_data_type == 'grib') then
          call getdata_grib (readflag,valid_pt,imax,jmax
     &               ,ifh,need_to_flip_lats,need_to_flip_lons,inp
     &               ,lugb,lugi,trkrinfo)
        elseif (trkrinfo%inp_data_type == 'netcdf') then
          call getdata_netcdf (ncfile_id,readflag,valid_pt,imax,jmax
     &               ,ifh,need_to_flip_lats,need_to_flip_lons
     &               ,ncfile_tmax,netcdfinfo)
        endif

        if(enable_timing/=0) then
        call date_and_time (big_ben(1),big_ben(2),big_ben(3),date_time)
        write (6,32) date_time(5),date_time(6),date_time(7)
 32     format (1x,'TIMING: after getdata ... ',i2.2,':',i2.2,':',i2.2)
        endif
 
c       Count how many parms were successfully read for this fcst time.
c       Also, for right now, put the value of readflag into all of the
c       calcparms for parameters 3 through 9.  Note that in getdata we
c       read in 17 parms, but in this next loop we only check the 
c       readflags up to maxtp (= 14 as of 7/2015).  That's because
c       parms 12 & 13 are for 500 mb u & v, which are not used for 
c       tracking, only for calculating the deep layer mean wind for
c       the next guess, and parm 14 is the 300-500 mb mean temperature, 
c       which is used for determining storm phase.  Parms 10 & 11 are 
c       for the near-surface winds, which are used in estimating surface
c       winds near the storm, and will now also be used as a
c       parameter for position estimates.  Finally, parm 17 is the 
c       land-sea mask, which is not used as a tracking parm.

        idum = 0
        do irf = 1,nreadparms
          if (readflag(irf)) idum = idum + 1
          if (irf > 2 .and. irf < 10) then 
            ! calcparm for parms > 9 is done further below.
            do jj=1,maxstorm
              calcparm(irf,jj) = readflag(irf)
            enddo
          endif
        enddo          

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'Of ',nreadparms,' readable parms, you read in ',idum
          print *,'parms for this fcst hour from the input grib file.'
        endif

c       If not enough tracked parms were read in, exit the program....

        if (idum == 0) then
          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in subroutine  tracker'
            print *,'!!! Not enough tracked parms read in from getdata.'
            print *,'!!! Check for a problem with the input GRIB file.'
            print *,'!!! Model identifier = ',inp%model
            print *,'!!! STOPPING EXECUTION FOR THIS MODEL'
          endif
          itret = 99
          ifhtemp = ifh
          do while (ifhtemp <= ifhmax)
            do istmp=1,maxstorm
              fixlon (istmp,ifhtemp) = -999.0
              fixlat (istmp,ifhtemp) = -999.0
            enddo
            ifhtemp = ifhtemp + 1
          enddo
cPENG          call output_all (fixlon,fixlat,inp,maxstorm,ifhmax,ioaret)
cPENG          call output_atcf (fixlon,fixlat,inp,xmaxwind,maxstorm,ifhmax
cPENG     &                     ,ioaret)
          if (ifh == 1) then
            ! Per Jim Gross (1/01), if the  tracker ran but was unable
            ! to get an initial fix (or, in this case, unable to get 
            ! the data needed to run), write out zeroes for the 00h 
            ! fixes to indicate that the  tracker ran unsuccessfully, 
            ! but don't write out any subsequent forecast times
            ! with zeroes....
            vradius = 0
            cps_vals(1) =  -9999.0
            cps_vals(2) =  -9999.0
            cps_vals(3) =  -9999.0
            wcore_flag  = 'u'   ! 'u' = initial value of 'undetermined'
            do istmp = 1,maxstorm
              if (stormswitch(istmp) /= 3) then
               ileadtime = nint(fhreal(ifh) * 100.0)
               ifcsthour = ileadtime / 100
               call output_atcfunix (-999.0,-999.0,inp,istmp
     &                   ,ifcsthour,0.0,0.0,vradius,maxstorm
     &                   ,trkrinfo,-99.0,-99.0,-99.0,cps_vals
     &                   ,wcore_flag,ioaxret)
               call output_hfip (-999.0,-999.0,inp,istmp
     &                   ,ifh,0.0,0.0,vradius,-99.0,ioaxret)
              endif
            enddo
          endif
          return
        endif

c          1: 850 mb relative vorticity
c          2: 700 mb relative vorticity
c          3: 850 mb wind circulation difference
c          4: NOT USED
c          5: 700 mb wind circulation differenc
c          6: NOT USED
c          7: 850 mb geopotential height
c          8: 700 mb geopotential height
c          9: MSLP
c         10: 10-m wind circulation difference
c         11: 10-m relative vorticity
c         12: 500-850 mb thickness (lower level)
c         13: 200-500 mb thickness (upper level)
c         14: 200-850 mb thickness (deep-layer)

c       Check the flags that were read in from the namelist for 
c       determining which parameters the user wants to track.
c       Here, check for z850, z700 and mslp....

        if (user_wants_to_track_gph850 == 'n' .or.
     &      user_wants_to_track_gph850 == 'N') then
          do jj=1,maxstorm
            calcparm(7,jj) = .FALSE.
          enddo
        endif

        if (user_wants_to_track_gph700 == 'n' .or.
     &      user_wants_to_track_gph700 == 'N') then
          do jj=1,maxstorm
            calcparm(8,jj) = .FALSE.
          enddo
        endif
          
        if (user_wants_to_track_mslp == 'n' .or.
     &      user_wants_to_track_mslp == 'N') then
          do jj=1,maxstorm
            calcparm(9,jj) = .FALSE.
          enddo
        endif
          

c       Parameters 1 & 2 are abs vorticity at 850 & 700.  If the data 
c       files had this parm at 850 & 700 (ECMWF & UKMET do NOT), then 
c       we don't need to re-calculate relative vorticity, we just need 
c       to subtract out the Coriolis component.  If the files did not
c       have vorticity, then we need to calculate relative vorticity.
c       If we're able to read vorticity or calculate it, then set the
c       vorticity calcparms to TRUE for all storms for now.

        vortloop: do ivort=1,2

          if (ivort == 1) then
            if (user_wants_to_track_zeta850 == 'n' .or.
     &          user_wants_to_track_zeta850 == 'N') then
              do jj=1,maxstorm
                calcparm(1,jj) = .FALSE.
              enddo
              cycle vortloop
            endif
          endif

          if (ivort == 2) then
            if (user_wants_to_track_zeta700 == 'n' .or.
     &          user_wants_to_track_zeta700 == 'N') then
              do jj=1,maxstorm
                calcparm(2,jj) = .FALSE.
              enddo
              cycle vortloop
            endif
          endif

          if (readflag(ivort)) then
          
            call subtract_cor (imax,jmax,dy,ivort)
            
            do jj=1,maxstorm
              calcparm(ivort,jj) = .TRUE.
            enddo
          else
            if (ivort == 1) then
              if (readflag(3) .and. readflag(4)) then
                call rvcal (imax,jmax,dx,dy,ivort,valid_pt)
                do jj=1,maxstorm
                  calcparm(1,jj) = .TRUE.
                enddo
              else
                do jj=1,maxstorm
                  calcparm(1,jj) = .FALSE.
                enddo
              endif
            else
              if (readflag(5) .and. readflag(6)) then
                call rvcal (imax,jmax,dx,dy,ivort,valid_pt)
                do jj=1,maxstorm
                  calcparm(2,jj) = .TRUE.
                enddo
              else
                do jj=1,maxstorm
                  calcparm(2,jj) = .FALSE.
                enddo
              endif
            endif
          endif

        enddo vortloop


c       Check the flags that were read in from the namelist for 
c       determining which parameters the user wants to track.
c       Here, check for user preferences for the wind circulation 
c       difference at 850 & 700...

        if (readflag(3) .and. readflag(4)) then
          if (user_wants_to_track_wcirc850 == 'n' .or.
     &        user_wants_to_track_wcirc850 == 'N') then
            do jj=1,maxstorm
              calcparm(3,jj) = .FALSE.
            enddo
          else
            do jj=1,maxstorm
              calcparm(3,jj) = .TRUE.
            enddo
          endif
        else
          do jj=1,maxstorm
            calcparm(3,jj) = .FALSE.
          enddo
        endif

        if (readflag(5) .and. readflag(6)) then
          if (user_wants_to_track_wcirc700 == 'n' .or.
     &        user_wants_to_track_wcirc700 == 'N') then
            do jj=1,maxstorm
              calcparm(5,jj) = .FALSE.
            enddo
          else
            do jj=1,maxstorm
              calcparm(5,jj) = .TRUE.
            enddo
          endif
        else
          do jj=1,maxstorm
            calcparm(5,jj) = .FALSE.
          enddo
        endif


c       Compute the sfc vorticity if sfc_u and sfc_v have been read in.

        if (readflag(10) .and. readflag(11)) then

          if (user_wants_to_track_wcircsfc == 'n' .or.
     &        user_wants_to_track_wcircsfc == 'N') then
            do jj=1,maxstorm
              calcparm(10,jj) = .FALSE.
            enddo
          else
            do jj=1,maxstorm
              calcparm(10,jj) = .TRUE.
            enddo
          endif

          if (user_wants_to_track_zetasfc == 'n' .or.
     &        user_wants_to_track_zetasfc == 'N') then
            do jj=1,maxstorm
              calcparm(11,jj) = .FALSE.
            enddo
          else
            ! The 3 in the next call to rvcal is to indicate the 3rd 
            ! level for the zeta array, which is for the surface (or 
            ! 10m) data.
            call rvcal (imax,jmax,dx,dy,3,valid_pt)
            do jj=1,maxstorm
              calcparm(11,jj) = .TRUE.
            enddo
          endif

        else
          do jj=1,maxstorm
            calcparm(10,jj) = .FALSE.
            calcparm(11,jj) = .FALSE.
          enddo
        endif


c       Compute the  thicknesses for 200-850, 200-500 and 500-850 mb
c       if the gp hgt fields have been read in for 200, 500 and 850.

        if (readflag(7) .and. readflag(15) .and. readflag(16)) then

          call thickness_calc (imax,jmax,valid_pt)

          do jj=1,maxstorm

            if (user_wants_to_track_thick500850 == 'n' .or.
     &          user_wants_to_track_thick500850 == 'N') then
              calcparm(12,jj) = .FALSE.
            else
              calcparm(12,jj) = .TRUE.
            endif

            if (user_wants_to_track_thick200500 == 'n' .or.
     &          user_wants_to_track_thick200500 == 'N') then
              calcparm(13,jj) = .FALSE.
            else
              calcparm(13,jj) = .TRUE.
            endif

            if (user_wants_to_track_thick200850 == 'n' .or.
     &          user_wants_to_track_thick200850 == 'N') then
              calcparm(14,jj) = .FALSE.
            else
              calcparm(14,jj) = .TRUE.
            endif

          enddo
        else
          if (verb .ge. 3) then
            print *,' '
            print *,'NOTE: Thickness will not be tracked since at least'
            print *,'one of the gp height fields was not read in.'
            print *,'  readflag(7)  -- 850 mb ---> ',readflag(7)
            print *,'  readflag(15) -- 500 mb ---> ',readflag(15)
            print *,'  readflag(16) -- 200 mb ---> ',readflag(16)
            print *,' '
          endif
          do jj=1,maxstorm
            calcparm(12,jj) = .FALSE.
            calcparm(13,jj) = .FALSE.
            calcparm(14,jj) = .FALSE.
          enddo
        endif
 
c       ---------------------------------------------------------------
c       Now call  find_maxmin for the variables zeta, hgt and slp. Only
c       process those storms for which stormswitch is set to 1.  If a
c       storm is selected to be processed, we still have to check the
c       calcparm for each parameter, to make sure that the particular
c       parm exists at that level and is able to be processed.
c
c       The following commented-out data statements are just included 
c       as a reference so you can see the array positioning of the 
c       different parameters and levels that are read in:
c
c       data igparm   /41,41,33,34,33,34,7,7,2,33,34,33,34,11,7,7/
c       data iglevtyp /100,100,100,100,100,100,100,100,102,sfc,sfc
c                     ,100,100,100,100,100/
c       data iglev    /850,700,850,850,700,700,850,700,0,sfc,sfc
c                     ,500,500,400,500,200/
c  
c       And also for reference, here are the variables / levels for
c       the *tracked* parameters (i.e., the "calcparm" elements):
c  
c          1: 850 mb relative vorticity
c          2: 700 mb relative vorticity
c          3: 850 mb wind circulation difference
c          4: NOT USED
c          5: 700 mb wind circulation differenc
c          6: NOT USED
c          7: 850 mb geopotential height
c          8: 700 mb geopotential height
c          9: MSLP
c         10: 10-m wind circulation difference
c         11: 10-m relative vorticity
c         12: 500-850 mb thickness (lower level)
c         13: 200-500 mb thickness (upper level)
c         14: 200-850 mb thickness (deep-layer)
c
c       NOTE: For mid-latitude cases, we will track ONLY mslp, which
c       is why we set all the other calcparms to 'false' just below.

        if (trkrinfo%type == 'midlat') then
          do m = 1,maxstorm
            calcparm(1,m) = .false.
            calcparm(2,m) = .false.
            calcparm(3,m) = .false.
            calcparm(4,m) = .false.
            calcparm(5,m) = .false.
            calcparm(6,m) = .false.
            calcparm(7,m) = .false.
            calcparm(8,m) = .false.
            calcparm(10,m) = .false.
            calcparm(11,m) = .false.
            calcparm(12,m) = .false.
            calcparm(13,m) = .false.
            calcparm(14,m) = .false.
          enddo
        endif

        if (trkrinfo%type == 'midlat' .or. trkrinfo%type == 'tcgen')
     &  then
          call sort_storms_by_pressure (gridprs,ifh,maxstorm,prsindex
     &                                 ,issret)
          if ( (ifh == 1) .or.
     &         (ifh == 2 .and. trkrinfo%inp_data_type == 'netcdf' .and.
     &          ncfile_has_hour0 == 'n') ) then
            stormct = numtcv
          endif
        endif

        prevstormct = stormct
        tracking_previously_known_storms = .true.

        stormloop: do sl_counter = 1,maxstorm

         cps_vals(1) =  -9999.0
         cps_vals(2) =  -9999.0
         cps_vals(3) =  -9999.0
         wcore_flag  = 'u'   ! 'u' = initialized value of 'undetermined'

         if (trkrinfo%type == 'midlat' .or. trkrinfo%type == 'tcgen') 
     &   then
           ist = prsindex(sl_counter)
         else
           ist = sl_counter
         endif

         if (trkrinfo%type == 'midlat' .or. trkrinfo%type == 'tcgen') 
     &   then

           if (ist == (prevstormct + 1)) then

             ! For the mid-latitude and tropical cyclogenesis cases, we
             ! need to scan the mslp field to find new storms.  If we 
             ! are at this point inside the if statement in stormloop,
             ! then that means we have looped through and attempted to 
             ! track all storms that have already been found up to this 
             ! point in the forecast, and we need to scan the field for
             ! any new storms at this forecast hour.  If this is for 
             ! forecast hour = 0, then right off the bat we may be 
             ! scanning the field (if there were no tcvitals records
             ! read in for this forecast), since ist = 1 and 
             ! (prevstormct + 1) = 0 + 1 = 1.  All that the call just 
             ! below to first_ges_center does is return a rough idea 
             ! of the location of new lows; more specific locations are
             ! obtained through the  barnes analysis tracking algorithm 
             ! further below.

             if (readflag(9)) then
               if (ifh > 1) then
                 ! We need the use of 2 different masks.  One 
                 ! (masked_out) is to be used when looking for new lows,
                 ! so that after we find a new low, we mask out the 
                 ! surrounding area so we don't find it on a subsequent 
                 ! search for this forecast hour.  The other 
                 ! (masked_outc) is used in the routine to check for a 
                 ! closed contour.  If checking for a closed contour
                 ! at, say 70W/25N, this and surrounding points may have
                 ! already been masked out in first_ges_center, so "N"
                 ! would misleadingly/incorrectly be returned from 
                 ! check_closed_contour, so that is why we need 2 masks.
                 ! But now after the first forecast hour (t=0), the way 
                 ! we have this set up is that we track previously known
                 ! storms first, and once we're done with them, we 
                 ! search for new storms at that same forecast hour.  
                 ! But when looking for new storms, we need to know the 
                 ! positions of the previously tracked storms at this 
                 ! current forecast hour, so we copy the masked_outc 
                 ! array to masked_out in this case....

                 masked_out = masked_outc

               endif
               call first_ges_center (imax,jmax,dx,dy,'mslp',slp
     &                ,'min',trkrinfo,ifh,valid_pt,maxstorm,masked_out
     &                ,stormct,contour_info,maxmini,maxminj,ifgcret)
               tracking_previously_known_storms = .false.
             else
               if ( verb .ge. 1 ) then
                 print *,' '
                 print *,'!!! ERROR: In subroutine  tracker, readflag'
                 print *,'!!!    for mslp indicates that the mslp data'
                 print *,'!!!    is not available for this forecast '
                 print *,'!!!    hour, and it is needed for a "midlat"'
                 print *,'!!!    or "tcgen" run of the  tracker.  '
                 print *,'!!!    We will exit....'
                 print *,'!!!    readflag(9) = ',readflag(9)
                 print *,'!!!    ifh= ',ifh
                 print *,' '
               endif
               itret = 98
               return
             endif
           endif
         endif

         xval = 0.0     ! initialize entire xval array to 0
         isastorm = 'U' ! re-initialize flag for each time, each storm
 
         select case (stormswitch(ist))

          case (1)

            vradius = 0

            if ( verb .ge. 2 ) then
              print *,'   ---------------------------------------------'
              print *,'   |      *** TOP OF STORM LOOP ***             '
              print *,'   | Beginning of storm loop in tracker for'
              print *,'   | Storm number ',ist
              write (6,418) ifhours(ifh),ifclockmins(ifh)
 418          format (1x,'   | Forecast hour: ',i4,':',i2.2)
              print *,'   | Storm name = ',storm(ist)%tcv_storm_name
              print *,'   | Storm ID   = ',storm(ist)%tcv_storm_id
              write (6,420) gstorm(ist)%gv_gen_date
     &             ,gstorm(ist)%gv_gen_fhr
     &             ,gstorm(ist)%gv_gen_lat
     &             ,gstorm(ist)%gv_gen_latns,gstorm(ist)%gv_gen_lon
     &             ,gstorm(ist)%gv_gen_lonew,gstorm(ist)%gv_gen_type
              print *,'   ---------------------------------------------'
              print *,' '
              
 420          format ('    | Gen ID (if available): ',i10.10,'_F',i3.3
     &             ,'_',i3.3,a1,'_',i4.4,a1,'_',a3)
              
            endif
c           First, make sure storm is within the grid boundaries...
 
            call check_bounds (slonfg(ist,ifh),slatfg(ist,ifh),ist,ifh
     &                        ,trkrinfo,icbret)
            if (icbret == 95) then   ! Out of regional grid bounds
              fixlon (ist,ifh) = -999.0
              fixlat (ist,ifh) = -999.0
              stormswitch(ist) = 2
              cycle stormloop
            endif

            if (slatfg(ist,ifh) > 0.0) then
              cvort_maxmin = 'max'
            else
              cvort_maxmin = 'min'
            endif

            if (calcparm(1,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for zeta at 850 mb'
              endif

              call find_maxmin (imax,jmax,dx,dy,'zeta'
     &           ,zeta(1,1,1),cvort_maxmin,ist,slonfg(ist,ifh)
     &           ,slatfg(ist,ifh),glon,glat,valid_pt,trkrinfo
     &           ,calcparm(1,ist),clon(ist,ifh,1),clat(ist,ifh,1)
     &           ,xval(1),glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif 
            endif

            if (calcparm(2,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for zeta at 700 mb'
              endif

              call find_maxmin (imax,jmax,dx,dy,'zeta'
     &           ,zeta(1,1,2),cvort_maxmin,ist,slonfg(ist,ifh)
     &           ,slatfg(ist,ifh),glon,glat,valid_pt,trkrinfo
     &           ,calcparm(2,ist),clon(ist,ifh,2),clat(ist,ifh,2)
     &           ,xval(2),glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif
            endif

            if (calcparm(7,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for hgt at 850 mb'
              endif

              call find_maxmin (imax,jmax,dx,dy,'hgt'
     &           ,hgt(1,1,1),'min',ist,slonfg(ist,ifh),slatfg(ist,ifh)
     &           ,glon,glat,valid_pt,trkrinfo,calcparm(7,ist)
     &           ,clon(ist,ifh,7),clat(ist,ifh,7),xval(7)
     &           ,glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif
            endif

            if (calcparm(8,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for hgt at 700 mb'
              endif

              call find_maxmin (imax,jmax,dx,dy,'hgt'
     &           ,hgt(1,1,2),'min',ist,slonfg(ist,ifh),slatfg(ist,ifh)
     &           ,glon,glat,valid_pt,trkrinfo,calcparm(8,ist)
     &           ,clon(ist,ifh,8),clat(ist,ifh,8),xval(8)
     &           ,glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif
            endif

            if (calcparm(9,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for mslp'
              endif

              call find_maxmin (imax,jmax,dx,dy,'slp'
     &           ,slp,'min',ist,slonfg(ist,ifh),slatfg(ist,ifh)
     &           ,glon,glat,valid_pt,trkrinfo,calcparm(9,ist)
     &           ,clon(ist,ifh,9),clat(ist,ifh,9),xval(9)
     &           ,glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif
            endif

            if (calcparm(11,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for sfc zeta'
              endif

              call find_maxmin (imax,jmax,dx,dy,'zeta'
     &           ,zeta(1,1,3),cvort_maxmin,ist,slonfg(ist,ifh)
     &           ,slatfg(ist,ifh),glon,glat,valid_pt,trkrinfo
     &           ,calcparm(11,ist),clon(ist,ifh,11),clat(ist,ifh,11)
     &           ,xval(11),glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif
            endif

c           The array indices for the 3 different thickness layers are
c           as follows:
c             1: 500-850
c             2: 200-500
c             3: 200-850

            if (calcparm(12,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for thickness in'
                print *,'the 500-850 mb layer.'
              endif

              call find_maxmin (imax,jmax,dx,dy,'thick'
     &           ,thick(1,1,1),'max',ist,slonfg(ist,ifh),slatfg(ist,ifh)
     &           ,glon,glat,valid_pt,trkrinfo,calcparm(12,ist)
     &           ,clon(ist,ifh,12),clat(ist,ifh,12),xval(12)
     &           ,glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif
            endif

            if (calcparm(13,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for thickness in'
                print *,'the 200-500 mb layer.'
              endif

              call find_maxmin (imax,jmax,dx,dy,'thick'
     &           ,thick(1,1,2),'max',ist,slonfg(ist,ifh),slatfg(ist,ifh)
     &           ,glon,glat,valid_pt,trkrinfo,calcparm(13,ist)
     &           ,clon(ist,ifh,13),clat(ist,ifh,13),xval(13)
     &           ,glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif
            endif

            if (calcparm(14,ist)) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'         ---    ---    ---'
                print *,'Now calling find_maxmin for thickness in'
                print *,'the 200-850 mb layer.'
              endif

              call find_maxmin (imax,jmax,dx,dy,'thick'
     &           ,thick(1,1,3),'max',ist,slonfg(ist,ifh),slatfg(ist,ifh)
     &           ,glon,glat,valid_pt,trkrinfo,calcparm(14,ist)
     &           ,clon(ist,ifh,14),clat(ist,ifh,14),xval(14)
     &           ,glatmax,glatmin,glonmax,glonmin
     &           ,inp%modtyp,ifmret)
              if (ifmret /= 0) then   ! Out of regional grid bounds
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop
              endif
            endif

c           Now get centers for wind circulation at 700 & 850 mb and
c           at 10m.  First, get a modified guess lat/lon position for
c           wind circulation.  Do this because we will be searching 
c           for this wind circulation center over a smaller area and
c           so it's more crucial to have a better first guess position.
c           This modified guess position will be an average of the first
c           guess position for this time and the  fix positions for this
c           time from some of the other parameters.

            if (slatfg(ist,ifh) >= 0.0) then
              cmaxmin = 'max'
            else
              cmaxmin = 'min'
            endif

            if (calcparm(3,ist) .and. calcparm(4,ist)) then
              call get_uv_guess (slonfg(ist,ifh),slatfg(ist,ifh)
     &                          ,clon,clat,calcparm,ist,ifh,maxstorm
     &                          ,uvgeslon,uvgeslat,igugret)
              if (igugret == 0) then

                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'          ---    ---    ---'
                  print *,'Now calling get_wind_circulation for 850 mb '
                endif

                print *,' '
                print *,'Before first call to get_wind_circulation, '
                print *,' glatmax= ',glatmax
                print *,' glatmin= ',glatmin
                print *,' glonmax= ',glonmax
                print *,' glonmin= ',glonmin
                print *,' trkrinfo%gridtype= ',trkrinfo%gridtype
                print *,' inp%modtyp= ',inp%modtyp
                print *,' cmaxmin= ',cmaxmin
                print *,' nlev850= ',nlev850
                print *,' u(1,1,nlev850)= ',u(1,1,nlev850)
                print *,' u(imax,jmax,nlev850)= ',u(imax,jmax,nlev850)
                print *,' imax= ',imax,'  jmax= ',jmax
                print *,' uvgeslon= ',uvgeslon,'  uvgeslat= ',uvgeslat
                print *,' dx= ',dx,' dy= ',dy,' ist= ',ist
                print *,' calcparm(3,ist)= ',calcparm(3,ist)
                print *,' clon(ist,ifh,3)= ',clon(ist,ifh,3)
                print *,' clat(ist,ifh,3)= ',clat(ist,ifh,3)
                print *,' xval(3)= ',xval(3)

                if (enable_timing/=0) then
                  call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                               ,date_time)
                  write (6,141) date_time(5),date_time(6),date_time(7)
 141              format (1x,'TIMING: Before GWC 850 ... ',i2.2,':',i2.2
     &                   ,':',i2.2)
                endif

                call get_wind_circulation (uvgeslon,uvgeslat,imax,jmax
     &               ,dx,dy,ist,850,valid_pt,calcparm(3,ist)
     &               ,clon(ist,ifh,3),clat(ist,ifh,3),xval(3),trkrinfo
     &               ,inp%modtyp,cmaxmin,igwcret)

                if (enable_timing/=0) then
                  call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                               ,date_time)
                  write (6,142) date_time(5),date_time(6),date_time(7)
 142              format (1x,'TIMING: After GWC 850 ... ',i2.2,':',i2.2
     &                   ,':',i2.2)
                endif

c                call get_uv_center (uvgeslon,uvgeslat,imax,jmax,dx,dy
c     &               ,ist,850,valid_pt,calcparm(3,ist)
c     &               ,clon(ist,ifh,3),clat(ist,ifh,3),xval(3),trkrinfo
c     &               ,igucret)

                if (igwcret /= 0) then
                  calcparm(3,ist) = .FALSE.
                  calcparm(4,ist) = .FALSE.
                endif
              else
                calcparm(3,ist) = .FALSE.
                calcparm(4,ist) = .FALSE.
                clon(ist,ifh,3) = 0.0
                clat(ist,ifh,3) = 0.0
              endif 
            endif
  
            if (calcparm(5,ist).and. calcparm(6,ist)) then
              call get_uv_guess (slonfg(ist,ifh),slatfg(ist,ifh)
     &                          ,clon,clat,calcparm,ist,ifh,maxstorm
     &                          ,uvgeslon,uvgeslat,igugret)
              if (igugret == 0) then

                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'          ---    ---    ---'
                  print *,'Now calling get_wind_circulation for 700 mb '
                endif

                if (enable_timing/=0) then
                  call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                               ,date_time)
                  write (6,143) date_time(5),date_time(6),date_time(7)
 143              format (1x,'TIMING: Before GWC 700 ... ',i2.2,':',i2.2
     &                   ,':',i2.2)
                endif

                call get_wind_circulation (uvgeslon,uvgeslat,imax,jmax
     &               ,dx,dy,ist,700,valid_pt,calcparm(5,ist)
     &               ,clon(ist,ifh,5),clat(ist,ifh,5),xval(5),trkrinfo
     &               ,inp%modtyp,cmaxmin,igwcret)

                if (enable_timing/=0) then
                  call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                               ,date_time)
                  write (6,144) date_time(5),date_time(6),date_time(7)
 144              format (1x,'TIMING: After GWC 700 ... ',i2.2,':',i2.2
     &                   ,':',i2.2)
                endif

c                call get_uv_center (uvgeslon,uvgeslat,imax,jmax,dx,dy
c     &               ,ist,700,valid_pt,calcparm(5,ist)
c     &               ,clon(ist,ifh,5),clat(ist,ifh,5),xval(5),trkrinfo
c     &               ,igucret)

                if (igwcret /= 0) then
                  calcparm(5,ist) = .FALSE.
                  calcparm(6,ist) = .FALSE.
                endif
              else 
                calcparm(5,ist) = .FALSE.
                calcparm(6,ist) = .FALSE.
                clon(ist,ifh,5) = 0.0
                clat(ist,ifh,5) = 0.0
              endif
            endif

            if (calcparm(10,ist)) then
              call get_uv_guess (slonfg(ist,ifh),slatfg(ist,ifh)
     &                          ,clon,clat,calcparm,ist,ifh,maxstorm
     &                          ,uvgeslon,uvgeslat,igugret)
              if (igugret == 0) then

                if ( verb .ge. 3 ) then
                  print *,' '                                             
                  print *,'          ---    ---    ---'
                  print *,'Now calling get_wind_circulation for the'
                  print *,'surface (10m) level'
                endif

                ! NOTE: The 1020 in the call here is just a number/code
                ! to indicate to the subroutine to process sfc winds.

                if (enable_timing/=0) then
                  call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                               ,date_time)
                  write (6,145) date_time(5),date_time(6),date_time(7)
 145              format (1x,'TIMING: Before GWC Sfc ... ',i2.2,':',i2.2
     &                   ,':',i2.2)
                endif

                call get_wind_circulation (uvgeslon,uvgeslat,imax,jmax
     &                ,dx,dy,ist,1020,valid_pt,calcparm(10,ist)
     &                ,clon(ist,ifh,10),clat(ist,ifh,10),xval(10)
     &                ,trkrinfo,inp%modtyp,cmaxmin,igwcret)

                if (enable_timing/=0) then
                  call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                               ,date_time)
                  write (6,146) date_time(5),date_time(6),date_time(7)
 146              format (1x,'TIMING: After GWC Sfc ... ',i2.2,':',i2.2
     &                   ,':',i2.2)
                endif

c                call get_uv_center (uvgeslon,uvgeslat,imax,jmax,dx,dy
c     &               ,ist,1020,valid_pt,calcparm(10,ist)
c     &               ,clon(ist,ifh,10),clat(ist,ifh,10),xval(10)
c     &               ,trkrinfo,igucret)

                if (igwcret /= 0) then
                  calcparm(10,ist) = .FALSE.
                endif
              else
                calcparm(10,ist) = .FALSE.
                clon(ist,ifh,10) = 0.0
                clat(ist,ifh,10) = 0.0
              endif
            endif
  
c           ------------------------------------------------------
c           All of the parameter center fixes have been done.  Now 
c           average those positions together to get the best guess
c           fix position.  If a center fix is able to be made, then
c           call subroutine  get_max_wind to get the maximum near-
c           surface wind near the center, and then call  get_next_ges
c           to get a guess position for the next forecast hour.

            if (stormswitch(ist) == 1) then

              call fixcenter (clon,clat,ist,ifh,calcparm
     &             ,slonfg(ist,ifh),slatfg(ist,ifh),inp
     &             ,stderr,fixlon,fixlat,xval,maxstorm,ifret)

              if (ifret == 0) then
                if ((trkrinfo%type == 'midlat' .or.
     &               trkrinfo%type == 'tcgen') .and.
     &               trkrinfo%gridtype == 'regional')then
                  if (fixlon(ist,ifh) > (trkrinfo%eastbd + 7.0) .or.
     &                fixlon(ist,ifh) < (trkrinfo%westbd - 7.0) .or.
     &                fixlat(ist,ifh) > (trkrinfo%northbd + 7.0) .or.
     &                fixlat(ist,ifh) < (trkrinfo%southbd - 7.0)) then

                    if ( verb .ge. 3 ) then
                      print *,' '      
                      print *,'!!! For a midlat or tcgen case, a fix '
                      print *,'!!! will NOT be made for this time due'
                      print *,'!!! the storm being more than 7 degrees'
                      print *,'!!! outside the user-specified lat/lon'
                      print *,'!!! bounds for this run.  We will stop'
                      print *,'!!! tracking this storm.'
                      print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
                      print *,'!!! Storm    = '
     &                       ,storm(ist)%tcv_storm_name
                      write (6,432) ifhours(ifh),ifclockmins(ifh)
 432                  format (1x,'!!! Fcst hr  = ',i4,':',i2.2)
                      print *,'!!! fixlat= ',fixlat(ist,ifh)
                      print *,'!!! fixlon= ',fixlon(ist,ifh)
                      print *,'!!! User East  Bound = ',trkrinfo%eastbd
                      print *,'!!! User West  Bound = ',trkrinfo%westbd
                      print *,'!!! User North Bound = ',trkrinfo%northbd
                      print *,'!!! User South Bound = ',trkrinfo%southbd
                    endif

                    fixlon (ist,ifh) = -999.0
                    fixlat (ist,ifh) = -999.0
                    stormswitch(ist) = 2
                    if (ifh == 1) then
                      vradius = 0     
                      ileadtime = nint(fhreal(ifh) * 100.0)
                      ifcsthour = ileadtime / 100
                      call output_atcfunix (-999.0
     &                    ,-999.0,inp,ist
     &                    ,ifcsthour,0.0
     &                    ,0.0,vradius,maxstorm,trkrinfo
     &                    ,-99.0,-99.0,-99.0
     &                    ,cps_vals,wcore_flag,ioaxret)
                      imeanzeta = -99
                      igridzeta = -99
                      call output_atcf_gen (-999.0
     &                      ,-999.0,inp,ist
     &                      ,ifcsthour,0.0
     &                      ,0.0,vradius,maxstorm,trkrinfo
     &                      ,-99,-99,-999.0,-999.0,-99.0
     &                      ,cps_vals,'u',imeanzeta,igridzeta,ioaxret)
                      call output_atcf_sink (-999.0
     &                      ,-999.0,inp,ist
     &                      ,ifcsthour,0.0
     &                      ,0.0,vradius,maxstorm,trkrinfo
     &                      ,-99,-99,imeanzeta,igridzeta
     &                      ,cps_vals,-999.0,-999.0,ioaxret)
                    endif
                    cycle stormloop     
                  endif
                endif
              else
                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
              endif

c             Just because we've found a center doesn't mean there is
c             actually a storm there.  I noticed in the first year that
c             for some decaying or just weak storms, the  tracker would
c             identify a center to follow, but it may have only been
c             a weak trough passing by, or something else that's not
c             our storm.  This next subroutine checks to see that the 
c             surface pressure gradient and/or tangential winds at 
c             850 mb resemble a storm.  It is called twice; the first
c             time for MSLP, the 2nd time for 850 mb winds.  We will
c             apply these storm-checking criteria if either the mslp
c             or v850 check come back negative.  Remember, there
c             is the possibility that centers could not be found for 
c             1 or both of these parameters, in which case the isastorm
c             flag will have a value of 'U', for "undetermined".

              isiret1 = 0; isiret2 = 0; isiret3 = 0

              print *,' ttest, ifret= ',ifret

              if (ifret == 0) then

                print *,' ttest, calcparm(9,ist)= ',calcparm(9,ist)

                if (calcparm(9,ist)) then

                  ! Do a check of the mslp gradient....

                  print *,' ttest, in IF part: ' 
                  print *,'     clon(ist,ifh,9)= ',clon(ist,ifh,9)
                  print *,'     clat(ist,ifh,9)= ',clat(ist,ifh,9)
                  print *,'     xval(9)= ',xval(9)

                  call is_it_a_storm (imax,jmax,dx,dy,'slp',ist
     &                 ,valid_pt,clon(ist,ifh,9),clat(ist,ifh,9)
     &                 ,xval(9),trkrinfo,isastorm(1),isiret1)

                else

                  ! Sept 2016: There has been a hole in this logic for
                  ! a while.  If a fix can't be made for mslp (e.g., 
                  ! maybe the mslp fix was too far away from the 
                  ! guess?), then this check isn't performed.  We are 
                  ! changing this so that the mslp gradient check will
                  ! still be performed, but using the mean fixlat and
                  ! fixlon positions as the center.  Still, we first
                  ! need to check to see if mslp was even read in.  If
                  ! it wasn't, then we are just out of luck.

                  print *,' ttest, in ELSE part: '

                  if (trkrinfo%use_backup_mslp_grad_check == 'y' .or.
     &                trkrinfo%use_backup_mslp_grad_check == 'Y') then

                    print *,' ttest ELSE, readflag(9)= ',readflag(9)

                    if (readflag(9)) then

                      print *,'ttest ELSE A, ist= ',ist,' ifh= ',ifh
                      print *,'ttest ELSE A, fixlon(ist,ifh)= '
     &                       ,fixlon(ist,ifh)
                      print *,'ttest ELSE A, fixlat(ist,ifh)= '
     &                       ,fixlat(ist,ifh)

                      call fix_latlon_to_ij (imax,jmax,dx,dy,slp,'min'
     &                   ,valid_pt,fixlon(ist,ifh),fixlat(ist,ifh)
     &                   ,9999.0,ifix,jfix,gridpoint_maxmin,'tracker'
     &                   ,glatmax,glatmin,glonmax,glonmin
     &                   ,trkrinfo,ifilret)

                      print *,'ttest ELSE B, ifilret= ',ifilret

                      if (ifilret == 0) then

                        print *,'ttest ELSE B, ifilret= ',ifilret
                        print *,'ttest ELSE B, fixlon(ist,ifh)= '
     &                         ,fixlon(ist,ifh)
                        print *,'ttest ELSE B, fixlat(ist,ifh)= '
     &                         ,fixlat(ist,ifh)

                        call is_it_a_storm (imax,jmax,dx,dy,'slp',ist
     &                     ,valid_pt,fixlon(ist,ifh),fixlat(ist,ifh)
     &                     ,gridpoint_maxmin,trkrinfo,isastorm(1)
     &                     ,isiret1)

                        if (isiret1 == 0) then
                          ! Even though calcparm(9) is FALSE and mslp 
                          ! will not be used for center-fixing 
                          ! purposes, we need to fill the clat and clon
                          ! arrays just a few lines below so that 
                          ! calls to fix_latlon_to_ij below do not 
                          ! get screwed up.  So, into the clat and clon
                          ! arrays we put the mean fixlat and fixlon
                          ! positions for this lead time. 
                          clat(ist,ifh,9) = fixlat(ist,ifh)
                          clon(ist,ifh,9) = fixlon(ist,ifh)
                          xval(9) = gridpoint_maxmin
                        endif

                      endif

                    endif

                  endif

                endif

                ! If we have found a valid mslp gradient, then make
                ! a call to fix_latlon_to_ij to (1) get the actual
                ! gridpoint value of the mslp (the value previously
                ! stored in xval(9) is an area-averaged value coming
                ! from the  barnes analysis), and (2) to get the 
                ! (i,j) indices for this gridpoint to be used in the
                ! call to check_closed_contour below.
                !
                ! NOTE: If a mslp fix was not made, or if the mslp
                ! "isastorm" flag comes back as no, we make the same
                ! call to fix_latlon_to_ij, but we use the mean fix
                ! position as our input to search around, and then
                ! basically we just find the lowest mslp near that
                ! mean fix position.  There is a check on the value
                ! of xinp_fixlat and xinp_fixlon to make sure that 
                ! they contain valid values and not just the 
                ! initialized -999 values.

                if (isiret1 == 0 .and. isastorm(1) == 'Y') then
                  xinp_fixlat = clat(ist,ifh,9)
                  xinp_fixlon = clon(ist,ifh,9)
                  if (verb >= 3) then
                    print *,' ttest at location C IF....'
                    print *,'     xinp_fixlat= ',xinp_fixlat
                    print *,'     xinp_fixlon= ',xinp_fixlon
                  endif
                else
                  xinp_fixlat = fixlat(ist,ifh)
                  xinp_fixlon = fixlon(ist,ifh)
                  if (verb >= 3) then
                    print *,' ttest at location C ELSE....'
                    print *,'     xinp_fixlat= ',xinp_fixlat
                    print *,'     xinp_fixlon= ',xinp_fixlon
                  endif
                endif

                if (xinp_fixlat > -99.0 .and. xinp_fixlon > -990.0) 
     &          then
                  if (verb >= 3) then
                    print *,' ttest at location D'
                  endif
                  call fix_latlon_to_ij (imax,jmax,dx,dy,slp,'min'
     &               ,valid_pt,xinp_fixlon,xinp_fixlat
     &               ,xval(9),ifix,jfix,gridpoint_maxmin,'tracker'
     &               ,glatmax,glatmin,glonmax,glonmin
     &               ,trkrinfo,ifilret)
                  if (verb >= 3) then
                    print *,' ttest at location E, ifilret= ',ifilret
                  endif
                  if (ifilret == 0) then  
                    gridprs(ist,ifh) = gridpoint_maxmin
                  else          
                    ! Search went out of regional grid bounds....
                    fixlon (ist,ifh) = -999.0
                    fixlat (ist,ifh) = -999.0
                    stormswitch(ist) = 2
                    cycle stormloop     
                  endif
                endif

                print *,' ttest at location F'

                ! For a "tracker" case, check to see if the user has
                ! requested to compute and write out the ROCI.  If 
                ! so, then we make a call to check_closed_contour,
                ! being sure to specify 999 as the number of levels
                ! to check....

                if (isiret1 == 0 .and. isastorm(1) == 'Y' .and.
     &              trkrinfo%type == 'tracker') then

                  if (trkrinfo%want_oci) then

                    if ( verb .ge. 3 ) then
                      print *,' '
                      print *,'Before call to check_closed_contour, '
                      print *,'ifix= ',ifix,' jfix= ',jfix
                      print *,'longitude= ',xinp_fixlon,'E   ('
     &                     ,360-xinp_fixlon,'W)'
                      print *,'latitude= ',xinp_fixlat
                      print *,'mean mslp value (xval(9))= ',xval(9)
                    endif

                    if (contour_info%numcont == 0) then
                      contour_info%numcont = maxconts
                    endif

                    if (xval(9) < 1100.0) then
                      ! Pressure units are in mb...
                      prs_contint_thresh = 4.0
                    elseif (xval(9) >80000.0) then
                      ! Pressure units are in Pa...
                      prs_contint_thresh = 400.0
                    else
                      if (verb .ge. 3) then
                        print *,' '
                        print *,'ERROR: Something wrong in subroutine'
                        print *,'       tracker.  The mslp value'
                        print *,'       (xval(9)) is not in range.'
                        print *,'       before call to'
                        print *,'       check_closed_contour.'
                        print *,'       xval(9) = ',xval(9) 
                        print *,'       EXITING....' 
                        print *,' ' 
                        stop 95
                      endif
                    endif
 
                    if (trkrinfo%contint < prs_contint_thresh) then
                      hold_old_contint = trkrinfo%contint
                      trkrinfo%contint = prs_contint_thresh
                      if ( verb .ge. 3 ) then
                        print *,' '
                        print *,'Before going into routine to diagnose'
                        print *,'the ROCI for a tracker run, the '
                        print *,'requested contour interval is being '
                        print *,'adjusted up (coarser) to avoid having'
                        print *,'the contour check routine break and '
                        print *,'return an invalid value.'
                        print *,'User-requested contint value (Pa) = '
     &                         ,hold_old_contint
                        print *,'Modified contint value (Pa) = '
     &                         ,trkrinfo%contint
                      endif
                    endif

                    masked_outc = .false.
                    get_last_isobar_flag = 'y'
                    call check_closed_contour (imax,jmax,ifix,jfix,slp
     &                  ,valid_pt,masked_outc,ccflag,'min',trkrinfo
     &                  ,999,contour_info,get_last_isobar_flag,plastbar
     &                  ,rlastbar,icccret)

                    if ( verb .ge. 3 ) then
                      print *,' '
                      print *,'After call to check_closed_contour, '
                      print *,'ifix= ',ifix,' jfix= ',jfix
                      print *,'longitude= ',xinp_fixlon,'E   ('
     &                     ,360-xinp_fixlon,'W)'
                      print *,'latitude= ',xinp_fixlat
                      print *,'mean mslp value (xval(9))= ',xval(9)
                      print *,'gridpoint mslp value= ',slp(ifix,jfix)
                      print *,'ccflag= ',ccflag
                      print *,'prs of last closed isobar = ',plastbar
                      print *,'radius of last closed isobar = '
     &                     ,rlastbar,' nm'
                      print *,' '
                    endif

                  endif

                endif

                ! For the midlat & tcgen cases, do a check to see if
                ! there is a closed mslp contour.  The ifix and jfix
                ! values passed into check_closed_contour are the 
                ! values for the (i,j) at the gridpoint minimum, 
                ! which was obtained just above from the call to
                ! fix_latlon_to_ij.
                ! UPDATE 7/12/2016 tpm: A change was made to fix a 
                ! hole in the logic.  Previously, for a genesis run
                ! (type = midlat or tcgen), if a fix was not made 
                ! for mslp, then the isastorm(1) flag would not be 
                ! 'Y', and so the call to check_closed_contour in
                ! the following IF statement would not be made, and
                ! that would prevent the mask from getting updated
                ! for this particular storm, allowing the same storm
                ! to be detected when the scan for new storms takes
                ! place at this lead time (i.e., after all previously-
                ! known storms from the last lead time have been 
                ! tracked).  As a fix, if that isastorm(1) flag is not
                ! 'Y', then we call a new subroutine which updates the
                ! mask based on the circulation at 850 mb.

                if (isastorm(1) == 'Y' .and. isiret1 == 0 .and.
     &              (trkrinfo%type == 'midlat' .or.
     &               trkrinfo%type == 'tcgen')) then

                  if ( verb .ge. 3 ) then
                    print *,' '
                    print *,'Before call to check_closed_contour, '
                    print *,'ifix= ',ifix,' jfix= ',jfix
                    print *,'longitude= ',xinp_fixlon,'E   ('
     &                   ,360-xinp_fixlon,'W)'
                    print *,'latitude= ',xinp_fixlat
                    print *,'mean mslp value (xval(9))= ',xval(9)
                  endif

                  if (contour_info%numcont == 0) then
                    contour_info%numcont = maxconts
                  endif

                  get_last_isobar_flag = 'y'
                  call check_closed_contour (imax,jmax,ifix,jfix,slp
     &                ,valid_pt,masked_outc,ccflag,'min',trkrinfo
     &                ,999,contour_info,get_last_isobar_flag,plastbar
     &                ,rlastbar,icccret)

                  if ( verb .ge. 3 ) then
                    print *,' '
                    print *,'After call to check_closed_contour, '
                    print *,'ifix= ',ifix,' jfix= ',jfix
                    print *,'longitude= ',xinp_fixlon,'E   ('
     &                   ,360-xinp_fixlon,'W)'
                    print *,'latitude= ',xinp_fixlat
                    print *,'mean mslp value (xval(9))= ',xval(9)
                    print *,'gridpoint mslp value= ',slp(ifix,jfix)
                    print *,'ccflag= ',ccflag
                    print *,'prs of last closed isobar = ',plastbar
                    print *,'radius of last closed isobar = ',rlastbar
     &                   ,' nm'
                    print *,' '
                  endif

                  ! This next bit of code adds a second layer of closed
                  ! contour checking.  This is to decrease the 
                  ! occurrence of interrupted midlat and tcgen tracks,
                  ! which usually happens when the closed contour 
                  ! criterion is not met for one time period.  So in 
                  ! this next code, we check to see if the ccflag was 
                  ! 'y' for at least half the time over the last 24h.  
                  ! For time periods shorter than 24h (e.g., the storm 
                  ! was just detected at 144h and we are now at 156h),
                  ! the threshold is still that for at least half of 
                  ! the time the system has been detected as a storm,
                  ! it must have a ccflag value of 'y'.

                  if (ccflag == 'y') then
                    closed_mslp_ctr_flag(ist,ifh) = 'y'
                  else
                    closed_mslp_ctr_flag(ist,ifh) = 'n'
                    if (ifh > 1) then
                      iccfh = ifh
                      cc_time_sum_tot = 0.0
                      cc_time_sum_yes = 0.0
                      do while (iccfh > 1 .and. 
     &                     closed_mslp_ctr_flag(ist,iccfh) /= 'u' .and.
     &                     cc_time_sum_tot < 24.0)
                        xinterval_fhr = fhreal(iccfh) - fhreal(iccfh-1)
                        cc_time_sum_tot = cc_time_sum_tot 
     &                                  + xinterval_fhr
                        if (closed_mslp_ctr_flag(ist,iccfh) == 'y') then
                          cc_time_sum_yes = cc_time_sum_yes 
     &                                    + xinterval_fhr
                        endif
                        iccfh = iccfh - 1
                      enddo
                      if (cc_time_sum_tot > 0.0) then
                        cc_time_pct = cc_time_sum_yes / cc_time_sum_tot
                      else
                        cc_time_pct = 0.0
                      endif
                      if (cc_time_pct >= 0.50) then
                        ccflag = 'y'

                        if ( verb .ge. 3 ) then
                          print *,' '
                          print *,'++ NOTE ON CLOSED CONTOUR CHECK: The'
                          print *,'   ccflag returned for this hour was'
                          print *,'   NO, but a check of recent ccflags'
                          print *,'   indicates that more than 50% of '
                          print *,'   the ccflags over the last 24h are'
                          print *,'   YES, so we will continue.'
                          print *,'   cc_time_pct= ',cc_time_pct
                          print *,' '
                        endif

                      else
                        ccflag = 'n'

                        if ( verb .ge. 3 ) then
                          print *,' '
                          print *,'!! NOTE ON CLOSED CONTOUR CHECK: The'
                          print *,'!! ccflag returned for this hour was'
                          print *,'   NO, and a check of recent ccflags'
                          print *,'   indicates that less than 50% of '
                          print *,'   the ccflags over the last 24h are'
                          print *,'   YES, so we will stop tracking.'
                          print *,'   cc_time_pct= ',cc_time_pct
                        endif

                      endif
                    endif
                  endif

                  if (ccflag == 'y') then
                    isastorm(2) = 'Y'
                  else if (ccflag == 'n') then
                    isastorm(2) = 'N'
                  endif

                  if ( verb .ge. 3 ) then
                    print *,' '
                    print *,'*---------------------------------------*'
                    print *,'* After check_closed_contour...         *'
                    print *,'*---------------------------------------*'
                    print *,' '
                  endif


                else if (isastorm(1) /= 'Y' .and.
     &               calcparm(3,ist) .and.
     &              (trkrinfo%type == 'midlat' .or.
     &               trkrinfo%type == 'tcgen')) then

                  ! The isastorm(1) flag indicates that a mslp gradient
                  ! could not be found at this lead time, so the mask
                  ! cannot be updated using mslp.  Instead,
                  ! do a check of the 850 mb wind circulation 
                  ! surrounding the 850 wind circulation fix, and then
                  ! set the mask to be TRUE for all points within the
                  ! area where mean cyclonic Vt exceed +1 m/s....

c                  call check_closed_contour (imax,jmax,ifix,jfix,slp
c     &                ,valid_pt,masked_outc,ccflag,'min',trkrinfo
c     &                ,999,contour_info,get_last_isobar_flag,plastbar
c     &                ,rlastbar,icccret)

                  if ( verb .ge. 3 ) then
                    print *,' '
                    print *,'Calling mask_based_on_wind_circ at '
     &                     ,ifcsthour
                  endif

                  call mask_based_on_wind_circ (imax,jmax,dx,dy,850
     &                     ,valid_pt,masked_outc,trkrinfo
     &                     ,clon(ist,ifh,3),clat(ist,ifh,3),inp%modtyp
     &                     ,imbowret)

                endif

                ! For tropical cyclones, check the avg 850 mb tangential
                ! windspeed close to the storm center....

                if (trkrinfo%type == 'tcgen' .or.
     &              trkrinfo%type == 'tracker') then

                  had_to_try_backup_850_vt_check = 'n'

                  if (calcparm(3,ist)) then

                    if (verb .ge. 3) then
                      print *,' '
                      print *,'Checking 850 mb Vt speed using 850 mb '
                      print *,'wind circulation fix: '
                      print *,' 850 mb wcirc fix lon= ',clon(ist,ifh,3)
                      print *,' 850 mb wcirc fix lat= ',clat(ist,ifh,3)
                      print *,' Multi-parm fix lon=   ',fixlon(ist,ifh)
                      print *,' Multi-parm fix lat=   ',fixlat(ist,ifh)
                      print *,' '
                    endif
 

                    call is_it_a_storm (imax,jmax,dx,dy,'v850',ist
     &                   ,valid_pt,clon(ist,ifh,3),clat(ist,ifh,3)
     &                   ,xval(3),trkrinfo,isastorm(3),isiret3)

                  else

                    ! Sept 2016: There has been a hole in this logic for
                    ! a while.  If a fix can't be made for 850 mb wind 
                    ! circulation (maybe the 850 mb wind circulation fix
                    ! was too far away from the guess?), then this check
                    ! isn't performed.  We are changing this so that the
                    ! 850 mb Vt wind speed check will still be
                    ! performed, but using the mean fixlat and fixlon 
                    ! positions as the center.  Still, we first need to
                    ! check to see if 850 mb u-comp and v-comp were even
                    ! read in. If they weren't, then we are just out 
                    ! of luck.

                    had_to_try_backup_850_vt_check = 'y'
                    isiret3 = -99

                    if (trkrinfo%use_backup_850_vt_check == 'y' .or.
     &                  trkrinfo%use_backup_850_vt_check == 'Y') then

                      if (readflag(3) .and. readflag(4)) then

                        if (verb .ge. 3) then
                          print *,' '
                          print *,'!!! NOTE: 850 mb wcirc fix not '
                          print *,'available.  We are instead '
                          print *,'checking 850 mb Vt speed using '
                          print *,'multi-parm fix position: '
                          print *,' Multi-parm fix lon=   '
     &                                      ,fixlon(ist,ifh)
                          print *,' Multi-parm fix lat=   '
     &                                      ,fixlat(ist,ifh)
                          print *,' '
                        endif

                        call is_it_a_storm (imax,jmax,dx,dy,'v850',ist
     &                     ,valid_pt,fixlon(ist,ifh),fixlat(ist,ifh)
     &                     ,0.00,trkrinfo,isastorm(3),isiret3)

                      endif
  
                    endif

                  endif
                    
                  if (calcparm(3,ist) .or. 
     &                (had_to_try_backup_850_vt_check == 'y' .and.
     &                 isiret3 == 0) ) then
                    
                    if (trkrinfo%type == 'tcgen') then
                      ! This next bit of code adds a second layer of 850
                      ! mb Vt magnitude checking.  This is to decrease 
                      ! the occurrence of interrupted tcgen tracks, 
                      ! which occasionally happens for weak storms when
                      ! this criterion is not met for one time period. 
                      ! So in this next code, we check to see if the 
                      ! vt850_flag was 'y' for at least 75% of the time
                      ! over the last 24h.  For time periods shorter 
                      ! than 24h (e.g., the storm was just detected at 
                      ! 144h and we are now at 156h), the threshold is 
                      ! still that for at least 75% of the time the 
                      ! system has been detected as a storm, it must 
                      ! have a vt850_flag value of 'y'.

                      if (isastorm(3) == 'Y') then
                        vt850_flag(ist,ifh) = 'y'
                      else
                        vt850_flag(ist,ifh) = 'n'
                        if (ifh > 1) then
                          iccfh = ifh
                          cc_time_sum_tot = 0.0
                          cc_time_sum_yes = 0.0
                          do while (iccfh > 1 .and. 
     &                         vt850_flag(ist,iccfh) /= 'u' .and.
     &                         cc_time_sum_tot < 24.0)
                            xinterval_fhr = fhreal(iccfh) - 
     &                                      fhreal(iccfh-1)
                            cc_time_sum_tot = cc_time_sum_tot 
     &                                      + xinterval_fhr
                            if (vt850_flag(ist,iccfh) == 'y') then
                              cc_time_sum_yes = cc_time_sum_yes 
     &                                        + xinterval_fhr
                            endif
                            iccfh = iccfh - 1
                          enddo
                          if (cc_time_sum_tot > 0.0) then
                            cc_time_pct = cc_time_sum_yes / 
     &                                    cc_time_sum_tot
                          else
                            cc_time_pct = 0.0
                          endif
                          if (cc_time_pct >= 0.75) then
                            isastorm(3) = 'Y'

                            if ( verb .ge. 3 ) then
                              print *,' '
                              print *,'+++ NOTE ON Vt_850 CHECK: The '
                              print *,'    isastorm flag returned for '
                              print *,'    this hour was NO, but a'
                              print *,'    check of recent vt850_flags'
                              print *,'    indicates that more than 75%'
                              print *,'    of the vt850_flags over the'
                              print *,'    last 24h are YES, so we will'
                              print *,'    continue.'
                              print *,'    cc_time_pct= ',cc_time_pct
                              print *,' '
                            endif

                          else
                            isastorm(3) = 'N'

                            if ( verb .ge. 3 ) then
                              print *,' '
                              print *,'!!! NOTE ON Vt_850 CHECK: The '
                              print *,'!!! isastorm flag returned for '
                              print *,'    this hour was NO, and a'
                              print *,'    check of recent vt850_flags '
                              print *,'    indicates that less than 75%'
                              print *,'    of the vt850_flags over the'
                              print *,'    last 24h are YES, so we will'
                              print *,'    stop tracking.'
                              print *,'    cc_time_pct= ',cc_time_pct
                            endif

                          endif
                        endif
                      endif

                    endif

                  endif   
                endif

              else

                if (trkrinfo%type == 'midlat' .or.
     &              trkrinfo%type == 'tcgen') then
                  isastorm(1) = 'N'

                  if ( verb .ge. 3 ) then
                    print *,' '
                    print *,'!!! For a midlat or tcgen case, a fix '
                    print *,'!!! could not be made for mslp, '
                    print *,'!!! therefore we will stop tracking '
                    print *,'!!! for this storm.'
                  endif

                else
                  isastorm(1) = 'N'
                  isastorm(3) = 'N'

                  if ( verb .ge. 3 ) then
                    print *,' '
                    print *,'!!! For a TC tracker case, a fix could'
                    print *,'!!! not be made using any tracked parms,'
                    print *,'!!! therefore we will stop tracking for'
                    print *,'!!! this storm.'
                  endif

                endif

                if ( verb .ge. 3 ) then
                  print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
                  print *,'!!! Storm    = ',storm(ist)%tcv_storm_name
                  write (6,432) ifhours(ifh),ifclockmins(ifh)
                endif

                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
                cycle stormloop 

              endif

              if (isiret1 /= 0 .or. isiret2 /= 0 .or. isiret3 /= 0) 
     &             then 

                if ( verb .ge. 1 ) then
                  print *,' '
                  print *,'!!! ERROR: One of the calls to '
                  print *,'!!! is_it_a_storm produced an error.'
                  print *,'!!! Chances are this is from a call to '
                  print *,'!!! get_ij_bounds, meaning we are too close'
                  print *,'!!! to a regional grid boundary to do this '
                  print *,'!!! analysis.  Processing will continue....'
                  print *,'!!! isiret1= ',isiret1,' isiret2= ',isiret2
                  print *,'!!! isiret3= ',isiret3
                endif

              endif

              if (isastorm(1) == 'N' .or. isastorm(2) == 'N' .or.
     &            isastorm(3) == 'N') then

                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'!!! At least one of the isastorm flags from'
                  print *,'!!! subroutine  is_it_a_storm is "N", so '
                  print *,'!!! either we were unable to find a good '
                  print *,'!!! mslp gradient and/or a valid 850 mb '
                  print *,'!!! circulation for the storm at this time,'
                  print *,'!!! or, for the cases of midlat or tcgen '
                  print *,'!!! tracking, a closed mslp contour could '
                  print *,'!!! not be found, thus we will stop tracking'
                  print *,'!!! this storm.'
                  print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
                  print *,'!!! Storm    = ',storm(ist)%tcv_storm_name
                  write (6,432) ifhours(ifh),ifclockmins(ifh) 
                  print *,'!!! mslp gradient flag = ',isastorm(1)
                  print *,'!!! closed contour flag = ',isastorm(2)
                  print *,'!!! 850 mb winds flag = ',isastorm(3)
                  print *,' '
                endif

                fixlon (ist,ifh) = -999.0
                fixlat (ist,ifh) = -999.0
                stormswitch(ist) = 2
              endif

              ! Now do another check for the  tracker and tcgen cases.
              ! If the isastorm flags for mslp gradient and v850 BOTH
              ! came back positive AND you have been able to locate an
              ! 850 mb vort center, just do a check to make sure that
              ! the distance between the 850 vort center and the mslp
              ! center is not too great.

              if (trkrinfo%type == 'tracker' .or. 
     &            trkrinfo%type == 'tcgen') then
                if (isastorm(1) == 'Y' .and. isastorm(3) == 'Y' .and.
     &            calcparm(1,ist) .and. stormswitch(ist) == 1) then

c                  if (atcfname == 'GFSO' .and.
c     &                abs(slatfg(ist,ifh)) >= 25.0) then
c                    trkrinfo%max_mslp_850 = 405.0
c                  else if (atcfname == 'GFSO' .and.
c     &                abs(slatfg(ist,ifh)) < 25.0) then
c                    trkrinfo%max_mslp_850 = 405.0
c                  else
c                    trkrinfo%max_mslp_850 = 323.0
c                  endif

                  call calcdist (clon(ist,ifh,9),clat(ist,ifh,9)
     &                          ,clon(ist,ifh,1),clat(ist,ifh,1),dist
     &                          ,degrees)

                  if (dist > trkrinfo%max_mslp_850) then
                    if ( verb .ge. 3 ) then
                      print *,' '
                      print *,'!!! In routine  tracker, the dist betw'
                      print *,'!!! the mslp center & the 850 zeta '
                      print *,'!!! center is too great, thus we will'
                      print *,'!!! stop tracking this storm.'
                      print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
                      print *,'!!! Storm    = '
     &                     ,storm(ist)%tcv_storm_name
                      write (6,432) ifhours(ifh),ifclockmins(ifh)
                      print *,'!!! Max dist allowed (km) = '
     &                     ,trkrinfo%max_mslp_850
                      print *,'!!! Actual distance  (km) = ',dist
                      print *,' '
                    endif
 
                    fixlon (ist,ifh) = -999.0
                    fixlat (ist,ifh) = -999.0
                    stormswitch(ist) = 2
                  else
                    
                    if ( verb .ge. 3 ) then
                      print *,' '
                      print *,'Actual distance between the parm centers'
                      print *,'for 850 zeta and mslp is ',dist,' (km)'
                      print *,'Max dist allowed (km) = '
     &                     ,trkrinfo%max_mslp_850
                    endif

                  endif
                endif
              endif

              ! Do one final check.  Check the new fix position and 
              ! the old fix position and calculate the speed that the
              ! storm would have had to travel to get to this point.
              ! If that speed exceeds a certain threshold (~60 kt), 
              ! assume you're tracking the wrong thing and quit.
              ! Obviously, only do this for times > 00h.  The check
              ! in the if statement to see if the previous hour's 
              ! lats and lons were > -999 is for the midlat and 
              ! tcgen cases -- remember, they can have genesis at
              ! any hour of the forecast, in which case the previous
              ! forecast hour's lat & lon would be -999.

              if (ifh > 1 .and. stormswitch(ist) == 1) then
                if (fixlon(ist,ifh-1) > -999.0 .and.
     &              fixlat(ist,ifh-1) > -999.0 ) then

                  if (trkrinfo%type == 'midlat') then
                    xmaxspeed = maxspeed_ml
                  else
                    xmaxspeed = maxspeed_tc
                  endif

                  call calcdist (fixlon(ist,ifh-1),fixlat(ist,ifh-1)
     &                          ,fixlon(ist,ifh),fixlat(ist,ifh),dist
     &                          ,degrees)

                  ! convert distance from km to nm and get speed.

                  distnm = dist * 0.539638
                  xinterval_fhr = fhreal(ifh) - fhreal(ifh-1)
                  xknots = distnm / xinterval_fhr

                  if (xknots > xmaxspeed) then

                    if ( verb .ge. 3 ) then
                      print *,' '
                      print *,'!!! In routine  tracker, calculated spd'
                      print *,'!!! of the storm from the last position'
                      print *,'!!! to the current position is too high,'
                      print *,'!!! so we will stop tracking this storm'
                      print *,'!!! (For fear that we are not actually '
                      print *,'!!! tracking our storm, but have instead'
                      print *,'!!! locked onto some other feature....)'
                      print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
                      print *,'!!! Storm    = '
     &                     ,storm(ist)%tcv_storm_name
                      write (6,432) ifhours(ifh),ifclockmins(ifh)  
                      print *,'!!! Max speed allowed (kt) = ',xmaxspeed
                      print *,'!!! Actual speed      (kt) = ',xknots
                      print *,' '
                    endif

                    fixlon (ist,ifh) = -999.0
                    fixlat (ist,ifh) = -999.0
                    stormswitch(ist) = 2
                  else

                    if ( verb .ge. 3 ) then
                      print *,' '
                      print *,'The average speed that the storm moved'
                      print *,'at since the previous forecast time is'
     &                     ,xknots,' knots.'
                    endif

                  endif

                endif

              endif
 
            endif
 
c           Now get the maximum near-surface wind speed near the storm
c           center (get_max_wind).  Also, call  getradii to get the 
c           radii in each storm quadrant of gale-force, storm-force 
c           and hurricane force winds.

            if (readflag(10) .and. readflag(11) .and. ifret == 0
     &          .and. stormswitch(ist) == 1) then
              call get_max_wind (fixlon(ist,ifh),fixlat(ist,ifh)
     &                       ,imax,jmax,dx,dy,valid_pt,levsfc
     &                       ,xmaxwind(ist,ifh),trkrinfo,rmax,igmwret)
c              if (igmwret /= 0 .and. gridmove_status == 'stopped') then
              if (igmwret /= 0) then
                
                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'!!! Return code from get_max_wind is /= 0. '
                  print *,'!!! rcc= igmwret= ',igmwret
                  print *,'!!! Also, this is a moveable, regional grid'
                  print *,'!!! and the grid did not change from last' 
                  print *,'!!! lead time to current one, so what has'
                  print *,'!!! likely happened is that the storm has '
                  print *,'!!! moved close to the edge of the nested '
                  print *,'!!! grid domain, but the nested grid itself'
                  print *,'!!! had stopped moving, probably because it'
                  print *,'!!! dropped or lost the storm.'
                  print *,'!!! '
                  print *,'!!! TRACKING WILL STOP FOR THIS STORM'
                  print *,'!!! '
                endif

                stormswitch(ist) = 2
                cycle stormloop
              endif

              ileadtime = nint(fhreal(ifh) * 100.0)
              ifcsthour = ileadtime / 100

              ! For the radii, we encountered a problem with radmax
              ! being too small.  It was set at 650 km.  Hurricane
              ! Sandy exceeded this in the models, so the values
              ! returned from getradii were close to the default
              ! radmax value of 650 km (350 nm), instead of higher.
              ! To fix it, we now use an iterative technique, where
              ! we start with radmax as a small value (500 km).  If
              ! getradii returns a value for R34 in a quadrant that
              ! does not exceed 0.97*radmax, then that value is ok.
              ! If it does exceed 0.97*radmax, then we bump up radmax
              ! by 50 km and call  getradii again, looking to diagnose
              ! radii only in those quadrants where the
              ! need_to_expand_r34 flag = 'n'.  BTW... note the 
              ! initial IF statement... we will only go into this 
              ! routine if the max wind just diagnosed for this lead
              ! time is at least 34 kts (17.5 m/s).

              if (xmaxwind(ist,ifh) >= 17.5) then

                vradius = 0
                first_time_thru_getradii = .true.
                r34_check_okay = 'n'
                do ivr = 1,4
                  need_to_expand_r34(ivr) = 'y'
                enddo
                radmax = 500.0  ! Initial radmax, in km

                igrct = 1

                if ( verb .ge. 3 ) then
                  write (6,242) ifcsthour,igrct,xmaxwind(ist,ifh)
     &                        ,date_time(5)
     &                        ,date_time(6),date_time(7)
 242              format (1x,'TIMING: b4 getrad_iter_loop, fhr= ',i5
     &                   ,' igrct= ',i2,' Vmax (m/s)= ',f8.3
     &                   ,'   ',i2.2,':',i2.2,':',i2.2)
                endif

                getrad_iter_loop: do while
     &          (r34_check_okay == 'n' .and. radmax <= 1050.)

                  call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                               ,date_time)
                  if ( verb .ge. 3 ) then
                    write (6,244) ifcsthour,igrct,date_time(5)
     &                          ,date_time(6),date_time(7)
 244                format (1x,'TIMING: after call getradii, fhr= ',i5
     &                     ,' igrct= ',i2,'   ',i2.2,':',i2.2,':',i2.2)
                  endif

                  call getradii (fixlon(ist,ifh),fixlat(ist,ifh),imax
     &                      ,jmax,dx,dy,valid_pt,storm(ist)%tcv_storm_id
     &                      ,ifcsthour,xmaxwind(ist,ifh),vradius
     &                      ,trkrinfo,need_to_expand_r34,radmax
     &                      ,first_time_thru_getradii,igrct,igrret)

                  if (igrret /= 0) then
                    if (verb >= 3) then
                      print *,' '
                      print *,'!!! ERROR: Return code from getradii = '
     &                       ,igrret
                      print *,'!!! Searching for radii will not be '
                      print *,'!!! completed for this lead time and'
                      print *,'!!! all radii values will be set to '
                      print *,'!!! missing.'
                      print *,' '
                      exit getrad_iter_loop
                    endif
                  endif

                  call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                               ,date_time)
                  if ( verb .ge. 3 ) then
                    write (6,245) ifcsthour,igrct,date_time(5)
     &                          ,date_time(6),date_time(7)
 245                format (1x,'TIMING: after call getradii, fhr= ',i5
     &                     ,' igrct= ',i2,'   ',i2.2,':',i2.2,':',i2.2)
                  endif

                  first_time_thru_getradii = .false.
                  igrct = igrct + 1
                  r34_dist_thresh = 0.97 * radmax
                  r34_good_ct = 0
                  do ivr = 1,4
                    vradius_km = float(vradius(1,ivr)) / 0.5396
                    if (vradius_km < r34_dist_thresh) then
                      r34_good_ct = r34_good_ct + 1
                      need_to_expand_r34(ivr) = 'n'
                    endif
                  enddo
                  if (r34_good_ct == 4) then
                    r34_check_okay = 'y'
                  endif
                  radmax = radmax + 50.0
                enddo getrad_iter_loop

                if ( verb .ge. 3 ) then
                  write (6,246) ifcsthour,igrct,xmaxwind(ist,ifh)
     &                        ,date_time(5)
     &                        ,date_time(6),date_time(7)
 246              format (1x,'TIMING: after getrad_iter_loop, fhr= ',i5
     &                   ,' igrct= ',i2,' Vmax (m/s)= ',f8.3
     &                   ,'   ',i2.2,':',i2.2,':',i2.2)
                endif

              endif

            endif

c           If the user has requested so, then call a routine to 
c           determine the type of cyclone, using Bob Hart's 
c           cyclone phase space (CPS) algorithms.  It is only used
c           for times after t=0, since for the first check (of the
c           "parameter B" thickness asymmetry), we need to know 
c           in which direction the storm is moving.  Pulling that 
c           storm movement data off of the tcvitals is not reliable
c           since the model storm may not be moving in the same 
c           direction as the observed storm.  However, we could do
c           an upgrade later where this storm movement data is 
c           pulled from the "genesis vitals", which are derived 
c           from the model forecast data itself, not the obs.

            if (phaseflag == 'y' .and. stormswitch(ist) == 1) then
              wcore_flag = 'u'   ! 'u' = undetermined
              call get_phase (imax,jmax,inp,dx,dy,ist,ifh,trkrinfo
     &                       ,fixlon,fixlat,valid_pt,maxstorm
     &                       ,cps_vals,wcore_flag,igpret)
            endif

            if (structflag == 'y' .or. ikeflag == 'y') then
              call get_sfc_center (fixlon(ist,ifh),fixlat(ist,ifh)
     &                      ,clon,clat,ist,ifh,calcparm,xsfclon
     &                      ,xsfclat,maxstorm,igscret)
            endif

            if (structflag == 'y' .and. stormswitch(ist) == 1) then
              call get_wind_structure (imax,jmax,inp,dx,dy
     &                     ,ist,ifh,fixlon,fixlat,xsfclon,xsfclat
     &                     ,valid_pt,er_wind,sr_wind,er_vr,sr_vr
     &                     ,er_vt,sr_vt,maxstorm,trkrinfo,igwsret)
              if (igwsret == 0) then
                call output_wind_structure (fixlon(ist,ifh)
     &                      ,fixlat(ist,ifh),xsfclon,xsfclat,inp,ist
     &                      ,ifcsthour,xmaxwind(ist,ifh)
     &                      ,gridprs(ist,ifh),er_wind,sr_wind
     &                      ,er_vr,sr_vr,er_vt,sr_vt,maxstorm,iowsret)
              endif
            endif

            if (structflag == 'y' .and. stormswitch(ist) == 1) then
              call get_fract_wind_cov (imax,jmax,inp,dx,dy
     &                     ,ist,ifh,fixlon,fixlat,xsfclon,xsfclat
     &                     ,valid_pt,calcparm,wfract_cov,pdf_ct_bin
     &                     ,pdf_ct_tot,maxstorm,trkrinfo,igfwret)
              if (igfwret == 0) then 
                call output_fract_wind (fixlon(ist,ifh)
     &                      ,fixlat(ist,ifh),xsfclon,xsfclat,inp,ist
     &                      ,ifcsthour,xmaxwind(ist,ifh)
     &                      ,gridprs(ist,ifh),wfract_cov,'earth'
     &                      ,pdf_ct_bin,pdf_ct_tot,maxstorm,iofwret)
              endif
            endif

            if (ikeflag == 'y' .and. stormswitch(ist) == 1) then
              call get_ike_stats (imax,jmax,inp,dx,dy
     &                     ,ist,ifh,fixlon,fixlat,xsfclon,xsfclat
     &                     ,valid_pt,calcparm,ike,sdp,wdp,maxstorm
     &                     ,trkrinfo,igisret)
              if (igisret == 0) then
                call output_ike (fixlon(ist,ifh)
     &                      ,fixlat(ist,ifh),xsfclon,xsfclat,inp,ist
     &                      ,ifcsthour,xmaxwind(ist,ifh)
     &                      ,gridprs(ist,ifh),ike,sdp,wdp,maxstorm
     &                      ,ioiret)
              endif
            endif

c           Now print out the current fix position and intensity
c           (in knots) to standard output.  Conversion for m/s to
c           knots (1.9427) is explained in output_atcf.

            if ( verb .ge. 3 ) then
              print *,' '
              print *,'After call to fixcenter, fix positions at '
              write (6,442) ifhours(ifh),ifclockmins(ifh)
 442          format (1x,'forecast hour= ',i4,':',i2.2,' follow:')
              print *,' '
            endif

            if (ifret == 0 .and. stormswitch(ist) == 1) then

              if ( verb .ge. 3 ) then
                write (6,73) storm(ist)%tcv_storm_id,ifhours(ifh)
     &               ,ifclockmins(ifh),fixlon(ist,ifh)
     &               ,360.-fixlon(ist,ifh),fixlat(ist,ifh)
     &               ,int((xmaxwind(ist,ifh)*1.9427) + 0.5)
                print *,' '
              endif

              ! Only call output routines every atcffreq/100 hours....

              ileadtime = nint(fhreal(ifh) * 100.0)
              leadtime_check = mod(ileadtime,atcffreq)

              if (leadtime_check == 0) then

                ifcsthour = ileadtime / 100

                call output_atcfunix (fixlon(ist,ifh)
     &                    ,fixlat(ist,ifh),inp,ist
     &                    ,ifcsthour,xmaxwind(ist,ifh)
     &                    ,gridprs(ist,ifh),vradius,maxstorm
     &                    ,trkrinfo,plastbar,rlastbar,rmax,cps_vals
     &                    ,wcore_flag,ioaxret)

                ! Get the storm motion vector and the speed of 
                ! motion so that we can output this in the 
                ! "atcf_sink" forecast text file.

                if (ifh < ifhmax) then
                  call get_next_ges (fixlon,fixlat,ist,ifh
     &              ,imax,jmax,dx,dy,inp%model,valid_pt,readflag
     &              ,maxstorm,istmspd,istmdir,'vitals',trkrinfo
     &              ,ignret)
                else
                  istmdir = -999
                  istmspd = -999
                  ignret  = 0
                endif

                if ( verb .ge. 3 ) then
                  write (6,617) istmspd,istmdir,ignret
 617              format (1x,'+++ RPT_STORM_MOTION: istmspd= ',i5
     &                 ,' istmdir= ',i5,' rcc= ',i3)
                endif

                ! Call a routine to find the mean & max relative
                ! vorticity near the storm at 850 & 700.  These will
                ! be written out to the "atcf_sink" fcst text file.

                imeanzeta = -99
                igridzeta = -99
                call get_zeta_values (fixlon,fixlat,imax,jmax,dx,dy
     &                 ,trkrinfo,imeanzeta,igridzeta,readflag
     &                 ,valid_pt,ist,ifh,maxstorm,inp,igzvret)

                if (trkrinfo%type == 'midlat' .or.
     &              trkrinfo%type == 'tcgen') then
                  call output_atcf_gen (fixlon(ist,ifh)
     &               ,fixlat(ist,ifh),inp,ist
     &               ,ifcsthour,xmaxwind(ist,ifh)
     &               ,gridprs(ist,ifh),vradius,maxstorm,trkrinfo
     &               ,istmspd,istmdir,plastbar,rlastbar,rmax
     &               ,cps_vals,wcore_flag,imeanzeta,igridzeta,ioaxret)
                endif

                call output_atcf_sink (fixlon(ist,ifh)
     &                    ,fixlat(ist,ifh),inp,ist
     &                    ,ifcsthour,xmaxwind(ist,ifh)
     &                    ,gridprs(ist,ifh),vradius,maxstorm
     &                    ,trkrinfo,istmspd,istmdir,imeanzeta
     &                    ,igridzeta,cps_vals,plastbar,rlastbar
     &                    ,ioaxret)

                if (inp%model == 12 .and. ifcsthour == 0) then
                  ! Write vitals for GFS ens control analysis
                  call output_tcvitals (fixlon(ist,ifh)
     &                    ,fixlat(ist,ifh),inp,ist,iovret)

                endif
              endif

              ! The exception here is for the call to the  output_hfip
              ! routine, which will be called for every lead time
              ! that is processed....

              call output_hfip (fixlon(ist,ifh),fixlat(ist,ifh),inp,ist
     &                        ,ifh,xmaxwind(ist,ifh)
     &                        ,gridprs(ist,ifh),vradius,rmax,ioaxret)
            else

              if ( verb .ge. 3 ) then
                write (6,452) 'fixpos ',storm(ist)%tcv_storm_id
     &               ,' fhr= ',ifhours(ifh),ifclockmins(ifh)
     &               ,' Fix not made for this forecast hour'
 452            format (1x,a7,1x,a4,a6,i4,':',i2.2,a36)
                
                print *,' '
                print *,'!!! RETURN CODE from fixcenter not equal to 0,'
                print *,'!!! or output from is_it_a_storm indicated the'
                print *,'!!! system found was not our storm, or the '
                print *,'!!! speed calculated indicated we may have '
                print *,'!!! locked onto a different center, thus a fix'
                print *,'!!! was not made for this storm at this '
                print *,'!!! forecast hour.'
                print *,'!!! mslp gradient check       = ',isastorm(1)
                print *,'!!! mslp closed contour check = ',isastorm(2)
                print *,'!!! 850 mb winds check      = ',isastorm(3)
                print *,'!!! fixcenter return code = ifret = ',ifret
                print *,' '
              endif

              if (ifh == 1) then
                vradius = 0
                ileadtime = nint(fhreal(ifh) * 100.0)
                ifcsthour = ileadtime / 100

c                if (inp%model == 1 .or. inp%model == 8 .or. 
c     &              inp%model == 22) then                
cPENG
      if (inp%model == 1 .or. inp%model == 10 .or. inp%model == 7
     &  .or. inp%model == 22 .or. inp%model == 16
     &  .or. inp%model == 15 .or. inp%model == 8) then

                  ! For the vt=00h lead time, if the  tracker failed to 
                  ! locate a position, we are going to write out an
                  ! atcfunix record that contains the position, 
                  ! intensity, mslp and 34-kt wind radii from TC Vitals
                  ! for this storm and initial time.  Only do this for 
                  ! the GFS or GDAS runs of the  tracker.

                  tcv_max_wind_ms = float(storm(ist)%tcv_vmax)
                  tcv_mslp_pa = float(storm(ist)%tcv_pcen) * 100.0

                  ! Convert tcvitals NE 34-kt wind radius from km to nm
                  r34_from_tcv = float(storm(ist)%tcv_r15ne)
                  if (r34_from_tcv > 0.0) then
                    vradius(1,1) = int( ((r34_from_tcv*0.5396) 
     &                             / 5.0) + 0.5) * 5
                  else
                    vradius(1,1) = 0
                  endif

                  ! Convert tcvitals SE 34-kt wind radius from km to nm
                  r34_from_tcv = float(storm(ist)%tcv_r15se)
                  if (r34_from_tcv > 0.0) then
                    vradius(1,2) = int( ((r34_from_tcv*0.5396)
     &                             / 5.0) + 0.5) * 5
                  else    
                    vradius(1,2) = 0
                  endif

                  ! Convert tcvitals SW 34-kt wind radius from km to nm
                  r34_from_tcv = float(storm(ist)%tcv_r15sw)
                  if (r34_from_tcv > 0.0) then
                    vradius(1,3) = int( ((r34_from_tcv*0.5396)
     &                             / 5.0) + 0.5) * 5
                  else    
                    vradius(1,3) = 0
                  endif

                  ! Convert tcvitals NW 34-kt wind radius from km to nm
                  r34_from_tcv = float(storm(ist)%tcv_r15nw)
                  if (r34_from_tcv > 0.0) then
                    vradius(1,4) = int( ((r34_from_tcv*0.5396)
     &                             / 5.0) + 0.5) * 5
                  else    
                    vradius(1,4) = 0
                  endif

                  ! Convert tcvitals roci from km to nm
  
                  if (storm(ist)%tcv_penvrad > 0) then
                    roci_from_tcv = float(storm(ist)%tcv_penvrad)
                    rlastbar = roci_from_tcv * 0.5396
                  else
                    rlastbar = -99.0
                  endif
                  
                  ! Convert tcvitals pressure at roci from km to nm
  
                  if (storm(ist)%tcv_penv > 0) then
                    proci_from_tcv = float(storm(ist)%tcv_penv)
                    plastbar = proci_from_tcv * 100.0
                  else
                    plastbar = -99.0
                  endif

                  write (6,291) storm(ist)%tcv_storm_id
     &                         ,storm(ist)%tcv_storm_name
     &                         ,atcfymdh
  291             format (1x,'NOTE: TCVITALS_USED_FOR_ATCF_F00 '
     &                   ,' Storm ID: ',a4,' Storm name: ',a9
     &                   ,' YMDH: ',i10)

                  call output_atcfunix (slonfg(ist,ifh)
     &                      ,slatfg(ist,ifh),inp,ist
     &                      ,ifcsthour,tcv_max_wind_ms
     &                      ,tcv_mslp_pa,vradius,maxstorm,trkrinfo
     &                      ,plastbar,rlastbar,-99.0
     &                      ,cps_vals,wcore_flag,ioaxret)
                else

                  ! For all other models, we print out missing 
                  ! data values at tau=00h if the  tracker was 
                  ! unable to find the storm....

                  call output_atcfunix (-999.0
     &                      ,-999.0,inp,ist
     &                      ,ifcsthour,0.0
     &                      ,0.0,vradius,maxstorm,trkrinfo
     &                      ,-99.0,-99.0,-99.0
     &                      ,cps_vals,wcore_flag,ioaxret)

                endif

                imeanzeta = -99
                igridzeta = -99
                if (trkrinfo%type == 'midlat' .or.
     &              trkrinfo%type == 'tcgen') then
                  call output_atcf_gen (-999.0   
     &               ,-999.0,inp,ist
     &               ,ifcsthour,0.0
     &               ,0.0,vradius,maxstorm,trkrinfo
     &               ,-99,-99,-999.0,-999.0,-99.0
     &               ,cps_vals,'u',imeanzeta,igridzeta,ioaxret)
                endif
                call output_atcf_sink (-999.0
     &                    ,-999.0,inp,ist
     &                    ,ifcsthour,0.0
     &                    ,0.0,vradius,maxstorm,trkrinfo
     &                    ,-99,-99,imeanzeta,igridzeta
     &                    ,cps_vals,-999.0,-999.0,ioaxret)
                call output_hfip (-999.0
     &                    ,-999.0,inp,ist
     &                    ,ifh,0.0
     &                    ,0.0,vradius,-99.0,ioaxret)

                if (trkrinfo%type == 'tracker') then
                  ! Update 11/11: For a 'tracker' run, i.e., one in 
                  ! which we know that there is an observed storm in
                  ! the area, we will assume that there was some type
                  ! of problem in the initialization that prevented 
                  ! the storm from being found.  In this case, even 
                  ! though we have written out zeroes for the 00h
                  ! time, we want to at least try tracking again at
                  ! the next lead time.  Requested by HWRF folks....
                  if (verb .ge. 3) then
                    print *,' '
                    print *,'++ NOTE: Even though a fix could not be'
                    print *,'   made for this storm at 00h, we will '
                    print *,'   use the storm heading info from tc'
                    print *,'   vitals to create a guess for the next'
                    print *,'   lead time and attempt to track again'
                    print *,'   at that time.'
                    print *,'   ifh= ',ifh,' ist= ',ist
                    write (6,301) storm(ist)%tcv_storm_id
     &                           ,storm(ist)%tcv_storm_name
 301                format (1x,'  storm_id = ',a4,' storm_name = ',a9)
                  endif
                  call get_next_ges (slonfg,slatfg,ist,ifh
     &              ,imax,jmax,dx,dy,inp%model,valid_pt,readflag
     &              ,maxstorm,istmspd,istmdir,'tracker',trkrinfo
     &              ,ignret)
                  if (ignret /= 0) then
                    fixlon (ist,ifh) = -999.0
                    fixlat (ist,ifh) = -999.0
                    stormswitch(ist) = 2
                    cycle stormloop
                  endif
                  stormswitch(ist) = 1
                endif

              endif
              cycle stormloop
            endif


c           Now get first guess for next forecast time's position.
c           But first, if this is the first time level (ifh=1) and 
c           the user has requested that storm vitals be  output (this
c           is usually only done for model analyses in order to get 
c           an analysis position from one time to the next), we will
c           write out a storm vitals record for this time level.  
c           Note that we have already gotten the next guess position
c           info just above for the case of the repeated analysis 
c           data, so we'll just output the genesis vitals record.

            if (ifh <= ifhmax) then
              if (ifh == 1 .and. trkrinfo%out_vit == 'y') then
                call output_gen_vitals (fixlon(ist,ifh)
     &             ,fixlat(ist,ifh),inp,ist,istmspd,istmdir,iovret)
              endif
              if (ifh < ifhmax) then
                call get_next_ges (fixlon,fixlat,ist,ifh
     &            ,imax,jmax,dx,dy,inp%model,valid_pt,readflag
     &            ,maxstorm,istmspd,istmdir,'tracker',trkrinfo
     &            ,ignret)
                if (ignret /= 0) then
                  if ( verb .ge. 3 ) then
                    print *,' '
                    print *,'!!! ERROR: Problem getting first guess '
                    print *,'!!! position for next lead time.  Return'
                    print *,'!!! code from call to get_next_ges = '
                    print *,'!!! ignret = ',ignret
                    print *,'!!! Storm name = '
     &                     ,storm(ist)%tcv_storm_name
                    print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
                    print *,'!!! TRACKING WILL STOP FOR THIS STORM.'
                  endif
                  fixlon (ist,ifh) = -999.0
                  fixlat (ist,ifh) = -999.0
                  stormswitch(ist) = 2
                  cycle stormloop
                endif
              else
                istmdir = -999
                istmspd = -999
              endif
            endif
 
          case (2)
            fixlon (ist,ifh) = -999.0
            fixlat (ist,ifh) = -999.0

            if ( verb .ge. 3 ) then
              print *,' '
              print *,'!!! Case 2 in tracker for stormswitch'
              print *,'!!! Storm name = ',storm(ist)%tcv_storm_name
              print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
            endif

            if (ifh == 1) then
              vradius = 0
              ileadtime = nint(fhreal(ifh) * 100.0)
              ifcsthour = ileadtime / 100
              call output_atcfunix (-999.0
     &                  ,-999.0,inp,ist
     &                  ,ifcsthour,0.0
     &                  ,0.0,vradius,maxstorm,trkrinfo
     &                  ,-99.0,-99.0,-99.0
     &                  ,cps_vals,wcore_flag,ioaxret)
              imeanzeta = -99
              igridzeta = -99
              if (trkrinfo%type == 'midlat' .or.
     &            trkrinfo%type == 'tcgen') then
                call output_atcf_gen (-999.0
     &             ,-999.0,inp,ist
     &             ,ifcsthour,0.0
     &             ,0.0,vradius,maxstorm,trkrinfo
     &             ,-99,-99,-999.0,-999.0,-99.0
     &             ,cps_vals,'u',imeanzeta,igridzeta,ioaxret)
              endif
              call output_atcf_sink (-999.0
     &                  ,-999.0,inp,ist
     &                  ,ifcsthour,0.0
     &                  ,0.0,vradius,maxstorm,trkrinfo
     &                  ,-99,-99,imeanzeta,igridzeta
     &                  ,cps_vals,-999.0,-999.0,ioaxret)
              call output_hfip (-999.0
     &                  ,-999.0,inp,ist
     &                  ,ifh,0.0
     &                  ,0.0,vradius,-99.0,ioaxret)
            endif

          case (3)
          continue

c            print *,' '
c            print *,'!!! Case 3 in tracker for stormswitch'
c            print *,'!!! Storm name = ',storm(ist)%tcv_storm_name
c            print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id

          end select
 
        enddo stormloop

        if (trkrinfo%type == 'midlat' .or.
     &      trkrinfo%type == 'tcgen') then
          ileadtime = nint(fhreal(ifh) * 100.0)
          leadtime_check = mod(ileadtime,atcffreq)
          if (leadtime_check == 0) then
            ifcsthour = ileadtime / 100
          endif
          if (trkrinfo%inp_data_type == 'grib') then
            call output_tracker_mask (masked_outc,valid_pt,ifh
     &                  ,ifcsthour,imax,jmax,iotmret)
          endif
        endif

        if(use_per_fcst_command=='y') then
c          User wants us to run a command per forecast time

!     Replace %[FHOUR] with forecast hour, %[FMIN] with forecast minute.

!     The %[] format is chosen to avoid shell syntax errors if someone
!     includes unknown %[] constructs.  A stray <FYEAR>, for example,
!     would generate syntax errors or unexpected results in some
!     shells.  

!     If an unrecognized %[xxx] sequence is used, it will be retained in
!     the final command.  This allows the underlying command to detect
!     the unreplaced %[] and use suitable default values or abort, as
!     appropriate.

           pfc_final=per_fcst_command
           call argreplace(pfc_final,pfc_cmd_len,'%[FHOUR]',            &
     &                     ifhours(ifh))
           call argreplace(pfc_final,pfc_cmd_len,'%[FMIN]',             &
     &                     iftotalmins(ifh))

           if(verb.ge.2) then
              print *,' '
              print *,'!!! Running per-fcst command'
              print *,'!!! Unparsed = ',trim(per_fcst_command)
              print *,'!!! Parsed = ',trim(pfc_final)
           endif
           call run_command(trim(pfc_final),pfcret)
           if(pfcret/=0 .and. verb.ge.1) then
              print *,' '
              print *,'!!! Non-zero exit status from per-fcst command'
              print *,'!!! Command = ',trim(pfc_final)
              print *,'!!! Exit status = ',pfcret
              print *,'!!! Continuing anyway...'
           elseif(pfcret==0 .and. verb.ge.2) then
              print *,' '
              print *,'!!! Per-fcst command returned success status (0)'
           endif
        endif

        ifh = ifh + 1
        if (ifh > ifhmax) exit ifhloop

        if (inp%file_seq == 'multi') then
          call baclose(lugb,igcret)
          call baclose(lugi,iicret)
          if ( verb .ge. 3 ) then
            print *,'baclose return code for unit ',lugb,' = igcret = '
     &           ,igcret
            print *,'baclose return code for unit ',lugi,' = iicret = '
     &           ,iicret
          endif
        endif

      enddo ifhloop
c
cPENG      call output_all (fixlon,fixlat,inp,maxstorm,ifhmax,ioaret)
cPENG      call output_atcf (fixlon,fixlat,inp,xmaxwind,maxstorm,ifhmax
cPENG     &                 ,ioaret)
c
  73  format ('fixpos  ',a4,'  fhr= ',i4,':',i2.2,'   Fix position=  '
     &       ,f7.2,'E  (',f6.2,'W)',2x,f7.2,'   Max Wind= ',i3,' kts')

      if (allocated(prstemp)) deallocate (prstemp) 
      if (allocated(prsindex)) deallocate (prsindex) 
      if (allocated(iwork)) deallocate(iwork)
      if (allocated(zeta)) deallocate (zeta) 
      if (allocated(u)) deallocate (u) 
      if (allocated(v)) deallocate (v)
      if (allocated(hgt)) deallocate (hgt) 
      if (allocated(slp)) deallocate (slp) 
      if (allocated(tmean)) deallocate (tmean)
      if (allocated(thick))    deallocate (thick)
      if (allocated(lsmask))   deallocate (lsmask)
      if (allocated(masked_out)) deallocate (masked_out) 
      if (allocated(masked_outc)) deallocate (masked_outc)
      if (allocated(cpshgt)) deallocate (cpshgt)
      if (allocated(vt850_flag)) deallocate (vt850_flag)
      if (allocated(closed_mslp_ctr_flag)) 
     &  deallocate (closed_mslp_ctr_flag)
      if (allocated(netcdf_file_time_values)) 
     &  deallocate (netcdf_file_time_values)
      if (allocated(nctotalmins)) 
     &  deallocate (nctotalmins)
c
      return 
      end   
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine argreplace(arg,n,name,val)
      ! This subroutine is used to generate the pre-forecast-command
      ! It will edit the command (argument "arg") and replace string
      ! name with value val.  That is how the per-forecast-command
      ! has these modifications:

      ! %[FHOUR]  -> replace with ->  last forecast hour
      ! %[FMIN]   -> replace with ->  last forecast minute

      implicit none

      integer, intent(in) :: n
      character(n), intent(inout) :: arg
      character(*), intent(in) :: name
      integer, intent(in) :: val

      integer found,namelen,i1,i2
      character(n) :: out

      found=index(arg,name)
      namelen=len(name)
      i1=found-1  ! last char that is before name
      i2=found+namelen  ! index of last char in name

      if(found==0) return

      out=' '

      if(found>1 .and. i2<n) then
         write(out,'(A,I0,A)') arg(1:i1),val,arg(i2:n)
      elseif(found>1) then
!        special case: name is at end of string
!        hope the value fits...
         write(out,'(A,I0)') arg(1:i1),val
      elseif(i2<n) then
!        special case: name is at beginning of string
         write(out,'(I0,A)') val,arg(i2:n)
      else
!        special case: name is the entirety of the string
!        hope the value fits...
         write(out,'(I0)') val
      endif

      arg=out

      end subroutine argreplace

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine open_grib_files1(inp,lugb,lugi,gfilename,ifilename
     &                           ,lout,iret)

C     ABSTRACT: This subroutine must be called before any attempt is
C     made to read from the input GRIB files.  The GRIB and index files
C     are  opened with a call to baopenr.  This call to baopenr was not
C     needed in the cray version of this program (the files could be
C     opened with a simple Cray assign statement), but the GRIB-reading
C     utilities on the SP do require calls to this subroutine (it has
C     something to do with the GRIB I/O being done in C on the SP, and
C     the C I/O package needs an explicit open statement).
C
C     INPUT:
c     inp      Contains user-input info on the date & data
C     lugb     The Fortran unit number for the GRIB data file
C     lugi     The Fortran unit number for the GRIB index file
c     ifh      integer index for lead time level
c     gfilename If using individual files for each tau, gfilename will 
c              contain the grib data filename for this tau.  Otherwise, 
c              if using one big file for all taus, this contains dummy 
c              character data.
c     ifilename If using individual files for each tau, gfilename will 
c              contain the grib index filename for this tau.  Otherwise,
c              if using one big file for all taus, this contains dummy 
c              character data.
C     lout     The Fortran unit number for the  output grib file
C
C     OUTPUT:
C     iret     The return code from this subroutine

      USE inparms
      USE verbose_output

      implicit none
c
      type (datecard) inp

      logical(1)  output_file_open
      logical(1)  file_open
      logical(4)  file_open4,file_open5
      character fnameg*7,fnamei*7,fnameo*7
      character(*) gfilename,ifilename
      character(120) gopen_g_file,gopen_i_file
      integer  igoret,iioret,iooret,lugb,lugi,lout,iret,nlen1,nlen2

      iret=0

      if (inp%file_seq == 'onebig') then
        fnameg(1:5) = "fort."
        fnamei(1:5) = "fort."
        fnameo(1:5) = "fort."
        write(fnameg(6:7),'(I2)') lugb
        write(fnamei(6:7),'(I2)') lugi
        write(fnameo(6:7),'(I2)') lout
        call baopenr (lugb,fnameg,igoret)
        call baopenr (lugi,fnamei,iioret)
        call baopenw (lout,fnameo,iooret)
      else

        print *,'in open_grib_files in multi else part....'

        nlen1        = len_trim(gfilename)
        gopen_g_file = trim(gfilename(1:nlen1))
        nlen2        = len_trim(ifilename)
        gopen_i_file = trim(ifilename(1:nlen2))

        print *,'  lugb= ',lugb,'  lugi= ',lugi
        print *,'nlen1= ',nlen1,' nlen2= ',nlen2
        print *,'gopen_g_file= ',gopen_g_file
        print *,'gopen_i_file= ',gopen_i_file

        write (6,81) gopen_g_file,gopen_i_file
   81   format (1x,'tpm gopen_g_file= ...',a<nlen1>
     &         ,'...  gopen_i_file= ...',a<nlen2>,'...')

        print *,'gopen_g_file= ',gopen_g_file,'....'
        print *,'gopen_i_file= ',gopen_i_file,'....'

        call baopenr (lugb,gopen_g_file,igoret)
        call baopenr (lugi,gopen_i_file,iioret)
        inquire (unit=lout, opened=output_file_open)
        if (output_file_open) then
          iooret = 0
        else
          fnameo(1:5) = "fort."
          write(fnameo(6:7),'(I2)') lout
          call baopenw (lout,fnameo,iooret)
        endif
      endif

      inquire (unit=lugb, opened=file_open)
      if (file_open) then
        print *,'TEST open_grib_files, unit lugb= ',lugb
     &        ,' is OPEN'
      else
        print *,'TEST open_grib_files, unit lugb= ',lugb
     &         ,' is CLOSED'
      endif

      inquire (unit=lugi, opened=file_open)
      if (file_open) then
        print *,'TEST open_grib_files, unit lugi= ',lugi
     &         ,' is OPEN'
      else
        print *,'TEST open_grib_files, unit lugi= ',lugi
     &         ,' is CLOSED'
      endif

      inquire (file=gopen_g_file, opened=file_open4)
      if (file_open4) then
        print *,'TEST gname  open_grib_files, gfile= '
     &        ,gopen_g_file,' is OPEN'
      else
        print *,'TEST gname  open_grib_files, gfile= '
     &        ,gopen_g_file,' is CLOSED'
      endif

      inquire (file=gopen_i_file, opened=file_open5)
      if (file_open5) then
        print *,'TEST iname  open_grib_files, ifile= '
     &         ,gopen_i_file,' is OPEN'
      else
        print *,'TEST iname  open_grib_files, ifile= '
     &         ,gopen_i_file,' is CLOSED'
      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'gettrk baopen: igoret= ',igoret,' iioret= ',iioret
     &       ,' iooret= ',iooret
      endif

      if (igoret /= 0 .or. iioret /= 0 .or. iooret /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in sub open_grib_files opening grib file'
          print *,'!!! or grib index file.  baopen return codes:'
          print *,'!!! grib  file return code = igoret = ',igoret
          print *,'!!! index file return code = iioret = ',iioret
          print *,'!!! output file return code = iooret = ',iooret
        endif

        iret = 113
        return
      endif

      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine open_ncfile (filename,ncid)

c     ABSTRACT: This subroutine opens a netcdf file specified by the
c     input file "ncfile" and returns the netcdf file id that will be
c     associated with that file.
c
c     INPUT:
c     ncfile   character full-path file netcdf name
c
c     OUTPUT:
c     ncfile_id integer, netcdf id assigned to the netcdf file

      implicit none

      include "netcdf.inc"

      character*(*), intent(in) :: filename
      integer, intent(out)      :: ncid
      integer :: status

      status = nf_open (filename, NF_NOWRITE, ncid)
      if (status .ne. NF_NOERR) call handle_netcdf_err(status)

      end subroutine open_ncfile
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine is_it_a_storm (imax,jmax,dx,dy,cparm,ist
     &                          ,defined_pt,parmlon,parmlat
     &                          ,parmval,trkrinfo,stormcheck,isiret)

c     ABSTRACT: This subroutine is called after the center of the storm
c     has been fixed.  Its purpose is to determine whether or not 
c     the center that was found is actually a storm, and not just some
c     passing trough (this has happened in the case of decaying or weak
c     storms).  It's called twice -- once to check for a minimum MSLP
c     gradient, and once to check for a circulation at 850 mb.  The 
c     subroutine input parameter "cparm" determines which parameter to
c     check for.
c
c     INPUT:
c     imax     Num pts in i direction on input grid
c     jmax     Num pts in j direction on input grid
c     dx       Grid spacing in i-direction on input grid
c     dy       Grid spacing in j-direction on input grid
c     cparm    Char string indicating what parm is to be checked:
c              slp  = mslp, for a check of mslp gradient
c              v850 = tangential winds at 850 mb
c     ist      integer storm number (internal to the  tracker)
c     defined_pt Logical; bitmap indicating if valid data at that pt.
c     parmlon  Longitude of the max/min value for the input parameter
c     parmlat  Latitude  of the max/min value for the input parameter
c     parmval  Data value at parm's max/min point (used for mslp call)
c     trkrinfo derived type containing grid info on user boundaries
c
c     OUTPUT:
c     stormcheck Character; set to 'Y' if mslp gradient or 850 mb 
c                tangential winds check okay.
c     isiret   Return code for this subroutine.
c
      USE radii; USE grid_bounds; USE set_max_parms; USE level_parms
      USE trig_vals; USE tracked_parms; USE atcf; USE trkrparms
      USE verbose_output

      implicit none
c
      type (trackstuff) trkrinfo

      real         vt,vtavg,vr,parmlat,parmlon,parmval,dist
      real         pthresh,vthresh,degrees,dx,dy,dell,ri,radinf
      real         pgradient,xmaxpgrad
      character(*) cparm
      logical(1)   defined_pt(imax,jmax)
      character*1  stormcheck
      integer      isiret,imax,jmax,ist,npts,ilonfix,jlatfix,igvtret
      integer      ibeg,iend,jbeg,jend,ivt,i,j,iix,jix,bskip,igiret

      isiret = 0
      stormcheck = 'N'

      dell = (dx+dy)/2.

c     First define the radius of influence, which depends on the
c     grid spacing of the model data being used.  The ceiling statement
c     for npts in the first if statement is needed in case the
c     resolution of the grib files eventually goes very low, down to
c     say a half degree or less, in order to cover enough points in
c     the search.

      if (dell < 1.24) then      ! GFS, MRF, NAM, NGM, NAVGEM, GDAS,
                                 ! GFDL, NCEP Ensemble & Ensemble
                                 ! Relocation, SREF Ensemble
        ri     = ritrk_most
        if (cparm == 'slp') then
          radinf = 300.0
        else
          radinf = 225.0
        endif
        npts   = ceiling(radinf/(dtk*(dx+dy)/2.))
      else if (dell >= 1.24 .and. dell < 2.49) then     ! UKMET
        ri     = ritrk_most     
        radinf = 275.0
        npts   = 2
      else                       ! ECMWF
        ri     = ritrk_coarse
        radinf = 350.0
        npts   = 1
      endif

      pthresh = trkrinfo%mslpthresh    ! These are read in in 
      vthresh = trkrinfo%v850thresh    ! subroutine  read_nlists....

      call get_ij_bounds (npts,0,ri,imax,jmax,dx,dy
     &           ,glatmax,glatmin,glonmax,glonmin,parmlon,parmlat
     &           ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if ( verb .ge. 3 ) then
        print *,' '
        print *,' After get_ij B, ibeg jbeg = ',ibeg,jbeg
        print *,' After get_ij B, iend jend = ',iend,jend
      endif

      if (igiret /= 0) then

        if ( verb .ge. 1 ) then
          print*,' '
          print*,'!!! ERROR in is_it_a_storm from call to'
          print*,'!!! get_ij_bounds, stopping processing for '
          print*,'!!! storm number ',ist
        endif

        isiret = 92
        return
      endif

c     If the input cparm is slp, then check to see that the MSLP 
c     gradient in any direction from the MSLP center is at least 
c     1mb / 200km, or 0.005mb/km.  This is based on discussions with 
c     Morris & Bob, who have had good results using a 2mb/200km 
c     requirement.  Since their model has a much finer resolution than
c     all of the models we run the  tracker on AND a much better 
c     depiction of the hurricane vortex, we do not use a requirement
c     as strict as theirs, and so make the requirement only half as
c     strong as theirs.
c
c     If the input cparm is v850, then check to see that there is
c     a circulation at 850 mb.  We will do this by calculating the
c     tangential wind of all points within a specified radius of 
c     the 850 minimum wind center, and seeing if there is a net
c     average tangential wind speed of at least 5 m/s.
c
c     UPDATE APRIL 2000: I've relaxed the thresholds slightly from
c     0.005 mb/km to 0.003 mb/km, and the wind threshold from 
c     5 m/s to 3 m/s.  Also, note that a special case for GDAS has
c     been hardwired in that is weaker (0.002 mb/km and 2 m/s).
c     That weaker GDAS requirement is for Qingfu's relocation stuff.
c
c     UPDATE JULY 2001: The relaxed requirement put in place in
c     April 2000 for the GDAS relocation has also been put in place
c     for the GFS ensemble relocation.

      ! We will want to speed things up for finer resolution grids.  
      ! We can do this by skipping some of the points in the loop.

      if ((dx+dy)/2. > 0.20) then
        bskip = 1
      else if ((dx+dy)/2. > 0.10 .and. (dx+dy)/2. <= 0.20) then
        bskip = 2
      else if ((dx+dy)/2. > 0.05 .and. (dx+dy)/2. <= 0.10) then
        bskip = 3
      else if ((dx+dy)/2. > 0.03 .and. (dx+dy)/2. <= 0.05) then
        bskip = 5
      else if ((dx+dy)/2. <= 0.03) then
        bskip = 10
      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'In is_it_a_storm, ilonfix= ',ilonfix
     &       ,' jlatfix= ',jlatfix
        print *,'ibeg jbeg iend jend = ',ibeg,jbeg,iend,jend
        print *,'cparm= ',cparm,'  parmlon parmlat = ',parmlon,parmlat
        print *,'parmval= ',parmval
        print *,' '
      endif

      vtavg = 0.0
      ivt   = 0

      xmaxpgrad = -999.0

      jloop: do jix = jbeg,jend,bskip
        iloop: do iix = ibeg,iend,bskip

          i = iix
          j = jix

          if (i < 1) then
            if (trkrinfo%gridtype == 'global') then
              i = iix + imax
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i < 1 in subroutine  is_it_a_storm'
                print *,'!!! for a non-global grid.  STOPPING....'
                print *,'!!! i= ',i
                print *,' '
              endif

              stop 97    
            endif    
          endif  

          if (i > imax) then
            if (trkrinfo%gridtype == 'global') then
              i = iix - imax
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i > imax in subroutine '
                print *,'!!! is_it_a_storm for a non-global grid.'
                print *,'!!! STOPPING....'
                print *,'!!! i= ',i,' imax= ',imax
                print *,' '
              endif

              stop 97    
            endif    
          endif
  
          call calcdist(parmlon,parmlat,glon(i),glat(j),dist,degrees)

          if (dist > radinf .or. dist == 0.0) cycle

          if (defined_pt(i,j)) then

            if (cparm == 'slp') then
              pgradient = (slp(i,j) - parmval) / dist
              if (pgradient > xmaxpgrad) xmaxpgrad = pgradient

              if ( verb .ge. 3 ) then
                write (6,93) i,j,glon(i),glat(j),dist,slp(i,j),pgradient
              endif

              if (pgradient > pthresh) then

                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'In is_it_a_storm, valid pgradient found.'
                  print '(a23,f8.5)',' pgradient threshold = ',pthresh
                  print '(a23,f8.5)',' pgradient found     = ',pgradient
                  print *,'mslp center = ',parmlon,parmlat,parmval
                  print *,'pgrad loc   = ',glon(i),glat(j),slp(i,j)
                endif

                stormcheck = 'Y'
                exit jloop
              endif
            endif

            if (cparm == 'v850') then
              call getvrvt (parmlon,parmlat,glon(i),glat(j)
     &             ,u(i,j,nlev850),v(i,j,nlev850),vr,vt,igvtret)
              if ( verb .ge. 3 ) then
                write (6,91) i,j,glon(i),glat(j),u(i,j,nlev850)
     &               ,v(i,j,nlev850),vr,vt
              endif

              vtavg = vtavg + vt
              ivt   = ivt + 1
            endif

          endif
              
        enddo iloop
      enddo jloop

  91  format (1x,'i= ',i4,' j= ',i4,' glon= ',f7.2,' glat= ',f6.2
     &       ,' u= ',f8.4,' v= ',f8.4,' vr= ',f9.5,' vt= ',f9.5)

  93  format (1x,'i= ',i4,' j= ',i4,' glon= ',f7.2,' glat= ',f6.2
     &       ,' dist= ',f8.2,' slp= ',f10.2,' pgradient= ',f8.5)

      if (stormcheck /= 'Y' .and. cparm == 'slp') then

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'!!! In is_it_a_storm, valid pgradient NOT FOUND.'
          write (6,94) '!!! (Max pgradient less than ',pthresh,' mb/km)'
 94       format (1x,a29,5x,f8.5,a7)
          write (6,95) '!!! Max pgradient (mb/km) found = ',xmaxpgrad
 95       format (1x,a34,f8.5)
          print *,' '
        endif

      endif

      if (cparm == 'v850') then

        if (ivt > 0) then
          vtavg = vtavg / float(ivt)
        else
          vtavg = 0.0
        endif

        if (parmlat > 0) then
          if (vtavg >= vthresh) then
            stormcheck = 'Y'

            if ( verb .ge. 3 ) then
              print *,' '
              print *,' In is_it_a_storm, average 850 tangential'
     &          ,' winds are OKAY (>= +',vthresh,' m/s for a NH storm).'
              print *,' Avg 850 tangential winds = ',vtavg,' m/s'
              print *,' '
            endif

          else

            if ( verb .ge. 3 ) then
              print *,' '
              print *,'!!! In is_it_a_storm, average 850 tangential'
              print *,'!!! winds did NOT exceed +',vthresh
     &             ,' m/s (NH storm).'
              print *,'!!! Avg 850 tangential winds = ',vtavg,' m/s'
              print *,' '
            endif

          endif
        else
          if (vtavg <= -vthresh) then
            stormcheck = 'Y'

            if ( verb .ge. 3 ) then
              print *,' '
              print *,' In is_it_a_storm, average 850 tangential'
     &          ,' winds are OKAY (<= -',vthresh,' m/s for a SH storm).'
              print *,' Avg 850 tangential winds = ',vtavg,' m/s'
              print *,' '
            endif

          else

            if ( verb .ge. 3 ) then
              print *,' '
              print *,'!!! In is_it_a_storm, average 850 tangential'
              print *,'!!! winds did NOT exceed -',vthresh
     &             ,' m/s (SH storm).'
              print *,'!!! Avg 850 tangential winds = ',vtavg,' m/s'
              print *,' '
            endif

          endif
        endif

      endif
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_phase (imax,jmax,inp,dx,dy,ist,ifh,trkrinfo
     &                    ,fixlon,fixlat,valid_pt,maxstorm
     &                    ,cps_vals,wcore_flag,igpret)
c
c     ABSTRACT: This subroutine is a driver subroutine for
c     determining the structure or phase of a cyclone.  Initially, we
c     will just have it use the Hart cyclone phase space (CPS) scheme.

      USE inparms; USE phase; USE set_max_parms; USE tracked_parms
      USE def_vitals; USE trkrparms; USE grid_bounds
      USE verbose_output

      implicit none

      type (datecard) inp
      type (trackstuff) trkrinfo

      character wcore_flag*1,okay_to_call_cps_routines*1
      real     fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real     cps_vals(3)
      real     dx,dy,paramb,vtl_slope,vtu_slope
      integer  imax,jmax,igpret,igcpret,ist,ifh,maxstorm
      integer  igvpret,igcv1ret,igcv2ret
      logical(1) valid_pt(imax,jmax)
c         

      if ( verb .ge. 3 ) then
        write (6,*) ' '
        write (6,611)
        write (6,613)
        write (6,615)
        write (6,*) ' '
        
 611    format(1x,'#-----------------------------------------------#')
 613    format(1x,'# start of routine to determine cyclone phase...#')
 615    format(1x,'#-----------------------------------------------#')
      endif

      if (phasescheme == 'cps' .or. phasescheme == 'both') then

        if (ifh > 1 .or. (ifh == 1 .and. trkrinfo%type == 'tracker'))
     &  then

          ! This condition that ifh > 1 is so that we *not* do the cps
          ! stuff for fhour=0 if it's a tcgen or midlat case, since we
          ! don't know the model storm motion direction for the
          ! analysis.  For a regular case where type = 'tracker', we
          ! have the observed storm's heading direction from tc vitals,
          ! so we can use that (even though the model's storm direction
          ! may differ slightly from the observed storm).  This current
          ! if statement and the ones below carefully check for these
          ! various instances.

          okay_to_call_cps_routines = 'n'

          if (ifh > 1) then
            if (fixlon(ist,ifh-1) > -990.0 .and.
     &          fixlat(ist,ifh-1) > -990.0) then
              okay_to_call_cps_routines = 'y'
            else
              if (verb >= 3) then
                print *,' '
                print *,' ><  CPS diagnostics were requested but will'
                print *,' ><  NOT be performed for this time level '
                print *,' ><  since the fixlon and fixlat at the '
                print *,' ><  previous lead time are undefined.'
                print *,' ><  This is likely the first found position'
                print *,' ><  for a genesis (tcgen or midlat) case.'
                print *,' ><  ifh= ',ifh
              endif
            endif
          elseif (ifh == 1 .and. trkrinfo%type == 'tracker') then
            okay_to_call_cps_routines = 'y'
          else
            if (verb >= 3) then
              print *,' '
              print *,' ><  CPS diagnostics were requested but will'
              print *,' ><  NOT be performed for this time level.'
              print *,' ><  The likely reason is that ifh=0 and'
              print *,' ><  this is a genesis case, so we do not '
              print *,' ><  know the storm motion direction.'
              print *,' ><  for a genesis (tcgen or midlat) case.'
              print *,' ><  ifh= ',ifh
              print *,' ><  trkrinfo%type ',trkrinfo%type
            endif
          endif

          if (okay_to_call_cps_routines == 'y') then

            ! Similarly, these next two conditions (previous lat and
            ! previous lon > -999) are in there in case we're doing a
            ! tcgen or midlat case and this is the *first* time level
            ! within a forecast that the storm has been detected (again,
            ! we don't yet know the storm heading).

            call get_cps_paramb (imax,jmax,inp,dx,dy,ist,ifh,trkrinfo
     &                  ,fixlon,fixlat,valid_pt,paramb,maxstorm,igcpret)

            call get_cps_vth (imax,jmax,inp,dx,dy,ist,ifh,trkrinfo
     &                       ,fixlon,fixlat,valid_pt,'lower',vtl_slope
     &                       ,maxstorm,igcv1ret)

            call get_cps_vth (imax,jmax,inp,dx,dy,ist,ifh,trkrinfo
     &                       ,fixlon,fixlat,valid_pt,'upper',vtu_slope
     &                       ,maxstorm,igcv2ret)

            if ( verb .ge. 3 ) then
              write (6,*) ' '
              write (6,73) storm(ist)%tcv_storm_id,ifhours(ifh)
     &             ,ifclockmins(ifh)
     &             ,paramb,vtl_slope,vtu_slope
            endif

            cps_vals(1) = paramb
            cps_vals(2) = vtl_slope
            cps_vals(3) = vtu_slope

          else

            if ( verb .ge. 3 ) then
              print *,' '
              print *,' ><  CPS diagnostics were requested but will NOT'
              print *,' ><  be performed for this time level since we '
              print *,' ><  are either at the first time level for a '
              print *,' ><  genesis case (type = midlat or tcgen), or' 
              print *,' ><  we are at any time level in which for some' 
              print *,' ><  reason the fixlon and fixlat at the'
              print *,' ><  previous time level are not defined.'
              print *,' ><  ifh= ',ifh
            endif

          endif

        else

          if ( verb .ge. 3 ) then
            print *,' '
            print *,' ><  CPS diags were requested but will NOT be'
            print *,' ><  performed for this time level since we are at'
            print *,' ><  time level 1 for a genesis case '
            print *,' ><  (type = midlat or tcgen) and we cannot'
            print *,' ><  diagnose the model direction of storm'
            print *,' ><  movement.  ifh= ',ifh
          endif

        endif

      endif

  73  format ('cps_stats: ',a4,'  lead time= ',i3,':',i2,'   paramb= '
     &       ,f8.2,'  vtl= ',f9.2,'  vtu= ',f9.2)


      if (phasescheme == 'vtt' .or. phasescheme == 'both') then
        call get_vtt_phase (inp,imax,jmax,dx,dy,ist,ifh,trkrinfo
     &        ,fixlon,fixlat,valid_pt,maxstorm,wcore_flag,igvpret)
      endif


      if ( verb .ge. 3 ) then
        write (6,*) ' '
        write (6,631)
        write (6,633)
        write (6,635)
        write (6,*) ' '
        
 631    format(1x,'#-------------------------------------------------#')
 633    format(1x,'# End of routine to determine cyclone phase...    #')
 635    format(1x,'#-------------------------------------------------#')
      endif

c         
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_cps_paramb (imax,jmax,inp,dx,dy,ist,ifh,trkrinfo
     &                 ,fixlon,fixlat,valid_pt,paramb,maxstorm,igcpret)
c
c     ABSTRACT: This subroutine is part of the algorithm for determining
c     the structure, or phase, of a cyclone.  For Hart's cyclone phase
c     space, this subroutine determines "Parameter B", which determines
c     the degree of thermal symmetry between the "left" and "right" 
c     hemispheres of a storm, in the layer between 900 and 600 mb.
c     We evaluate only those points that are within 500 km of the 
c     storm center.

      USE inparms; USE phase; USE set_max_parms; USE trig_vals 
      USE grid_bounds; USE tracked_parms; USE def_vitals; USE trkrparms
      USE verbose_output

      implicit none

      type (datecard) inp
      type (trackstuff) trkrinfo

      real      fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real      zthicksum(2)
      real      rlonc,rlatc,rlonb,rlatb,xdist,degrees,d,cosarg
      real      st_heading,st_heading_rad,ricps,dx,dy
      real      pt_dir,pt_dir_rad,zthick,hemval,paramb
      real      zthick_right_mean,zthick_left_mean
      integer   imax,jmax,igpret,igcpret,ist,ifh,npts,bskip,i,j
      integer   ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret
      integer   left_ct,right_ct,hemis,icount,maxstorm,ip
      logical(1) valid_pt(imax,jmax)
c
      ricps = 500.0

c     -----------------------------------------------------------------
c     First, determine the angle that the storm took getting from the
c     last position to the current one.  If this is for ifh=1 for a
c     regular type=tracker case, we will just use the storm direction
c     as read from the tcvitals card.
c     -----------------------------------------------------------------

      if (ifh == 1) then

        st_heading = float(storm(ist)%tcv_stdir)

      else

        call calcdist(fixlon(ist,ifh),fixlat(ist,ifh)
     &             ,fixlon(ist,ifh-1),fixlat(ist,ifh-1),xdist,degrees)

        rlonc = (360.-fixlon(ist,ifh)) * dtr
        rlatc = fixlat(ist,ifh) * dtr
        rlonb = (360.-fixlon(ist,ifh-1)) * dtr
        rlatb = fixlat(ist,ifh-1) * dtr
        d     = degrees * dtr

        if (d == 0.0) then
  
          ! Storm is stationary...
          st_heading = 0.0

        else
  
          cosarg = (sin(rlatc)-sin(rlatb)*cos(d))/(sin(d)*cos(rlatb))
          if (cosarg > 1.0)  cosarg = 1
          if (cosarg < -1.0) cosarg = -1
  
          if (sin(rlonc-rlonb) < 0.0) then
            st_heading_rad = acos(cosarg)
          else
            st_heading_rad = 2*pi - acos(cosarg)
          endif

          st_heading = st_heading_rad / dtr

        endif

      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,' In get_cps_paramb, lead time= ',ifhours(ifh),':'
     &         ,ifclockmins(ifh)
     &         ,'  ',storm(ist)%tcv_storm_id,' '
     &              ,storm(ist)%tcv_storm_name
        print '(a43,f9.3)'
     &       ,'  In get_cps_paramb, model storm heading = '
     &       ,st_heading
        print *,' '
      endif

c     -----------------------------------------------------------------
c     Now call  get_ij_bounds to get the boundaries for a smaller 
c     subdomain, or subset of gridpoints, in which to evaluate the 
c     parameter B statistic.  We will only include points within 
c     500 km of the storm center for evaluation.
c     -----------------------------------------------------------------

      npts = ceiling(ricps/(dtk*(dx+dy)/2.))

      call get_ij_bounds (npts,0,ricps,imax,jmax,dx,dy
     & ,glatmax,glatmin,glonmax,glonmin,fixlon(ist,ifh),fixlat(ist,ifh)
     & ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if (igiret /= 0) then
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in get_cps_paramb from call to'
          print *,'!!! get_ij_bounds, stopping processing for'
          print *,'!!! storm number ',ist
        endif
        igcpret = 92
        return
      endif

c     -----------------------------------------------------------------
c     Now loop through all of the points of the subdomain.  If the 
c     point is further than 500 km from the storm center, discard it.
c     Otherwise, evaluate the angle from the storm center to this point
c     to determine the hemisphere of the point, that is, if the point 
c     is to the left or the right of the storm track.
c     -----------------------------------------------------------------

      ! We will want to speed things up for finer resolution grids.  
      ! We can do this by skipping some of the points in the  
      ! loop for the evaluation of parameter B.

      if ((dx+dy)/2. > 0.20) then
        bskip = 1
      else if ((dx+dy)/2. > 0.10 .and. (dx+dy)/2. <= 0.20) then
        bskip = 2
      else if ((dx+dy)/2. > 0.05 .and. (dx+dy)/2. <= 0.10) then
        bskip = 3
      else if ((dx+dy)/2. > 0.03 .and. (dx+dy)/2. <= 0.05) then
        bskip = 5
      else if ((dx+dy)/2. <= 0.03) then
        bskip = 10
      endif

      left_ct = 0
      right_ct = 0
      zthicksum = 0
      icount = 0

c      print *,'CPS CORE: ibeg= ',ibeg,' iend= ',iend
c      print *,'CPS CORE: jbeg= ',jbeg,' jend= ',jend

      jloop: do j=jbeg,jend,bskip
        iloop: do i=ibeg,iend,bskip

          icount = icount + 1

c          print *,'CPS CORE: ist= ',ist,' ifh= ',ifh,' j= ',j,' i= ',i

          if (i > imax) then
            if (trkrinfo%gridtype == 'global') then
              ip = i - imax   ! If wrapping past GM
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: In get_cps_paramb, the '
                print *,'!!!    user-requested eastern search boundary'
                print *,'!!!    is beyond the eastern bounds of '
                print *,'!!!    this regional grid.  '
                print *,'!!!    Parameter B will not be computed.'
                print *,'!!!    Subroutine location A....'
                print *,'!!!         '
                print *,'!!!   imax of regional grid    = ',imax
                print *,'!!!   User-requested eastern i = ',i
                print *,' '
              endif

              paramb  = -9999.99
              igcpret = 95
              return
            endif    
          else   
            ip = i
          endif   

          if (i < 1) then
            if (trkrinfo%gridtype == 'global') then
              ip = i + imax   ! If wrapping past GM
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i < 1 in subroutine  get_cps_paramb'
                print *,'!!! for a non-global grid.'
                print *,'!!! Parameter B will not be computed.'
                print *,'!!! i= ',i
                print *,' '
              endif

              paramb  = -9999.99
              igcpret = 95
              return
            endif
          endif

          call calcdist (fixlon(ist,ifh),fixlat(ist,ifh),glon(ip)
     &                  ,glat(j),xdist,degrees)

          if (xdist > ricps) cycle iloop

          if (valid_pt(ip,j)) then
            continue
          else

            if ( verb .ge. 3 ) then
              print *,' '
              print *,'!!! UNDEFINED PT OUTSIDE OF GRID '
              print *,'!!! IN GET_CPS_PARAMB....'
              print *,'!!! i= ',i,' ip= ',ip,' j= ',j
              print *,'!!! fixlon= ',fixlon(ist,ifh),' fixlat= '
     &             ,fixlat(ist,ifh)
              print *,'!!! glon= ',glon(ip),' glat= ',glat(j)
              print *,'!!! Parameter B will not be computed.'
              print *,'!!! EXITING GET_CPS_PARAMB....'
              print *,' '
            endif

            paramb  = -9999.99
            igcpret = 95
            return
          endif   

          !----------------------------------------------------------
          ! Calculate angle from storm center to point, in a 0-360
          ! framework, clockwise positive.
          !----------------------------------------------------------

          rlonc = (360.-glon(ip)) * dtr
          rlatc = glat(j) * dtr
          rlonb = (360.-fixlon(ist,ifh)) * dtr
          rlatb = fixlat(ist,ifh) * dtr
          d     = degrees * dtr

          if (d > 0.) then
            cosarg = (sin(rlatc)-sin(rlatb)*cos(d))/(sin(d)*cos(rlatb))
            if (cosarg > 1.0)  cosarg = 1
            if (cosarg < -1.0) cosarg = -1
  
            if (sin(rlonc-rlonb) < 0.0) then
              pt_dir_rad = acos(cosarg)
            else
              pt_dir_rad = 2*pi - acos(cosarg)
            endif
          else
            pt_dir_rad = 0.0
          endif

          pt_dir = pt_dir_rad / dtr

          !------------------------------------------------------------
          ! Based on the angle that the point is from the storm center,
          ! determine if the point is to the left or the right of the
          ! storm track.
          !------------------------------------------------------------

          if (st_heading >= 180.0) then
            if ((st_heading - pt_dir) > 0.0 .and. 
     &          (st_heading - pt_dir) <= 180) then
              hemis = 2
              left_ct = left_ct + 1
            else
              hemis = 1
              right_ct = right_ct + 1
            endif
          else
            if ((pt_dir - st_heading) > 0.0 .and. 
     &          (pt_dir - st_heading) <= 180) then
              hemis = 1
              right_ct = right_ct + 1
            else
              hemis = 2
              left_ct = left_ct + 1
            endif
          endif

          !------------------------------------------------------------
          ! Calculate the 600-900 mb thickness at this point and add 
          ! the  thickness value to the array for the correct "storm
          ! hemisphere".
          !------------------------------------------------------------

          zthick = cpshgt(ip,j,7) - cpshgt(ip,j,1)
          zthicksum(hemis) = zthicksum(hemis) + zthick

          if ( verb .ge. 3 ) then
            write (6,51) rlonb/dtr,rlatb/dtr,rlonc/dtr,rlatc/dtr
     &           ,st_heading,pt_dir,hemis,zthick
          endif
               
        enddo iloop
      enddo jloop

 51   format (1x,'stlon stlat = ',2(f6.2,2x),'  ptlon ptlat = '
     &       ,2(f6.2,2x),'  sthead= ',f6.2,'  ptdir= ',f6.2,'  hemis= '
     &       ,i1,'  zthick= ',f7.2)

c     ------------------------------------------------------------------
c     Now calculate parameter B.  The hemval parameter = +1 for storms
c     in the Northern Hemisphere and -1 for Southern Hemisphere storms.
c     ------------------------------------------------------------------

      zthick_right_mean = zthicksum(1) / float(right_ct)
      zthick_left_mean  = zthicksum(2) / float(left_ct)

      if (fixlat(ist,ifh) < 0.0) then
        hemval = -1.0
      else
        hemval =  1.0
      endif

      paramb = hemval * (zthick_right_mean - zthick_left_mean)

      if ( verb .ge. 3 ) then
        print *,' '
        print *,' In get_cps_paramb, lead time= ',ifhours(ifh),':'
     &       ,ifclockmins(ifh)
     &       ,'  ',storm(ist)%tcv_storm_id,' ',storm(ist)%tcv_storm_name
        print *,'  right_ct= ',right_ct,'  left_ct= ',left_ct
        print *,'  zthicksum(1)= ',zthicksum(1)
        print *,'  zthicksum(2)= ',zthicksum(2)
        print *,'  zthick_right_mean= ',zthick_right_mean
        print *,'  zthick_left_mean=  ',zthick_left_mean
        print *,'  hemval= ',hemval
        print *,'  END of get_cps_paramb, paramb= ',paramb
      endif

c         
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_cps_vth (imax,jmax,inp,dx,dy,ist,ifh,trkrinfo
     &        ,fixlon,fixlat,valid_pt,clayer,vth_slope,maxstorm,igcvret)
c
c     ABSTRACT: This subroutine is part of the algorithm for determining
c     the structure, or phase, of a cyclone.  For Hart's cyclone phase
c     space, this subroutine determines the thermal wind profile for 
c     either the lower troposphere (i.e., between 600 and 900 mb) or the
c     upper troposphere (i.e., between 300 and 600 mb).  We evaluate 
c     only those points that are within 500 km of the storm center.

      USE inparms; USE phase; USE set_max_parms; USE trig_vals
      USE grid_bounds; USE tracked_parms; USE def_vitals; USE trkrparms
      USE verbose_output

      implicit none

      type (datecard) inp
      type (trackstuff) trkrinfo

      character clayer*5
      real      tmp1,tmp2,tmp3
      real      fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real      zmax(7),zmin(7),zdiff(7),xlolevs(7),xhilevs(7),plev(7)
      real      dlnp(7),dzdlnp(7),dz(7),lnp(7)
      real      vth_slope,xdist,degrees,d,cosarg
      real      ricps,dx,dy,R2
      integer   imax,jmax,igpret,igcpret,ist,ifh,npts,bskip,i,j,k,kix
      integer   ilonfix,jlatfix,ibeg,jbeg,iend,jend,igcvret,igiret
      integer   kbeg,kend,maxstorm,ip
      logical(1) valid_pt(imax,jmax)

      data xlolevs /900.,850.,800.,750.,700.,650.,600./
      data xhilevs /600.,550.,500.,450.,400.,350.,300./
c      data xlolevs /90000.,85000.,80000.,75000.,70000.,65000.,60000./
c      data xhilevs /60000.,55000.,50000.,45000.,40000.,35000.,30000./
c
      ricps = 500.0
      plev = 0.0

      if (clayer == 'lower') then
        kbeg = 1
        kend = 7
        plev = xlolevs
      else
        kbeg = 7
        kend = 13
        plev = xhilevs
      endif

c     -----------------------------------------------------------------
c     First, call  get_ij_bounds to get the boundaries for a smaller
c     subdomain, or subset of gridpoints, in which to evaluate the
c     parameter B statistic.  We will only include points within
c     500 km of the storm center for evaluation.
c     -----------------------------------------------------------------

      npts = ceiling(ricps/(dtk*(dx+dy)/2.))

      call get_ij_bounds (npts,0,ricps,imax,jmax,dx,dy
     & ,glatmax,glatmin,glonmax,glonmin,fixlon(ist,ifh),fixlat(ist,ifh)
     & ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if (igiret /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in get_cps_vtl from call to'
          print *,'!!! get_ij_bounds, stopping processing for'
          print *,'!!! storm number ',ist
        endif

        igcvret = 92
        return
      endif

c     ------------------------------------------------------------------
c     Now loop through all of the points of the subdomain at each level.
c     If a point is further than 500 km from the storm center, discard 
c     it. Otherwise, evaluate the gp height at the point to determine 
c     if it is a max or a min for the given level.  Store the max and
c     min height at each level in an array.
c     ------------------------------------------------------------------
        
c      ! We will want to speed things up for finer resolution grids.
c      ! We can do this by skipping some of the points in the
c      ! loop for the evaluation of parameter B.
c        
c      if ((dx+dy)/2. > 0.20) then
c        bskip = 1
c      else if ((dx+dy)/2. > 0.10 .and. (dx+dy)/2. <= 0.20) then
c        bskip = 2
c      else if ((dx+dy)/2. <= 0.10) then
c        bskip = 3
c      endif

      bskip = 1    ! Don't do any skipping for now....

      zmax  = -9999999.0
      zmin  = 9999999.0
      zdiff = 0.0
      lnp   = 0.0

      levloop: do k = kbeg,kend

        if (kbeg == 7) then   
          ! processing upper layers (600-300 mb)
          kix = k - 6
        else
          ! processing lower layers (900-600 mb)
          kix = k
        endif

        lnp(kix) = log(plev(kix))
        
        jloop: do j=jbeg,jend,bskip
          iloop: do i=ibeg,iend,bskip

            if (i > imax) then
              if (trkrinfo%gridtype == 'global') then
                ip = i - imax   ! If wrapping past GM
              else

                if ( verb .ge. 1 ) then
                  print *,' '
                  print *,'!!! ERROR: In get_cps_vth, the '
                  print *,'!!!  user-requested eastern search boundary'
                  print *,'!!!  is beyond the eastern bounds of '
                  print *,'!!!  this regional grid.  '
                  print *,'!!!  Thermal wind parm will not be computed.'
                  print *,'!!!  Subroutine location A....'
                  print *,'!!!         '
                  print *,'!!!   imax of regional grid    = ',imax
                  print *,'!!!   User-requested eastern i = ',i
                  print *,' '
                endif

                vth_slope = -9999.99
                igcvret   = 95
                return
              endif    
            else   
              ip = i
            endif   

            if (i < 1) then
              if (trkrinfo%gridtype == 'global') then
                ip = i + imax
              else

                if ( verb .ge. 1 ) then
                  print *,' '
                  print *,'!!! ERROR: i < 1 in subroutine  get_cps_vth'
                  print *,'!!! for a non-global grid.'
                  print *,'!!! Thermal wind parm will not be computed.'
                  print *,'!!! i= ',i
                  print *,' '
                endif

                vth_slope = -9999.99
                igcvret   = 95
                return
              endif
            endif
        
            call calcdist (fixlon(ist,ifh),fixlat(ist,ifh),glon(ip)
     &                    ,glat(j),xdist,degrees)
        
            if (xdist > ricps) cycle iloop
        
            if (valid_pt(ip,j)) then
              continue
            else

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'!!! UNDEFINED PT OUTSIDE OF GRID '
                print *,'!!! IN GET_CPS_VTH....'
                print *,'!!! i= ',i,' ip= ',ip,' j= ',j,' k= ',k
     &               ,' clayer= ',clayer
                print *,'!!! fixlon= ',fixlon(ist,ifh),' fixlat= '
     &               ,fixlat(ist,ifh)
                print *,'!!! glon(ip)= ',glon(ip),' glat= ',glat(j)
                print *,'!!! Thermal wind parm will not be computed.'
                print *,'!!! EXITING GET_CPS_VTH....'
                print *,' '
              endif

              vth_slope = -9999.99
              igcvret   = 95
              return
            endif

            tmp1 = zmax(kix)
            tmp2 = cpshgt(ip,j,k)
            tmp3 = zmin(kix)

            zmax(kix) = max(tmp1,tmp2)
            zmin(kix) = min(tmp3,tmp2)

c            zmax(kix) = max(zmax(kix),cpshgt(ip,j,k))
c            zmin(kix) = min(zmin(kix),cpshgt(ip,j,k))

          enddo iloop
        enddo jloop

        zdiff(kix) = zmax(kix) - zmin(kix)

      enddo levloop

c     ------------------------------------------------------------------
c     Now calculate the vertical derivative of the gp height, that is,
c     d(dz)/d(ln(p)).  Here, zdiff is the gp height perturbation at a 
c     given level, calculated in the loop above; dz is the vertical 
c     change in that perturbation from one level to the next.
c     ------------------------------------------------------------------
      
      dz = 0.0
      dlnp = 0.0
      dzdlnp = 0.0

      do k = 2,7
        dz(k) = zdiff(k) - zdiff(k-1)
        dlnp(k) = log(plev(k)) - log(plev(k-1))
        dzdlnp(k) = dz(k) / dlnp(k)
      enddo

c     ------------------------------------------------------------------
c     Now call a correlation routine to get the slope of a regression 
c     line.  The independent variable that we input is dlnp, the change
c     in log of pressure with height.  The dependent variable is 
c     dzdlnp, the vertical change in the height perturbation with 
c     respect to the change in pressure.  The slope that is returned 
c     defines whether we've got a cold core or warm core system.
c     See Hart (MWR, April 2003, Vol 131, pp. 585-616) for more 
c     details, specifically his Fig. 3 and the discussion surrounding.
c     Note that in the call to calccorr, we are sending only 6 of the 
c     7 elements of the dlnp and dzdlnp arrays, beginning with the 
c     2nd element of each.  That's because the first array value for
c     each of those arrays is empty, since in the loop just above, we
c     start with kbeg+1, not kbeg.
c     ------------------------------------------------------------------

      call calccorr(lnp(2),zdiff(2),6,R2,vth_slope)

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'++ In get_cps_vth, values for vth follow for '
     &       ,'lead time= ',ifhours(ifh),':',ifclockmins(ifh),'  '
     &       ,storm(ist)%tcv_storm_id,' ',storm(ist)%tcv_storm_name
        print *,'  ... clayer = ',clayer 
        print *,' '
      endif

      do k = kbeg,kend

        if (kbeg == 7) then
          kix = k - 6
        else
          kix = k
        endif

        if ( verb .ge. 3 ) then
          print *,' '
          write (6,31) k,plev(kix),zmax(kix),zmin(kix),zdiff(kix)
          if (kix > 1) then
            write (6,32) plev(kix),log(plev(kix))
     &           ,plev(kix-1),log(plev(kix-1))
            write (6,33) dz(kix),dlnp(kix),dzdlnp(kix)
          else
            write (6,34)
          endif
        endif

      enddo

  31  format (1x,'  +++ k= ',i2,' press= ',f8.1,' zmax= ',f7.2
     &       ,' zmin= ',f7.2,' zdiff= ',f7.2)
  32  format (1x,'      ln(',f7.1,')= ',f9.6,'  ln(',f7.1,')= ',f9.6)
  33  format (1x,'      dz= ',f10.2,' dlnp= ',f13.6,'  dzdlnp= ',f12.3)
  34  format (1x,'      --- First level... no derivatives done...')
c
      return
      end
c
C----------------------------------------------------
C
C----------------------------------------------------
      subroutine calccorr(xdat,ydat,numpts,R2,slope)
c
c     This subroutine is the main driver for a series of
c     other subroutines below this that will calculate the
c     correlation between two input arrays, xdat and ydat.
c
c     INPUT:
c      xdat     array of x (independent) data points
c      ydat     array of y (dependent)   data points
c      numpts   number of elements in each of xdat and ydat
c
c     OUTPUT:
c      R2    R-squared, the coefficient of determination
c      slope Slope of regression line
c
c     xdiff   array of points for xdat - xmean
c     ydiff   array of points for ydat - ymean
c     yestim  array of regression-estimated points
c     yresid  array of residuals (ydat(i) - yestim(i))

      USE verbose_output

      implicit none

      real    xdat(numpts),ydat(numpts)
      real    xdiff(numpts),ydiff(numpts)
      real    yestim(numpts),yresid(numpts)
      real    xmean,ymean,slope,yint,R2
      integer numpts,i

c
      call getmean(xdat,numpts,xmean)
      call getmean(ydat,numpts,ymean)
c
      call getdiff(xdat,numpts,xmean,xdiff)
      call getdiff(ydat,numpts,ymean,ydiff)
c
      call getslope(xdiff,ydiff,numpts,slope)
      yint = ymean - slope * xmean
c
      call getyestim(xdat,slope,yint,numpts,yestim)
      call getresid(ydat,yestim,numpts,yresid)
c

      if ( verb .ge. 3 ) then
        print *,' '
        print *,' *--------------------------------------------------* '
        print *,' * CPS Thermal wind regression details              * '
        print *,' *--------------------------------------------------* '
      endif

      call getcorr(yresid,ydiff,numpts,R2)

      if ( verb .ge. 3 ) then
        print *,'   i     ydat     xdat    ydiff    xdiff        e'
     &       ,'       e2   ydiff2'
        print *,' ----   -----    -----    -----    -----    -----   '
     &       ,' -----    -----'
        do i = 1,numpts
          write(6,'(2x,i3,2x,f7.2,2x,f7.4,2x,f7.2,2x,f7.4,3(2x,f7.2))')
     &         i,ydat(i),xdat(i),ydiff(i)
     &         ,xdiff(i),yresid(i),yresid(i)*yresid(i)
     &         ,ydiff(i)*ydiff(i)
        enddo
        
        print *,' ----   -----    -----    -----    -----    -----   '
     &       ,' -----    -----'
        print *,' '
        write (6,'(1x,a13,f9.3,3x,a5,f7.2)') ' means:   y: ',ymean
     &       ,'  x: ',xmean
        
        write (6,*) ' '
        write (6,30) 'slope= ',slope,'         y-intercept = ',yint
 30     format (2x,a7,f10.3,a23,f10.3)
        if (slope .gt. 0.0) then
          write(6,40) 'Regression equation:   Y = ',yint,' + ',slope
        else
          write(6,40) 'Regression equation:   Y = ',yint,' - '
     &              ,abs(slope)
        endif
 40     format (2x,a27,f8.2,a3,f8.2,'X')
c         
        print *,' '
        write (6,'(1x,a17,f7.4,5x,a7,f7.4)') ' R2(r_squared) = ',R2
     &       ,'   r = ',sqrt(R2)
        print *,' '
        print *,' *--------------------------------------------------* '
        print *,' *  End of regression details                       * '
        print *,' *--------------------------------------------------* '
      endif

      return
      end

c-------------------------------------------c
c                                           c
c-------------------------------------------c
      subroutine getmean(xarr,inum,zmean)
c     
c     This subroutine is part of the correlation calculation,
c     and it simply returns the mean of the input array, xarr.
c     
c     INPUT:
c      xarr   input array of data points
c      inum   number of data points in xarr
c     
c     OUTPUT:
c      zmean  mean of data values in xarr

      implicit none
      
      real   xarr(inum)
      real   xsum,zmean
      integer i,inum
c     
      xsum = 0.0
      do i = 1,inum
        xsum = xsum + xarr(i)
      enddo
c     
      zmean = xsum / float(MAX(inum,1))
c     
      return
      end
      
c-------------------------------------------c
c                                           c
c-------------------------------------------c
      subroutine getdiff(xarr,inum,zmean,zdiff)
c     
c     This subroutine is part of the correlation calculation,
c     and it returns in the array zdiff the difference values
c     between each member of the input array xarr and the
c     mean value, zmean.
c     
c     INPUT:
c      xarr   input array of data points
c      inum   number of data points in xarr
c      zmean  mean of input array (xarr)
c     
c     OUTPUT:
c      zdiff  array containing xarr(i) - zmean

      implicit none
      
      real xarr(inum),zdiff(inum)
      real zmean
      integer i,inum
c     
      do i = 1,inum
        zdiff(i) = xarr(i) - zmean
      enddo
c     
      return
      end
      
c-------------------------------------------c
c                                           c
c-------------------------------------------c

      subroutine getslope(xarr,yarr,inum,slope)
c
c     This subroutine is part of the correlation calculation,
c     and it returns the slope of the regression line.
c
c     INPUT:
c      xarr   input array of xdiffs (x - xmean)
c      yarr   input array of ydiffs (y - ymean)
c      inum   number of points in x & y arrays
c
c     OUTPUT:
c      slope  slope of regression line

      real xarr(inum),yarr(inum)
      real slope,sumxy,sumx2
      integer i,inum

c     First sum up the xarr*yarr products....

      sumxy = 0.0
      do i = 1,inum
        sumxy = sumxy + xarr(i) * yarr(i)
      enddo

c     Now sum up the x-squared terms....

      sumx2 = 0.0
      do i = 1,inum
        sumx2 = sumx2 + xarr(i) * xarr(i)
      enddo

c     Now get the slope....

      slope = sumxy / sumx2

      return
      end

c-------------------------------------------c
c                                           c
c-------------------------------------------c
      subroutine getyestim(xarr,slope,yint,inum,yestim)
c
c     This subroutine is part of the correlation calculation,
c     and it calculates all the predicted y-values using the
c     regression equation that has been calculated.
c
c     INPUT:
c      xarr   array of x data points
c      slope  slope of the calculated regression line
c      yint   y-intercept of the calculated regression line
c      inum   number of input points
c
c     OUTPUT:
c      yestim array of y pts estimated from regression eqn.

      implicit none

      real xarr(inum),yestim(inum)
      real slope,yint
      integer i,inum
c
      do i = 1,inum
        yestim(i) = yint + xarr(i) * slope
      enddo
c
      return
      end

c-------------------------------------------c
c                                           c
c-------------------------------------------c
      subroutine getresid(yarr,yestim,inum,yresid)
c
c     This subroutine is part of the correlation calculation,
c     and it calculates all the residual values between the
c     input y data points and the y-estim predicted y values.
c
c     INPUT:
c      yarr   array of y data points
c      yestim array of y pts estimated from regression eqn.
c      inum   number of input points
c
c     OUTPUT:
c      yresid array of residuals (ydat(i) - yestim(i))

      implicit none

      real yarr(inum),yestim(inum),yresid(inum)
      integer i,inum
c
      do i = 1,inum
        yresid(i) = yarr(i) - yestim(i)
      enddo
c
      return
      end

c-------------------------------------------c
c                                           c
c-------------------------------------------c
      subroutine getcorr(yresid,ydiff,inum,R2)
c
c     This subroutine is part of the correlation calculation,
c     and it does the actual correlation calculation.
c
c     INPUT:
c      yresid array of residuals (ydat(i) - yestim(i))
c      ydiff  array of points for ydat - ymean
c      inum   number of points in the arrays
c
c     OUTPUT:
c      R2     R-squared, the coefficient of determination

      USE verbose_output

      implicit none

      real yresid(inum),ydiff(inum)
      real R2,sumyresid,sumydiff
      integer i,inum
c
      sumyresid = 0.0
      sumydiff  = 0.0

      do i = 1,inum
        sumyresid = sumyresid + yresid(i) * yresid(i)
        sumydiff  = sumydiff  + ydiff(i) * ydiff(i)
      enddo

      if ( verb .ge. 3 ) then
        write (6,*)  ' '
        write (6,30) 'Sum of y-residuals squared (e2) = ',sumyresid
        write (6,30) 'Sum of y-diffs squared (ydiff2) = ',sumydiff
        write (6,*)  ' '
 30     format (1x,a35,f15.2)
      endif

      if (sumydiff == 0.0) then
       R2=1.0
       else
      R2 = 1 - sumyresid / sumydiff
      endif
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_vtt_phase (inp,imax,jmax,dx,dy,ist,ifh,trkrinfo
     &          ,fixlon,fixlat,valid_pt,maxstorm,wcore_flag,igvpret)
c
c     ABSTRACT: This subroutine is part of the algorithm for determining
c     the structure, or phase, of a cyclone.  Here, we are only looking
c     at the mid-to-upper tropospheric warm anomaly at the center of
c     the storm.  The temperature data that we are searching through in
c     the tmean array should be the 300-500 mb mean temperature data.
c     The criteria in this algorithm are based loosely on Vitart's
c     criteria for warm core checking, but the nuts & bolts of the
c     subroutine use algorithms from this tracker, including the  barnes
c     analysis.  First, we locate the warm core with the  find_maxmin
c     routine.  Then we use the  check_closed_contour routine to see if
c     there is a closed temperature contour surrounding the warm core.
c
c     INPUT:
c     inp
c     imax     Num pts in i direction on input grid
c     jmax     Num pts in j direction on input grid
c     inp      contains input date and model number information
c     dx       Grid spacing in i-direction on input grid
c     dy       Grid spacing in j-direction on input grid
c     ist      integer storm number (internal to the  tracker)
c     ifh      integer index for lead time
c     trkrinfo derived type containing grid info on user boundaries
c     fixlon   array containing found fix longitudes
c     fixlat   array containing found fix latitudes
c     valid_pt Logical; bitmap indicating if valid data at that pt.
c     maxstorm maximum # of storms to be handled
c
c     OUTPUT:
c     wcore_flag 'u'=undetermined, 'y'=yes, 'n'=no
c     igvpret  Return code for this subroutine.
c
c     LOCAL:
c     wcore_mean_val barnes-averaged value of the temperature at the
c              location where the  tracker found the warm core.
c     wcore_point_max max temperature found at a gridpoint near the
c              location where the  tracker found the warm core using
c              barnes analysis.

      USE set_max_parms; USE grid_bounds; USE trkrparms; USE contours
      USE tracked_parms; USE gen_vitals; USE def_vitals; USE inparms
      USE phase
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo,wcore_trkrinfo
      type (cint_stuff) wcore_contour_info
      type (datecard) inp

      character*1 get_last_contour_flag,wcore_flag
      real      fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real      dx,dy,wcore_mean_val,wcore_mean_lon,wcore_mean_lat
      real      wcore_point_max,tlastcont,rlastcont,tlastout,rlastout
      integer   imax,jmax,igvpret,ist,ifh,npts,bskip,i,j
      integer   ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret
      integer   icount,maxstorm,ip,ifmret,ifilret,ifix,jfix,icccret
      integer   num_check_conts
      logical(1) valid_pt(imax,jmax),compflag,wcore_mask(imax,jmax)
      logical(1) output_file_open
c

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'*-------------------------------------------------*'
        print *,'* At top of get_vtt_phase                         *'
        write (6,102) ifhours(ifh),ifclockmins(ifh)
 102    format (1x,'* Searching for warm core at hour ',i4,':',i2.2)
        write (6,103) wcore_depth
 103    format (1x,'* Warm core depth threshold (wcore_depth) = ',f7.2)
        print *,'*-------------------------------------------------*'
      endif

c     ------------------------------------------------------------
      wcore_mask = .false.
      wcore_mean_lon = -999.0
      wcore_mean_lat = -999.0
      wcore_trkrinfo = trkrinfo ! set equal to values from trkrinfo...
      wcore_trkrinfo%contint = wcore_depth  ! ...except use the warm
                                ! core contour interval specified by
                                ! the user in the extrkr.sh script.

c     ------------------------------------------------------------
c     First, call  find_maxmin to locate the warm core

      call find_maxmin (imax,jmax,dx,dy,'tmp'
     &      ,tmean,'max',ist,fixlon(ist,ifh),fixlat(ist,ifh)
     &      ,glon,glat,valid_pt,trkrinfo,compflag
     &      ,wcore_mean_lon,wcore_mean_lat,wcore_mean_val
     &      ,glatmax,glatmin,glonmax,glonmin,inp%modtyp,ifmret)

      if (verb .ge. 3) then
        print *,' '
        print *,'After call to find_maxmin for wcore, ifmret= ',ifmret
        print *,'      wcore_mean_val= ',wcore_mean_val
      endif

c     ------------------------------------------------------------
c     Once  find_maxmin returns a value and a location for the
c     barnes-averaged value of a warm core, then make a call to
c     fix_latlon_to_ij to (1) get the actual gridpoint value of the
c     temperature (the value stored in wcore_mean_val is an
c     area-averaged value coming from the  barnes analysis), and
c     (2) to get the (i,j) indeces for this gridpoint to be used in
c     the call to check_closed_contour below.

      if (wcore_mean_lat > -99.0 .and. wcore_mean_lon > -990.0) then
        call fix_latlon_to_ij (imax,jmax,dx,dy,tmean,'max'
     &     ,valid_pt,wcore_mean_lon,wcore_mean_lat
     &     ,wcore_mean_val,ifix,jfix,wcore_point_max,'tracker'
     &     ,glatmax,glatmin,glonmax,glonmin
     &     ,trkrinfo,ifilret)
        if (ifilret == 0) then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'+++ Warm core stats: '
            write (6,105) storm(ist)%tcv_storm_id
     &           ,gstorm(ist)%gv_gen_date
     &           ,gstorm(ist)%gv_gen_fhr,gstorm(ist)%gv_gen_lat
     &           ,gstorm(ist)%gv_gen_latns,gstorm(ist)%gv_gen_lon
     &           ,gstorm(ist)%gv_gen_lonew,gstorm(ist)%gv_gen_type
     &           ,ifhours(ifh),ifclockmins(ifh)
     &           ,wcore_mean_lon,360.-wcore_mean_lon
     &           ,wcore_mean_lat,wcore_mean_val
            write (6,106) storm(ist)%tcv_storm_id
     &           ,gstorm(ist)%gv_gen_date
     &           ,gstorm(ist)%gv_gen_fhr,gstorm(ist)%gv_gen_lat
     &           ,gstorm(ist)%gv_gen_latns,gstorm(ist)%gv_gen_lon
     &           ,gstorm(ist)%gv_gen_lonew,gstorm(ist)%gv_gen_type
     &           ,ifhours(ifh),ifclockmins(ifh)
     &           ,ifix,jfix,wcore_point_max
          endif

        else
          ! Search went out of regional grid bounds....
          
          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR IN get_vtt_phase.  The call to  '
            print *,'!!! fix_latlon_to_ij returned a non-zero return '
            print *,'!!! code, which means that the search for the fix'
            print *,'!!! i and j went out of bounds for a regional '
            print *,'!!! grid. This should have been caught in a '
            print *,'!!! previous call to find_maxmin for one of the '
            print *,'!!! various fix parms. In any event, we will not'
            print *,'!!! search for a warm core for this storm and '
            print *,'!!! lead time.'
            print *,' '
            write (6,115) storm(ist)%tcv_storm_id
     &           ,gstorm(ist)%gv_gen_date
     &           ,gstorm(ist)%gv_gen_fhr,gstorm(ist)%gv_gen_lat
     &           ,gstorm(ist)%gv_gen_latns,gstorm(ist)%gv_gen_lon
     &           ,gstorm(ist)%gv_gen_lonew,gstorm(ist)%gv_gen_type
     &           ,ifhours(ifh),ifclockmins(ifh)
     &           ,'U',-999.99,-9999.99
          endif

          igvpret = 95
          wcore_flag = 'u'
          return
        endif
      endif

  105 format (1x,'    wcore: ',a4,1x,i10.10,'_F',i3.3,'_',i3.3,a1
     &       ,'_',i4.4,a1,'_',a3,2x,i4,':',i2.2,'  mean_lon: ',f7.2,'E'
     &       ,1x,'(',f7.2,'W)',2x,'mean_lat: ',f7.2,2x
     &       ,'wcore_mean_val(K): ',f12.3)
  106 format (1x,'    wcore: ',a4,1x,i10.10,'_F',i3.3,'_',i3.3,a1
     &       ,'_',i4.4,a1,'_',a3,2x,i4,':',i2.2,'  ifix: ',i5,2x
     &       ,' jfix: ',i5,2x,'wcore_point_max(K): ',f12.3)


c     ------------------------------------------------------------
c     The Vitart scheme specifies that the temperature must decrease
c     by at least 1.0C in all directions from the warm core center
c     within a distance of 8 deg.  A rigorous check of this criterion
c     is performed here by utilizing the  check_closed_contour routine.
c     If we have a closed contour in the temperature field
c     surrounding the warm core (using a 1 deg K interval), that
c     criterion is satisfied.  For diagnostic purposes, we set the
c     value of num_check_conts to 999 in order to keep searching for
c     all contours surrounding the warm core, and this allows us to
c     get an idea of the "depth" or magnitude of the warm core when
c     the tlastcont and rlastcont values are returned.

      wcore_contour_info%numcont = maxconts
      num_check_conts = 999

      get_last_contour_flag = 'y'
      call check_closed_contour (imax,jmax,ifix,jfix,tmean
     &    ,valid_pt,wcore_mask,wcore_flag,'max',wcore_trkrinfo
     &    ,num_check_conts,wcore_contour_info,get_last_contour_flag
     &    ,tlastcont,rlastcont,icccret)

      if (wcore_flag == 'y') then
        tlastout = tlastcont
        rlastout = rlastcont/0.539638
      else
        tlastout = -999.0
        rlastout = -9999.0
      endif

      if ( verb .ge. 3 ) then
        write (6,115) storm(ist)%tcv_storm_id,gstorm(ist)%gv_gen_date
     &       ,gstorm(ist)%gv_gen_fhr,gstorm(ist)%gv_gen_lat
     &       ,gstorm(ist)%gv_gen_latns,gstorm(ist)%gv_gen_lon
     &       ,gstorm(ist)%gv_gen_lonew,gstorm(ist)%gv_gen_type
     &       ,ifhours(ifh),ifclockmins(ifh)
     &       ,wcore_flag,tlastout,rlastout
        
 115    format (1x,'    wcore: ',a4,1x,i10.10,'_F',i3.3,'_',i3.3,a1
     &       ,'_',i4.4,a1,'_',a3,2x,i4,':',i2.2
     &       ,'  wcore_flag= ',a1,2x,' Temp of last contour(K) = '
     &       ,f7.2,2x,'Radius of last contour(km) = ',f8.2)
      endif

      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_sfc_center (xmeanlon,xmeanlat,clon
     &                  ,clat,ist,ifh,calcparm,xsfclon,xsfclat
     &                  ,maxstorm,igscret)
c
c     ABSTRACT: This subroutine computes a modified lat/lon fix position
c     to use as the input center position for the subroutines that
c     follow which calculate surface-wind related values.  The reason
c     for this is that since we are concerned with the positioning of
c     low-level wind features (e.g., rmax), we want the center position
c     to be based solely on low-level features. We'll use mslp and the
c     min in the sfc wind speed.  If a center fix was unable to be made
c     at this forecast hour for mslp and low-level winds, then we will
c     stick with just using the mean position we got using all the other
c     parameters.
c
c     INPUT:
c     xmeanlon The mean center longitude computed from all the various
c              parameter fixes found in array clon
c     xmeanlat The mean center latitude computed from all the various
c              parameter fixes found in array clat
c     clon     Center longitudes of tracked parms for this storm & ifh
c     clat     Center latitudes of tracked parms for this storm & ifh
c     ist      Index for storm number
c     ifh      Index for forecast hour
c     calcparm Logical; Use this parm's location for this storm or not
c              (if a parameter fix could not be made at this forecast
c              hour, then calcparm is set to false for this time for
c              that parameter).
c     maxstorm Maximum number of storms that can be tracked
c
c     OUTPUT:
c     xsfclon  low-level longitude estimate for this storm & time,
c              computed ideally from mean of mslp & low-level winds.
c     xsfclat  low-level latitude estimate for this storm & time,
c              computed ideally from mean of mslp & low-level winds.
c     igscret  Return code from this subroutine

      USE set_max_parms
      USE verbose_output

      implicit none

      integer  ist,ifh,ipct,igscret,maxstorm
      real     clon(maxstorm,maxtime,maxtp)
      real     clat(maxstorm,maxtime,maxtp)
      real     xmeanlon,xmeanlat
      real     xsfclon,xsfclat,xlonsum,xlatsum
      logical(1) calcparm(maxtp,maxstorm)

      ipct = 0
      xlonsum = 0.0
      xlatsum = 0.0

      ! Do NOT include MSLP for the surface center at this time.
c      if (calcparm(9,ist)) then
c        ipct = ipct + 1
c        xlonsum = xlonsum + clon(ist,ifh,9)
c        xlatsum = xlatsum + clat(ist,ifh,9)
c      endif

      if (calcparm(10,ist)) then
c        ! NOTE: Put double weighting on surface wind center if
c        ! the  tracker was able to find a center for it....
c        ipct = ipct + 2
c        xlonsum = xlonsum + 2.*clon(ist,ifh,10)
c        xlatsum = xlatsum + 2.*clat(ist,ifh,10)
        ! Just use single weighting for the sfc wcirc fix
        ipct = ipct + 1
        xlonsum = xlonsum + clon(ist,ifh,10)
        xlatsum = xlatsum + clat(ist,ifh,10)
      endif

      if (calcparm(11,ist)) then
        ! This is for the sfc vorticity center....
        ipct = ipct + 1
        xlonsum = xlonsum + clon(ist,ifh,11)
        xlatsum = xlatsum + clat(ist,ifh,11)
      endif

      if (ipct > 0) then
        xsfclon = xlonsum / float(ipct)
        xsfclat = xlatsum / float(ipct)
      else

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'!!! In get_fract_wind_cov, CANNOT get modified fix '
          print *,'!!! position because the parameter fixes for mslp'
          print *,'!!! and the sfc winds could not be obtained at this'
          print *,'!!! forecast hour.   ist= ',ist,' ifh= ',ifh
          print *,'!!! We will use the  fixlon and fixlat values for'
          print *,'!!! this forecast hour.'
        endif

        xsfclon = xmeanlon
        xsfclat = xmeanlat
      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'+++ In get_sfc_center, modified fix (mslp + sfc_winds)'
        print *,'+++ position follows: '
        print *,'+++ '
        print *,'+++ mslp:            lon: ',clon(ist,ifh,9),'   lat: '
     &       ,clat(ist,ifh,9)
        print *,'+++ sfc_winds:       lon: ',clon(ist,ifh,10),'   lat: '
     &       ,clat(ist,ifh,10)
        print *,'+++ sfc_vorticity:   lon: ',clon(ist,ifh,11),'   lat: '
     &       ,clat(ist,ifh,11)
        print *,'+++ multi-parm mean: lon: ',xmeanlon,'   lat: '
     &       ,xmeanlat
        print *,'+++ sfc-only mean:   lon: ',xsfclon,'   lat: ',xsfclat
      endif

      return
      end
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_wind_structure (imax,jmax,inp,dx,dy
     &             ,ist,ifh,fixlon,fixlat,xsfclon,xsfclat,valid_pt
     &             ,er_wind,sr_wind,er_vr,sr_vr,er_vt,sr_vt,maxstorm
     &             ,trkrinfo,igwsret)
c       
c     ABSTRACT: This subroutine is a driver subroutine for
c     determining the structure of the low level winds of a cyclone.
c     The algorithm will search out at specified distances from the
c     storm center along arcs in each quadrant of the storm, 
c     evaluating the winds every 15 degrees along the arc.  In each
c     arc, start 7.5 degrees in, then make stops at 22.5, 37.5, 
c     52.5, 67.5, and 82.5 degrees.  At each of those points, we 
c     will bilinearly interpolate the winds to the points along those 
c     arcs.  Then we compute a quadrant average of the wing magnitude,
c     as well as the mean Vt and Vr values.  This will be done
c     twice -- First, for an earth-relative coordinate system, and
c     second, for a storm-relative coordinate system.  For the
c     earth-relative estimates, we will always have 4 earth-relative
c     quadrants: NE, SE, SW and NW.  For the storm-relative estimates,
c     these mean values of the wind will be computed for the same 
c     relative quadrants (front-right, back-right, back-left, front-
c     left, but with respect (positive clockwise) to the
c     direction of storm motion.  
c       
c     LOCAL:
c       numdist   Number of discrete radii at which the winds will
c                 be evaluated
c       rdist     The radii (km) at which winds will be evaluated
c     
c     Arrays:
c       rdist     Radii (km) at which the winds will be evaluated
c       er_wind:  Quadrant winds in earth-relative framework
c       sr_wind:  Quadrant winds in storm-relative framework
c       er_vr:    Quadrant radial winds in earth-relative framework
c       sr_vr:    Quadrant radial winds in storm-relative framework
c       er_vt:    Quadrant tangential winds in earth-relative framework
c       sr_vt:    Quadrant tangential winds in storm-relative framework

      USE inparms; USE phase; USE set_max_parms; USE tracked_parms
      USE def_vitals; USE trig_vals; USE trkrparms
      USE verbose_output

      implicit none

      type (datecard) inp
      type (trackstuff) trkrinfo

      integer, parameter :: numdist=14,numquad=4,num_qtr_azim=6
      integer  imax,jmax,igwsret,ist,ifh,iquad,idist,ibiret1,ibiret2
      integer  igvtret,ipct,maxstorm,iazim,azimuth_ct
      real     fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real     rdist(numdist)
      real     er_wind(numquad,numdist)
      real     sr_wind(numquad,numdist)
      real     er_vr(numquad,numdist)
      real     er_vt(numquad,numdist)
      real     sr_vr(numquad,numdist)
      real     sr_vt(numquad,numdist)
      real     dx,dy,bear,targlat,targlon,xintrp_u,xintrp_v,st_heading
      real     d,cosarg,rlonc,rlatc,rlonb,rlatb,st_heading_rad,degrees
      real     temp_bear,xdist,xsfclon,xsfclat,wmag,wmag_sum
      real     vr,vt,vr_sum,vt_sum
      logical(1) valid_pt(imax,jmax)
c
      data rdist/10.,25.,50.,75.,100.,125.,150.,200.,250.,300.,350.
     &          ,400.,450.,500./

      igwsret = 0

      er_wind = 0.0
      sr_wind = 0.0
      er_vr   = 0.0
      er_vt   = 0.0
      sr_vr   = 0.0
      sr_vt   = 0.0

c     -----------------------------------------------------------------
c     Now determine the angle that the storm took getting from the
c     last position to the current one.  If this is the initial time,
c     use the observed direction of motion from the TC Vitals.  This
c     may not match up with the model storm's initial direction of
c     motion, but it is all we have available to us in order to get
c     a heading estimate for the initial time.  This storm heading
c     information will be used for the storm-relative profiles.
c     -----------------------------------------------------------------

      if (ifh == 1) then

        st_heading = float(storm(ist)%tcv_stdir)

      else

        call calcdist(fixlon(ist,ifh),fixlat(ist,ifh)
     &               ,fixlon(ist,ifh-1),fixlat(ist,ifh-1),xdist,degrees)

        rlonc = (360.-fixlon(ist,ifh)) * dtr
        rlatc = fixlat(ist,ifh) * dtr
        rlonb = (360.-fixlon(ist,ifh-1)) * dtr
        rlatb = fixlat(ist,ifh-1) * dtr
        d     = degrees * dtr

        cosarg = (sin(rlatc)-sin(rlatb)*cos(d))/(sin(d)*cos(rlatb))
        if (cosarg > 1.0)  cosarg = 1
        if (cosarg < -1.0) cosarg = -1

        if (sin(rlonc-rlonb) < 0.0) then
          st_heading_rad = acos(cosarg)
        else
          st_heading_rad = 2*pi - acos(cosarg)
        endif

        st_heading = st_heading_rad / dtr

        if ( verb .ge. 3 ) then
          print *,' '
          print *,' In get_wind_structure, fhr= ',fhreal(ifh)
     &         ,'  ',storm(ist)%tcv_storm_id
     &         ,'  ',storm(ist)%tcv_storm_name
          print '(a25,a23,f9.3)','  In get_wind_structure, '
     &         ,' model storm heading = ',st_heading
          print *,' '
        endif

      endif

c     -----------------------------------------------------------------
c     Get the profiles for the earth-relative coordinate system.
c     Start with NE, then SE, SW, and NW.  First go through 
c     radiusloop, which goes from one radial distance to the next,
c     then do the quadloop, which goes through each quadrant, and 
c     then within each quadrant, the qtr_azimloop goes through for 
c     six points along an arc, spaced 15 degrees apart, starting at
c     7.5 degrees clockwise from the north.
c     -----------------------------------------------------------------

      if ( verb .ge. 3 ) then
        print *,' '
        print *,' *****************************************************'
        print *,'   Wind Structure: distbear bilin interp starts here.'
        print *,' *****************************************************'
        print *,' '
      endif

      radiusloop1: do idist = 1,numdist

        if ( verb .ge. 3 ) then
          print *,'-- ER structure idist= ',idist,' rdist= '
     &           ,rdist(idist)
        endif

        quadloop1: do iquad = 1,4

          if ( verb .ge. 3 ) then
            print *,'     structure iquad= ',iquad
          endif

          wmag_sum = 0.0
          vr_sum   = 0.0
          vt_sum   = 0.0
          azimuth_ct = 0

          ! In each quadrant, run through six points along an
          ! arc and evaluate the winds.

          qtr_azimloop1: do iazim = 1,num_qtr_azim

            bear = ((iquad-1) * 90.) + ((iazim-1) * 15.) + 7.5

            if ( verb .ge. 3 ) then
              print *,'       structure iazim= ',iazim
     &               ,' earth-relative bear= ',bear
            endif

            call distbear (xsfclat,xsfclon,rdist(idist)
     &                    ,bear,targlat,targlon)

            if ( verb .ge. 3 ) then
              print *,' '
              print '(5(a10,f7.2))','  sfclat= ',xsfclat
     &             ,'  sfclon= ',xsfclon
     &             ,'   rdist= ',rdist(idist),' targlat= ',targlat
     &             ,' targlon= ',targlon
              print '(19x,a8,f7.2,35x,a9,f7.2)','sfclon= ',360.-xsfclon
     &             ,'targlon= ',360.-targlon
            endif

            ! NOTE: The 1020 in the call here is just a number/code to
            ! indicate to the subroutine to process sfc winds....

            call bilin_int_uneven (targlat,targlon
     &            ,dx,dy,imax,jmax,trkrinfo,1020,'u',xintrp_u,ibiret1)

            call bilin_int_uneven (targlat,targlon
     &            ,dx,dy,imax,jmax,trkrinfo,1020,'v',xintrp_v,ibiret2)

            if (ibiret1 == 0 .and. ibiret2 == 0) then
              wmag = sqrt (xintrp_u**2 + xintrp_v**2)
              wmag_sum = wmag_sum + wmag
              call getvrvt (xsfclon,xsfclat,targlon,targlat
     &                     ,xintrp_u,xintrp_v,vr
     &                     ,vt,igvtret)
              vr_sum = vr_sum + vr
              vt_sum = vt_sum + vt
              azimuth_ct = azimuth_ct + 1

              if ( verb .ge. 3 ) then
                print '(2x,a21,f8.2,a14,f8.2,2(a11,f8.2))'
     &               ,'   intrp wind speed= '
     &               ,wmag,'    (in kts)= ',wmag*1.9427
     &               ,'  vr(m/s)= ',vr,'  vt(m/s)= ',vt
              endif

            endif

          enddo qtr_azimloop1

          if (azimuth_ct > 0) then
            ! Compute quadrant-azimuthally-averaged winds at 
            ! this distance
            er_wind(iquad,idist) = wmag_sum / float(azimuth_ct)
            er_vr(iquad,idist) =   vr_sum / float(azimuth_ct)
            er_vt(iquad,idist) =   vt_sum / float(azimuth_ct)
          else
            er_wind(iquad,idist) = -999.0
            er_vr(iquad,idist) = -999.0
            er_vt(iquad,idist) = -999.0
          endif

        enddo quadloop1

      enddo radiusloop1

c     -----------------------------------------------------------------
c     Get the profiles for the storm-relative coordinate system.
c     Start with the front-right quadrant and go clockwise through
c     back-right, back-left and front-left.
c     -----------------------------------------------------------------

      radiusloop2: do idist = 1,numdist

        if ( verb .ge. 3 ) then
          print *,'-- SR structure idist= ',idist,' rdist= '
     &           ,rdist(idist)
        endif

        quadloop2: do iquad = 1,4

          if ( verb .ge. 3 ) then
            print *,'     structure iquad= ',iquad
          endif

          wmag_sum = 0.0
          vr_sum   = 0.0
          vt_sum   = 0.0
          azimuth_ct = 0

          qtr_azimloop2: do iazim = 1,num_qtr_azim

c            temp_bear = st_heading + ((iquad-1) * 90.) + 45.

            temp_bear = st_heading + ((iquad-1) * 90.)
     &                + ((iazim-1) * 15.) + 7.5
            bear      = mod(temp_bear,360.)

            if ( verb .ge. 3 ) then
              print *,'       structure iazim= ',iazim
     &               ,' storm-relative bear= ',bear
            endif

            call distbear (xsfclat,xsfclon,rdist(idist)
     &                    ,bear,targlat,targlon)

            ! NOTE: The 1020 in the call here is just a number/code to
            ! indicate to the subroutine to process sfc winds....

            call bilin_int_uneven (targlat,targlon
     &            ,dx,dy,imax,jmax,trkrinfo,1020,'u',xintrp_u,ibiret1)

            call bilin_int_uneven (targlat,targlon
     &            ,dx,dy,imax,jmax,trkrinfo,1020,'v',xintrp_v,ibiret2)

            if (ibiret1 == 0 .and. ibiret2 == 0) then
              wmag = sqrt (xintrp_u**2 + xintrp_v**2)
              wmag_sum = wmag_sum + wmag
              call getvrvt (xsfclon,xsfclat,targlon,targlat
     &                     ,xintrp_u,xintrp_v,vr
     &                     ,vt,igvtret)
              vr_sum = vr_sum + vr
              vt_sum = vt_sum + vt
              azimuth_ct = azimuth_ct + 1

              if ( verb .ge. 3 ) then
                print '(2x,a21,f8.2,a14,f8.2,2(a11,f8.2))'
     &               ,'   intrp wind speed= '
     &               ,wmag,'    (in kts)= ',wmag*1.9427
     &               ,'  vr(m/s)= ',vr,'  vt(m/s)= ',vt
              endif

            endif

          enddo qtr_azimloop2

          if (azimuth_ct > 0) then
            ! Compute quadrant-azimuthally-averaged winds at
            ! this distance
            sr_wind(iquad,idist) = wmag_sum / float(azimuth_ct)
            sr_vr(iquad,idist) =   vr_sum / float(azimuth_ct)
            sr_vt(iquad,idist) =   vt_sum / float(azimuth_ct)
          else
            sr_wind(iquad,idist) = -999.0
            sr_vr(iquad,idist) = -999.0
            sr_vt(iquad,idist) = -999.0
          endif

        enddo quadloop2

      enddo radiusloop2
c
      return
      end

c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_fract_wind_cov (imax,jmax,inp,dx,dy
     &             ,ist,ifh,fixlon,fixlat,xsfclon,xsfclat,valid_pt
     &             ,calcparm,wfract_cov,pdf_ct_bin,pdf_ct_tot,maxstorm
     &             ,trkrinfo,igfwret)
c
c     ABSTRACT: This subroutine determines the fractional areal coverage
c     of winds exceeding various thresholds within specified arcs
c     (e.g., 200 km, 400 km, etc) in each quadrant of a storm.  The bins
c     that are used go as follows: (1) 0-100; (2) 0-200; (3) 0-300;
c     (4) 0-400; (5) 0-500.
c
c     LOCAL:
c       numdist   Number of discrete radii at which the winds will
c                 be evaluated
c       rdist     The radii (km) at which winds will be evaluated
c
c     Arrays:
c       rdist     Radii (km) at which the winds will be evaluated

      USE inparms; USE phase; USE set_max_parms; USE tracked_parms
      USE def_vitals; USE trig_vals; USE grid_bounds; USE level_parms
      USE trkrparms
      USE verbose_output

      implicit none

      type (datecard) inp
      type (trackstuff) trkrinfo

      integer, parameter :: numdist=14,numquad=4,numbin=5,numthresh=3
      real     fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real     rdist(numdist)
      real     wfract_cov(numquad+1,numbin,numthresh)
      real     area_total_quad_bin(numquad,numbin)
      real     area_exceed_quad_bin(numquad,numbin,numthresh)
      real     xintlon,xintlat
      real ::  windthresh(numthresh) = (/17.5,25.74,32.94/)
      real     dx,dy,bear,targlat,targlon,xintrp_u,xintrp_v,st_heading
      real     d,cosarg,rlonc,rlatc,rlonb,rlatb,st_heading_rad,degrees
      real     temp_bear,xdist,conv_ms_knots,vmagkts
      real     rads,ri,dell,vmag,xarea,grdintincr,xsfclon,xsfclat
      real     sum_exceed_area(numbin,numthresh)
      real     sum_total_area(numbin,numthresh)
      integer  pdf_ct_bin(16)
      integer  imax,jmax,igwsret,ist,ifh,iquad,idist,ibiret1,ibiret2
      integer  igfwret,ipct,i,j,numinterp,ixoa,ixaa,iq,ib,it,ii
      integer  jlatfix,ilonfix,npts,ibeg,iend,jbeg,jend,ngridint,ni,nj
      integer  itret,igiret,idistbin,ipdfbin,pdf_ct_tot,maxstorm
      logical(1) calcparm(maxtp,maxstorm)
      logical(1) valid_pt(imax,jmax)
      character  got_pdf*6
      character*2 :: cquad(4) = (/'NE','SE','SW','NW'/)
      character*5 :: cbin(5) = 
     &               (/'0-100','0-200','0-300','0-400','0-500'/)
      character*2 :: cthresh(3) = (/'34','50','64'/)
c
      igfwret = 0
      conv_ms_knots = 1.9427
      rads = 500.0
      ri   = 300.0
      dell = (dx+dy)/2.
      npts = rads/(dtk*dell)

      wfract_cov            = 0.0
      area_total_quad_bin   = 0.0
      area_exceed_quad_bin  = 0.0
      sum_exceed_area       = 0.0
      sum_total_area        = 0.0

c     Call  get_ij_bounds in order to get the dimensions for a smaller
c     subdomain of grid points to search over.

      call get_ij_bounds (npts,0,ri,imax,jmax,dx,dy
     &     ,glatmax,glatmin,glonmax,glonmin,xsfclon,xsfclat
     &     ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if (igiret /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in get_fract_wind_cov from call to '
          print *,'!!! get_ij_bounds, stopping processing for storm'
          print *,'!!! number ',ist
        endif

        igfwret = 92
        return
      endif

      if (ibeg < 1) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In get_fract_wind_cov, the ibeg returned'
            print *,'!!! from get_ij_bounds is < 1, but our gridtype is'
            print *,'!!! global, so we are going to leave it as is and '
            print *,'!!! account for the grid wrapping as we go.'
            print *,' '
          endif

        else

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In get_fract_wind_cov, the ibeg returned'
            print *,'!!! from get_ij_bounds is < 1, and our gridtype is'
            print *,'!!! NOT global, so we are going to abort the '
            print *,'!!! fractional wind coverage processing for'
            print *,'!!! this time.'
            print *,' '
          endif

          igfwret = 94
          return
        endif
      endif

      if (ibeg > imax .or. jbeg > jmax .or. jbeg < 1 .or.
     &    iend < 1 .or. jend < 1) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'ERROR in get_fract_wind_cov calculating ibeg, iend,'
          print *,'jbeg or jend.  ibeg= ',ibeg,' iend= ',iend
          print *,'               jbeg= ',jbeg,' jend= ',jend
          print *,'               imax= ',imax,' jmax= ',jmax
          print *,'fractional wind coverage processing will not be '
          print *,'performed for this time.'
        endif

        igfwret = 94
        return
      endif

      if (iend > imax) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In get_fract_wind_cov, the iend returned'
            print *,'!!! from get_ij_bounds is > imax, but our gridtype'
            print *,'!!! is global, so we are going to leave it as is '
            print *,'!!! and account for the grid wrapping.'
            print *,' '
          endif

        else

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In get_fract_wind_cov, the iend returned'
            print *,'!!! from get_ij_bounds is > imax, and our gridtype'
            print *,'!!! is NOT global, so we will abort the '
            print *,'!!! fractional wind coverage processing for'
            print *,'!!! this time.'
            print *,' '
          endif

          igfwret = 94
          return
        endif
      endif


c     When evaluating the winds at a gridpoint, keep in mind that each
c     gridpoint represents area around it.  There are 2 special cases
c     we need to watch out for.  The first is for cases in which the
c     area of a gridpoint straddles across a distance threshold, so
c     that some of the gridpoint's area is in the "<200" bin, while
c     some is in the "<100" bin.  The other is for the case in which
c     the area of a gridpoint straddles between 2 adjacent quadrants
c     (e.g., a gridpoint exactly to the north of the center would have
c     half its area in the NW quadrant and half in the NE quadrant).
c
c     To properly "partition" and assign gridpoint areas, we need to
c     interpolate the current grid down to a fine resolution.
c
c     This next if statement determines how many times to interpolate
c     the input grid to a smaller grid.  Here are the guidelines that
c     will be used, keeping in mind that we want the final grid spacing
c     to be on the order of between 0.05 and 0.10 degree (finer than
c     0.05 deg is superfluous, and coarser than 0.10 deg is too coarse).
c
c      Original grid size (deg)     # of interps
c     -------------------------    ------------
c           0.8 <= g                    4
c         0.4 <= g < 0.8                3
c         0.2 <= g < 0.4                2
c         0.1 <= g < 0.2                1
c                g < 0.1                0


      if ((dx+dy)/2. >= 0.8) then
        numinterp = 4
      else if ((dx+dy)/2. < 0.8 .and. (dx+dy)/2. >= 0.4) then
        numinterp = 3
      else if ((dx+dy)/2. < 0.4 .and. (dx+dy)/2. >= 0.2) then
        numinterp = 2
      else if ((dx+dy)/2. < 0.2 .and. (dx+dy)/2. >= 0.1) then
        numinterp = 1
      else
        numinterp = 0
      endif

      grdintincr = (dx+dy)/2.
      do i = 1,numinterp
        grdintincr = 0.5 * grdintincr
      enddo

c     Now loop through the points in this subdomain, determine if any
c     are within 500 km of the center, and then determine what quadrant
c     the point is in relative to the center, and then calculate the
c     fractional area coverage for winds.

      pdf_ct_tot = 0
      pdf_ct_bin = 0

      jloop: do j = jbeg,jend
        iloop: do i = ibeg,iend

          if (i > imax) then
            if (trkrinfo%gridtype == 'global') then
              ii = i - imax   ! If wrapping past GM
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: In get_fract_wind_cov, the '
                print *,'!!!    user-requested eastern search boundary'
                print *,'!!!    is beyond the eastern bounds of '
                print *,'!!!    this regional grid.  We will not '
                print *,'!!!    perform the fractional wind coverage' 
                print *,'!!!    processing for this storm & time.'
                print *,'!!!         '
                print *,'!!!   imax of regional grid    = ',imax
                print *,'!!!   User-requested eastern i = ',i
                print *,' '
              endif

              igfwret = 94
              return
            endif    
          else   
            ii = i
          endif   

          if (i < 1) then
            if (trkrinfo%gridtype == 'global') then
              ii = i + imax   ! If wrapping past GM
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i < 1 in get_fract_wind_cov' 
                print *,'!!! for a non-global grid.  We will not '
                print *,'!!! perform the fractional wind coverage'
                print *,'!!! processing for this storm & time.'
                print *,'!!!         '
                print *,'!!!   imax of regional grid    = ',imax
                print *,'!!!   User-requested eastern i = ',i
                print *,' '
              endif

              igfwret = 94
              return
            endif    
          endif

          if (.not. valid_pt(ii,j)) then
            cycle iloop   ! Only an issue for regional grids
          endif

          call calcdist (glon(ii),glat(j),xsfclon,xsfclat,xdist,degrees)

          if (xdist > (rads+(0.75*((dx+dy)/2.)*dtk*cos(glat(j)*dtr)))) 
     &    then

            ! If the distance is greater than "rads" (500 km at initial
            ! writing) plus another 3/4 of a gridpoint, then cycle.
            ! The extra 3/4 of a gridpoint is to allow for the case of
            ! some portion of the area around a gridpoint (whose
            ! center point > 500 km) being within the 500 km arc...
            ! although that is only factored in for grids with spacing
            ! >= 0.1 deg.  For smaller grids, where no interpolation is
            ! done in this subroutine, then the distance to that point
            ! is considered representative and the point is ignored if
            ! it is not less than 500 km from the center.

            cycle iloop

          else

            ! First interpolate the area surrounding each grid point to
            ! get fine resolution of lats & lons for determining how to
            ! partition the area of a gridpoint among quadrants as well
            ! as among distance thresholds.

            vmag = sqrt (u(ii,j,levsfc)**2 + v(ii,j,levsfc)**2)
            vmagkts = vmag * conv_ms_knots

            if (numinterp > 0) then

              grdintincr = ((dx+dy)/2.) / 2**numinterp  ! "grid spacing"
                                                  ! of interpolated grid
              ngridint = (2**numinterp) / 2

              got_pdf = 'notyet'

              njloop: do nj= ngridint,-ngridint,-1

                xintlat = glat(j) + float(nj) * grdintincr

                niloop: do ni= -ngridint,ngridint

                  xintlon = glon(ii) + float(ni) * grdintincr

                  call calcdist (xintlon,xintlat,xsfclon
     &                          ,xsfclat,xdist,degrees)

                  if (xdist <= 350. .and. got_pdf == 'notyet') then
                    ! The got_pdf flag is needed because in these loops
                    ! for niloop & njloop, we are actually looking at
                    ! tiny areas around the same grid point.  So we
                    ! want to make sure we only count each gridpoint
                    ! once.
                    ipdfbin = min((int(vmagkts / 10.) + 1),16)
                    pdf_ct_bin(ipdfbin) = pdf_ct_bin(ipdfbin) + 1
                    pdf_ct_tot = pdf_ct_tot + 1
                    got_pdf = 'got_it'
                  endif

                  if (xdist < 500.) then

                    ! Compute area of this fraction of a grid box
                    xarea = (grdintincr * 111195) *
     &                      (grdintincr * 111195
     &                                  * cos(xintlat * dtr))

                    idistbin = int(xdist / 100.) + 1

                    ! Go through a loop of the bins.  The purpose of
                    ! this is that these "bins" all go from the
                    ! the center out to a specified radius, they are
                    ! NOT 100-km wide bins.  So if we are dealing with
                    ! a point at r = 250 km, then that falls in the
                    ! 0-300 km bin, but it also falls in the 0-400 and
                    ! 0-500 km bins as well.  So we need to run through
                    ! this binloop multiple times to get the area data
                    ! into multiple bins.  Here are the bins & indices:
                    !   1: 0-100 km
                    !   2: 0-200 km
                    !   3: 0-300 km
                    !   4: 0-400 km
                    !   5: 0-500 km

                    binloop: do ib = idistbin,numbin

                      if (xintlon >= xsfclon .and.
     &                    xintlat >= xsfclat) then

                        ! NE quadrant

                        area_total_quad_bin(1,ib) =
     &                            area_total_quad_bin(1,ib) + xarea
                        if (vmag > windthresh(1)) then
                          area_exceed_quad_bin(1,ib,1) =
     &                          area_exceed_quad_bin(1,ib,1) + xarea
                        endif
                        if (vmag > windthresh(2)) then
                          area_exceed_quad_bin(1,ib,2) =
     &                          area_exceed_quad_bin(1,ib,2) + xarea
                        endif
                        if (vmag > windthresh(3)) then
                          area_exceed_quad_bin(1,ib,3) =
     &                          area_exceed_quad_bin(1,ib,3) + xarea
                        endif

                      else if (xintlon >= xsfclon .and.
     &                         xintlat < xsfclat) then

                        ! SE quadrant

                        area_total_quad_bin(2,ib) =
     &                             area_total_quad_bin(2,ib) + xarea
                        if (vmag > windthresh(1)) then
                          area_exceed_quad_bin(2,ib,1) =
     &                          area_exceed_quad_bin(2,ib,1) + xarea
                        endif
                        if (vmag > windthresh(2)) then
                          area_exceed_quad_bin(2,ib,2) =
     &                          area_exceed_quad_bin(2,ib,2) + xarea
                        endif
                        if (vmag > windthresh(3)) then
                          area_exceed_quad_bin(2,ib,3) =
     &                          area_exceed_quad_bin(2,ib,3) + xarea
                        endif

                      else if (xintlon < xsfclon .and.
     &                         xintlat < xsfclat) then

                        ! SW quadrant

                        area_total_quad_bin(3,ib) =
     &                             area_total_quad_bin(3,ib) + xarea
                        if (vmag > windthresh(1)) then
                          area_exceed_quad_bin(3,ib,1) =
     &                          area_exceed_quad_bin(3,ib,1) + xarea
                        endif
                        if (vmag > windthresh(2)) then
                          area_exceed_quad_bin(3,ib,2) =
     &                          area_exceed_quad_bin(3,ib,2) + xarea
                        endif
                        if (vmag > windthresh(3)) then
                          area_exceed_quad_bin(3,ib,3) =
     &                          area_exceed_quad_bin(3,ib,3) + xarea
                        endif

                      else if (xintlon < xsfclon .and.
     &                         xintlat >= xsfclat) then

                        ! NW quadrant

                        area_total_quad_bin(4,ib) =
     &                             area_total_quad_bin(4,ib) + xarea
                        if (vmag > windthresh(1)) then
                          area_exceed_quad_bin(4,ib,1) =
     &                          area_exceed_quad_bin(4,ib,1) + xarea
                        endif
                        if (vmag > windthresh(2)) then
                          area_exceed_quad_bin(4,ib,2) =
     &                          area_exceed_quad_bin(4,ib,2) + xarea
                        endif
                        if (vmag > windthresh(3)) then
                          area_exceed_quad_bin(4,ib,3) =
     &                          area_exceed_quad_bin(4,ib,3) + xarea
                        endif

                      endif

                    enddo binloop

                  endif

                enddo niloop

              enddo njloop

            else

              ! In this else statement is the case for a grid whose
              ! resolution is already fine enough that we don't need
              ! to interpolate any further.  For example, we will have
              ! the H*Wind data on a 0.05 degree grid, so that's already
              ! fine enough.

              call calcdist (glon(ii),glat(j),xsfclon,xsfclat
     &                      ,xdist,degrees)

              if (xdist <= 350.) then
                ipdfbin = min((int(vmagkts / 10.) + 1),16)
                pdf_ct_bin(ipdfbin) = pdf_ct_bin(ipdfbin) + 1
                pdf_ct_tot = pdf_ct_tot + 1
              endif

              if (xdist < 500.) then

                ! Compute area of this grid box
                xarea = (dy * 111195) *
     &                  (dx * 111195 * cos(glat(j) * dtr))

                idistbin = int(xdist / 100.) + 1

                ! Why the binloop2?  See explanation above in the "if"
                ! part of this if-then block, where binloop is.

                binloop2: do ib = idistbin,numbin

                  if (glon(ii) >= xsfclon .and.
     &                glat(j) >= xsfclat) then

                    ! NE quadrant

                    area_total_quad_bin(1,ib) =
     &                         area_total_quad_bin(1,ib) + xarea
                    if (vmag > windthresh(1)) then
                      area_exceed_quad_bin(1,ib,1) =
     &                      area_exceed_quad_bin(1,ib,1) + xarea
                    endif
                    if (vmag > windthresh(2)) then
                      area_exceed_quad_bin(1,ib,2) =
     &                      area_exceed_quad_bin(1,ib,2) + xarea
                    endif
                    if (vmag > windthresh(3)) then
                      area_exceed_quad_bin(1,ib,3) =
     &                      area_exceed_quad_bin(1,ib,3) + xarea
                    endif

                  else if (glon(ii) >= xsfclon .and.
     &                     glat(j) <  xsfclat) then

                    ! SE quadrant

                    area_total_quad_bin(2,ib) =
     &                         area_total_quad_bin(2,ib) + xarea
                    if (vmag > windthresh(1)) then
                      area_exceed_quad_bin(2,ib,1) =
     &                      area_exceed_quad_bin(2,ib,1) + xarea
                    endif
                    if (vmag > windthresh(2)) then
                      area_exceed_quad_bin(2,ib,2) =
     &                      area_exceed_quad_bin(2,ib,2) + xarea
                    endif
                    if (vmag > windthresh(3)) then
                      area_exceed_quad_bin(2,ib,3) =
     &                      area_exceed_quad_bin(2,ib,3) + xarea
                    endif

                  else if (glon(ii) < xsfclon .and.
     &                     glat(j) < xsfclat) then

                    ! SW quadrant

                    area_total_quad_bin(3,ib) =
     &                         area_total_quad_bin(3,ib) + xarea
                    if (vmag > windthresh(1)) then
                      area_exceed_quad_bin(3,ib,1) =
     &                      area_exceed_quad_bin(3,ib,1) + xarea
                    endif
                    if (vmag > windthresh(2)) then
                      area_exceed_quad_bin(3,ib,2) =
     &                      area_exceed_quad_bin(3,ib,2) + xarea
                    endif
                    if (vmag > windthresh(3)) then
                      area_exceed_quad_bin(3,ib,3) =
     &                      area_exceed_quad_bin(3,ib,3) + xarea
                    endif

                  else if (glon(ii) < xsfclon .and.
     &                     glat(j) >= xsfclat) then

                    ! NW quadrant

                    area_total_quad_bin(4,ib) =
     &                         area_total_quad_bin(4,ib) + xarea
                    if (vmag > windthresh(1)) then
                      area_exceed_quad_bin(4,ib,1) =
     &                      area_exceed_quad_bin(4,ib,1) + xarea
                    endif
                    if (vmag > windthresh(2)) then
                      area_exceed_quad_bin(4,ib,2) =
     &                      area_exceed_quad_bin(4,ib,2) + xarea
                    endif
                    if (vmag > windthresh(3)) then
                      area_exceed_quad_bin(4,ib,3) =
     &                      area_exceed_quad_bin(4,ib,3) + xarea
                    endif

                  endif

                enddo binloop2

              endif

            endif

          endif

        enddo iloop

      enddo jloop

c     -------------------------------------------------
c     Now compute the fractional wind coverage for all
c     the different quadrants, bins and thresholds...
c     -------------------------------------------------

      if ( verb .ge. 3 ) then
        write (6,109) '                                 '
     &       ,'                                     '
     &       ,'                '
        write (6,109) ' Quadrant   Bin    Wind_Thresh   '
     &       ,'Fract_coverage (%)      Area_exceeded'
     &       ,'      Area_total'
        write (6,109) ' --------   ---    -----------   '
     &       ,'------------------      -------------'
     &       ,'      ----------'
        write (6,109) '                                 '
     &       ,'                                     '
     &       ,'                '
        
        do iq = 1,numquad
          do ib = 1,numbin
            do it = 1,numthresh
              wfract_cov(iq,ib,it) = area_exceed_quad_bin(iq,ib,it) /
     &             area_total_quad_bin(iq,ib)
              write (6,117) cquad(iq),cbin(ib),cthresh(it)
     &             ,wfract_cov(iq,ib,it)*100.0
     &             ,area_exceed_quad_bin(iq,ib,it)
     &             ,area_total_quad_bin(iq,ib)
            enddo
          enddo
        enddo
      endif


  109 format (1x,a33,a37,a16)
  117 format (5x,a2,5x,a5,7x,a2,13x,f6.2,10x,f16.1,2x,f16.1)

c     -------------------------------------------------
c     Now compute the fractional wind coverage for all
c     the different bins and thresholds, but for the
c     entire "disc" of the storm, that is, summing all
c     quadrants together.
c     -------------------------------------------------

      do it = 1,numthresh
        do ib = 1,numbin
          do iq = 1,numquad
            sum_total_area(ib,it) = sum_total_area(ib,it)
     &                            + area_total_quad_bin(iq,ib)
            sum_exceed_area(ib,it) = sum_exceed_area(ib,it)
     &                             + area_exceed_quad_bin(iq,ib,it)
          enddo
          wfract_cov(5,ib,it) = sum_exceed_area(ib,it)
     &                        / sum_total_area(ib,it)
        enddo
      enddo

      if ( verb .ge. 3 ) then
        do ib = 1,numbin
          do it = 1,numthresh
            write (6,117) 'TT',cbin(ib),cthresh(it)
     &           ,wfract_cov(5,ib,it)*100.0
     &           ,sum_exceed_area(ib,it)
     &           ,sum_total_area(ib,it)
          enddo
        enddo
      endif

      return
      end

c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_ike_stats (imax,jmax,inp,dx,dy,ist,ifh
     &               ,fixlon,fixlat,xsfclon,xsfclat,valid_pt,calcparm
     &               ,ike,sdp,wdp,maxstorm,trkrinfo,igisret)
c
c     ABSTRACT: This subroutine computes the Integrated Kinetic Energy
c     (IKE) and Storm Surge Damage Potential (SDP) values, based on
c     Powell (BAMS, 2007).  At this time, we are only computing the IKE
c     values for TS threshold (17.5 m/s) and above.  We are not yet
c     computing wind damage potential (WDP) since, per Mark Powell
c     (4/2008), he is currently re-formulating an algorithm for it.
c
c     LOCAL:
c
c     Arrays:
c
c     ike   Integrated kinetic energy:
c           ike(1) = IKE_10m/s  (storm energy)
c           ike(2) = IKE_18m/s  (IKE_ts, tropical storm)
c           ike(3) = IKE_33m/s  (IKE_h,  hurricane)
c           ike(4) = IKE_25_40 m/s  (Not currently computed)
c           ike(5) = IKE_41_54 m/s  (Not currently computed)
c           ike(6) = IKE_55 m/s     (Not currently computed)
c
c     sdp   Storm surge damage potential

      USE inparms; USE phase; USE set_max_parms; USE tracked_parms
      USE def_vitals; USE trig_vals; USE grid_bounds; USE level_parms
      USE trkrparms
      USE verbose_output

      implicit none

      type (datecard) inp
      type (trackstuff) trkrinfo

      integer, parameter :: numdist=14,numquad=4
      integer  npts,ipct,igisret,imax,jmax,ist,ifh,ilonfix,jlatfix
      integer  ibeg,jbeg,iend,jend,igiret,i,j,maxstorm,ii
      real     fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real     ike(max_ike_cats)
      real     dx,dy,degrees,rads,ri,dell,xdist,vmag,xarea
      real     xsfclon,xsfclat,sdp,wdp
      logical(1) calcparm(maxtp,maxstorm)
      logical(1) valid_pt(imax,jmax)
c
      igisret = 0
      ike = 0.0
      sdp = 0.0
      wdp = 0.0

      rads = 400.0
      ri   = 300.0
      dell = (dx+dy)/2.
      npts = rads/(dtk*dell)

c     Call get_ij_bounds in order to get the dimensions for a smaller
c     subdomain of grid points to search over.

      call get_ij_bounds (npts,0,ri,imax,jmax,dx,dy
     &     ,glatmax,glatmin,glonmax,glonmin,xsfclon,xsfclat
     &     ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if (igiret /= 0) then
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in get_ike_stats from call to '
          print *,'!!! get_ij_bounds, STOPPING processing for storm '
          print *,'!!! number ',ist
        endif
        
        igisret = 92
        return
      endif

      if (ibeg < 1) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In get_ike_stats, the ibeg returned'
            print *,'!!! from get_ij_bounds is < 1, but our gridtype is'
            print *,'!!! global, so we are going to leave it as is and '
            print *,'!!! account for the grid wrapping as we go.'
            print *,' '
          endif

        else

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In get_ike_stats, the ibeg returned'
            print *,'!!! from get_ij_bounds is < 1, and our gridtype is'
            print *,'!!! NOT global, so we are going to abort the '
            print *,'!!! fractional wind coverage processing for'
            print *,'!!! this time.'
            print *,' '
          endif

          igisret = 94
          return
        endif
      endif
          
      if (ibeg > imax .or. jbeg > jmax .or. jbeg < 1 .or.
     &     iend < 1 .or. jend < 1) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'ERROR in get_ike_stats calculating ibeg, iend,'
          print *,'jbeg or jend.  ibeg= ',ibeg,' iend= ',iend
          print *,'               jbeg= ',jbeg,' jend= ',jend
          print *,'               imax= ',imax,' jmax= ',jmax
          print *,'fractional wind coverage processing will not be '
          print *,'performed for this time.'
        endif

        igisret = 94
        return
      endif
          
      if (iend > imax) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In get_ike_stats, the iend returned'
            print *,'!!! from get_ij_bounds is > imax, but our gridtype'
            print *,'!!! is global, so we are going to leave it as is '
            print *,'!!! and account for the grid wrapping.'
            print *,' '
          endif

        else

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In get_ike_stats, the iend returned'
            print *,'!!! from get_ij_bounds is > imax, and our gridtype'
            print *,'!!! is NOT global, so we will abort the '
            print *,'!!! fractional wind coverage processing for'
            print *,'!!! this time.'
            print *,' '
          endif

          igisret = 94
          return
        endif
      endif

c     Search a grid of points near the storm center, evaluate if the
c     storm is within the "rads" distance threshold.  If so, compute
c     the IKE values for all applicable thresholds (10, 18, 33 m/s).

      do j = jbeg,jend
        do i = ibeg,iend

          if (i > imax) then
            if (trkrinfo%gridtype == 'global') then
              ii = i - imax   ! If wrapping past GM
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: In get_ike_stats, the '
                print *,'!!!    user-requested eastern search boundary'
                print *,'!!!    is beyond the eastern bounds of '
                print *,'!!!    this regional grid.  We will not '
                print *,'!!!    perform the ike stats'
                print *,'!!!    processing for this storm & time.'
                print *,'!!!         '
                print *,'!!!   imax of regional grid    = ',imax
                print *,'!!!   User-requested eastern i = ',i
                print *,' '
              endif

              igisret = 94
              return
            endif
          else
            ii = i
          endif
              
          if (i < 1) then
            if (trkrinfo%gridtype == 'global') then
              ii = i + imax   ! If wrapping past GM
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i < 1 in get_ike_stats'
                print *,'!!! for a non-global grid.  We will not '
                print *,'!!! perform the ike stats'
                print *,'!!! processing for this storm & time.'
                print *,'!!!         '
                print *,'!!!   imax of regional grid    = ',imax
                print *,'!!!   User-requested eastern i = ',i
                print *,' '
              endif

              igisret = 94
              return
            endif
          endif

          if (.not. valid_pt(ii,j)) then
            cycle    ! Only an issue for regional grids
          endif

          call calcdist (glon(ii),glat(j),xsfclon,xsfclat,xdist,degrees)

          if (xdist > rads) then
            cycle
          else

            vmag = sqrt(u(ii,j,levsfc)**2 + v(ii,j,levsfc)**2)

            if (vmag > 10.0) then
              ! Add gridpoint to IKE_10.  Compute area first...
              xarea = (dy * 111195) *
     &                (dx * 111195 * cos(glat(j) * dtr))
              ike(1) = ike(1) + (0.5 * (vmag**2) * xarea)
            endif

            if (vmag > 18.0) then
              ! Add gridpoint to IKE_ts. Area already computed for 10
              ike(2) = ike(2) + (0.5 * (vmag**2) * xarea)
            endif

            if (vmag > 33.0) then
              ! Add gridpoint to IKE_h. Area already computed for 10
              ike(3) = ike(3) + (0.5 * (vmag**2) * xarea)
            endif

          endif

        enddo
      enddo

      ike(1) = ike(1) * 1.e-12      ! Convert from J to TJ
      ike(2) = ike(2) * 1.e-12      ! Convert from J to TJ
      ike(3) = ike(3) * 1.e-12      ! Convert from J to TJ

c     Compute the storm surge damage potential (sdp)

      if (ike(2) >= 0.0) then
        sdp = 0.676 + (0.43 * sqrt(ike(2)))
     &      - (0.0176 * ((sqrt(ike(2)) - 6.5)**2) )
      else
        sdp = -99.0
      endif

c     Print out the IKE and SDP statistics...

      if ( verb .ge. 3 ) then
        print *,' IKE_10 (storm energy)   = ',ike(1)
        print *,' IKE_TS (tropical storm) = ',ike(2)
        print *,' IKE_H  (hurricane)      = ',ike(3)
        print *,' SDP                     = ',sdp
      endif

      return
      end

c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine distbear (xlatin,xlonin,dist,bear,xlatt,xlont)
c
c     ABSTRACT: Given an origin at latitude, longitude=xlato,xlono,
c     this subroutine will locate a target point at a distance dist in
c     km or nautical miles (depends on what you use for "rad_earth..."
c     below), at bearing bear (degrees clockwise from north).
c     Returns latitude xlatt and longitude xlont of target point.
c
c     *** NOTE ***
c     This subroutine was written to handle input lats & lons as this:
c     All latitudes are in degrees, north positive and south negative.
c     All longitudes are in degrees, west positive and east negative.
c     *** **** ***
c
c     However, for the longitudes, the rest of the  tracker uses all
c     0-360 longitudes.  Therefore, we need to convert the input lons
c     and then once again convert the lons that are returned back to
c     the calling routine.
c
c     NOTE-- When origin is at north or south pole, bearing is no
c     longer measured from north.  Instead, bearing is measured
c     clockwise from the longitude opposite that specified in xlono.
c     Example-- if xlato=90., xlono=80., the opposite longitude is
c     -100 (100 East), and a target at bearing 30. will lie on the
c     -70. (70 East) meridian.
c
c     AUTHOR: The core of this subroutine was written by Albion
c             Taylor, another NOAA employee, in 1981.
c
      USE trig_vals

      implicit none
c
      real, parameter :: rad_earth_nm = 3440.170  ! radius of earth
      real, parameter :: rad_earth_km = 6372.797  ! radius of earth
      real     xlato,xlono,dist,bear,xlatt,xlont,xlatin,xlonin
      real     cdist,sdist,clato,slato,clono,slono,cbear,sbear
      real     z,y,x,r,xlattz,xlontz,ddist,dbear,dxlato,dxlono
c
      xlato = xlatin
      xlono = xlonin

cstr   print *,' '
cstr   print *,'+++ At top of distbear....'
cstr   print '(a6,f7.2,a3,f7.2,a9,f7.2)','xlon= ',xlono,'E  ',360.-xlono
cstr  &                                 ,'W   xlat=',xlato
cstr   print '(a6,f7.2,a8,f7.2)','dist= ',dist,'  bear= ',bear

      if (xlono > 180.) then
        ! Longitude input for this subroutine must be positive west
        xlono = 360. - xlono
      else
        ! Longitude input for this subroutine must be negative east
        xlono = -1. * xlono
      endif

cstr      print '(a31,a8,f8.2)','After conversion for distbear, '
cstr     &                     ,' xlono= ',xlono

      ddist  = dist
      dbear  = bear
      dxlato = xlato
      dxlono = xlono

      cdist = cos(ddist/rad_earth_km)
      sdist = sin(ddist/rad_earth_km)
      clato = cos(dtr*dxlato)
      slato = sin(dtr*dxlato)

cstr      print *,'cdist= ',cdist,' sdist= ',sdist,' clato= ',clato
cstr     &       ,' slato= ',slato

      clono = cos(dtr*dxlono)
      slono = sin(dtr*dxlono)

cstr      print *,'dxlono= ',dxlono,' clono= ',clono
cstr     &       ,' slono= ',slono

      cbear = cos(dtr*dbear)
      sbear = sin(dtr*dbear)

cstr      print *,'cbear= ',cbear,' sbear= ',sbear

      z=cdist*slato + clato*sdist*cbear
      y=clato*clono*cdist + sdist*(slono*sbear - slato*clono*cbear)
      x=clato*slono*cdist - sdist*(clono*sbear + slato*slono*cbear)

cstr      print *,'z= ',z,' y= ',y,' x= ',x

      r = sqrt(x**2 + y**2)

cstr      print *,'r = sqrt(x**2 + y**2) = ',r

      xlattz = atan2(z,r)/dtr

cstr      print *,'xlattz = datan2(z,r)/dtr = ',xlattz

      xlatt = xlattz

      if (r <= 0.) go to 20

      xlontz = atan2(x,y)/dtr

cstr      print *,'xlontz = atan2(x,y)/dtr = ',xlontz

c      xlont = xlontz

      ! Return the target longitude back to the calling routine
      ! as a 0-360 positive east longitude....

      xlont = mod(360.-xlontz,360.)

c      xlont = mod(360.+xlontz,360.)

cstr      print *,' '
cstr      print *,'At end of distbear....'
cstr      print '(a6,f7.2,a3,f7.2,a9,f7.2)','xlont= ',xlont,'E  '
cstr                            ,360.-xlont,'W   xlatt=',xlatt

      return
   20 xlont=0.
c
      return
      end

c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine bilin_int_uneven (targlat,targlon,dx,dy
     &              ,imax,jmax,trkrinfo,level,cparm,xintrp_val,ibiret)
c
c     ABSTRACT: This subroutine performs a bilinear interpolation to get
c     a data value at a given lat/lon that may be anywhere within a box
c     defined by the four surrouding grid points.  In the diagram below,
c     remember that for our grids we are using in the  tracker, the
c     latitude index starts at the north pole and increases southward.
c     The point "X" indicates the target lat/lon location of the value
c     for which we are  bilinearly interpolating.  The values to and ta
c     below are ratios that determine how geographically close the
c     target location is to the point of origin (pt.1 (i,j)) in terms
c     of both longitude (to) and latitude (ta).
c
c
c        pt.1                pt.2
c        (i,j)              (i+1,j)
c
c
c
c                       X
c
c        pt.4                pt.3
c        (i,j+1)            (i+1,j+1)
c

      USE grid_bounds; USE tracked_parms; USE level_parms
      USE trkrparms
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo

      character  cparm*1
      real       targlat,targlon,xintrp_val,dx,dy
      real       to,ta,d1,d2,d3,d4,z,eastlon
      integer    ie,iw,jn,js,ibiret,imax,jmax,level,nlev

      ibiret = 0

c     --------------------------------------------------------------
c     For the latitudes and longitudes surrounding our target
c     lat/lon location, convert the lat/lon values into i- and
c     j-indices.
c     --------------------------------------------------------------

c     Find the j-indices for the points just to the north and the
c     south of targlat....

      if (targlat >= 0.0) then
        ! For a northern hemisphere storm, jn is the j-index for the
        ! point just to the *NORTH* (poleward) of targlat.
        jn = int((glatmax - targlat)/dy + 1.)
        js = jn + 1
      else
        ! For a southern hemisphere storm, js is the j-index for the
        ! point just to the *SOUTH* (poleward) of targlat.
        js = ceiling((glatmax - targlat)/dy + 1.)
        jn = js - 1
      endif

      ! Check to make sure that points are not being requested beyond
      ! the northern or southern boundaries of the grid.  This is most
      ! likely to happen for a smaller, regional grid.

      if (jn > jmax .or. js > jmax) then
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR: jmax exceeded in subroutine  '
          print *,'!!! bilin_int_uneven.  Returning to calling '
          print *,'!!! routine after assigning wind value of -99.'
          print *,'!!! jn= ',jn,' js= ',js,' jmax= ',jmax
          print *,' '
        endif
        xintrp_val = -999.0 
        ibiret = 85
        return
      endif

      if (jn < 1 .or. js < 1) then
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR: jn < 0 or js < 0 in subroutine  '
          print *,'!!! bilin_int_uneven.  Returning to calling '
          print *,'!!! routine after assigning wind value of -99.'
          print *,'!!! jn= ',jn,' js= ',js,' jmax= ',jmax
          print *,' '
        endif
        xintrp_val = -999.0
        ibiret = 85
        return
      endif

c     Find the i-indices for the points just to the east and the
c     west of targlon....

      ie = int((targlon - glonmin)/dx + 2.)
      iw = ie - 1

      ! Check for GM wrapping.  Check ie to see if it is between the 
      ! most eastward gridpoint and the GM (i.e., on a 1-deg global
      ! grid (360x181), it would be if targlon was between 359.0 (i=360)
      ! and the GM (i=1, not i=361)).  Similarly then, if we adjust ie 
      ! to then be 1, then we have a problem with iw, 
      ! since iw = 1 - 1 = 0.

      if (ie > imax) then
        if (trkrinfo%gridtype == 'global') then 
          ie = ie - imax
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: ie > imax in subroutine  '
            print *,'!!! bilin_int_uneven for a non-global grid.  '
            print *,'!!! Returning to calling routine after '
            print *,'!!! assigning missing wind value of -99.'
            print *,'!!! ie= ',ie,' imax= ',imax
            print *,' '
          endif
          xintrp_val = -999.0
          ibiret = 85
          return
        endif    
      endif

      if (iw < 1) then
        if (trkrinfo%gridtype == 'global') then
          iw = iw + imax
        else
          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: iw < 1 in subroutine  bilin_int_uneven'
            print *,'!!! for a non-global grid.  Returning to calling '
            print *,'!!! routine after assigning missing wind value '
            print *,'!!! of -99.   iw= ',iw
            print *,' '
          endif
          xintrp_val = -999.0
          ibiret = 85
          return
        endif    
      endif

ctmwc      if ( verb .ge. 3 ) then
ctmwc        print *,'  +++ Interpolating winds for cparm= ',cparm
ctmwc        print '(6x,4(a4,i3))','jn= ',jn,' js= ',js,' iw= ',iw,' ie= ',ie
ctmwc      endif

c     ----------------------------------------------------------------
c     Calculate the longitude (to) and latitude (ta) location ratios.
c     Check for GM wrapping, as we can run into a problem here if 
c     interpolating for points that are just west of the GM, since we
c     would be interpolating using values of longitude just west of
c     GM (say, glon(iw)=359.5) and the GM (glon(ie) = 0.0).  This 
c     makes for an incorrect "to" ratio below, with 0-359.5 in the 
c     denominator.  We have to account for this....
c     ----------------------------------------------------------------

      if (glon(iw) > 300.0 .and. 
     &   (glon(ie) < 10. .and. glon(ie) >= 0.)) then
        eastlon = 360. - glon(ie)
      else
        eastlon = glon(ie)
      endif

ctmwc      if ( verb .ge. 3 ) then
ctmwc        print *,'glat(js)= ',glat(js),' glat(jn)= ',glat(jn)
ctmwc      endif

      to = (targlon - glon(iw)) / (eastlon - glon(iw))
      ta = (targlat - glat(jn)) / (glat(js) - glat(jn))

c     --------------------------------------------------------------
c     Copy the data values at the 4 known points into simple scalar
c     variables
c     --------------------------------------------------------------

      select case (level)
        case (850);  nlev = nlev850  ! check module level_parms for
        case (700);  nlev = nlev700  ! the values of these....
        case (500);  nlev = nlev500
        case (1020); nlev = levsfc
      end select

      if (cparm == 'u') then
        d1 = u(iw,jn,nlev)
        d2 = u(ie,jn,nlev)
        d3 = u(ie,js,nlev)
        d4 = u(iw,js,nlev)
      else if (cparm == 'v') then
        d1 = v(iw,jn,nlev)
        d2 = v(ie,jn,nlev)
        d3 = v(ie,js,nlev)
        d4 = v(iw,js,nlev)
      else if (cparm == 'm') then
        d1 = lsmask(iw,jn)
        d2 = lsmask(ie,jn)
        d3 = lsmask(ie,js)
        d4 = lsmask(iw,js)
      else

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in bilin_int_uneven.'
          print *,'!!! Input cparm not recognized.'
          print *,'!!! cparm= ',cparm
          print *,'!!! EXITING....'
        endif

        stop 95
      endif

      z = 1.9427

cstr      print '(2x,4(a4,f8.2))','  d1= ',d1*z,'  d2= ',d2*z
cstr     &                       ,'  d3= ',d3*z,' d4= ',d4*z

c     -------------------------------------------------------------
c     Compute the interpolated value
c     -------------------------------------------------------------

      xintrp_val = (1.-to) * (1.-ta) * d1
     &           + to * (1.-ta) * d2
     &           + to * ta * d3
     &           + (1.-to) * ta * d4

cstr     print '(2x,2(a11,f8.2))','   xintrp= ',xintrp_val,' (in kts)= '
cstr    &                     ,xintrp_val*z
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine sort_storms_by_pressure (gridprs,ifh,maxstorm,sortindex
     &                                   ,issret)
c
c     ABSTRACT: This subroutine  sorts storms by mslp.  It is called by
c     subroutine  tracker just before the loop for "stormloop" is done
c     for all the storms at a particular forecast hour.  It is only
c     called for the "midlat" and "tcgen" cases.  The end result of
c     this sort is an array (prsindex) that contains the indeces of
c     the storms, arranged from lowest pressure to highest (and note
c     that the "undefined" storms have a pressure of 9999.99 mb and
c     thus get sorted to the bottom of the array).  The purpose of
c     doing this is so that we track the most intense storms first.
c     Why go to the trouble?  Imagine a scenario in which we are
c     tracking a complex system in which there are 2 low pressure
c     centers.  Let's say that one is becoming dominant and
c     intensifying, while the other is weakening.  Now, let's assume
c     that the weakening one eventually gets absorbed into the
c     stronger, more dominant low.  Now we only have 1 low, but if in
c     the  tracker stormloop, we first process the data for the
c     weakening low, we will attribute the track to that storm, and
c     then when we get to the point in the loop where we are trying
c     to get the track for the stronger storm, we will (erroneously)
c     stop the tracking for that storm since the storm center has
c     already been attributed to the weaker storm.  But by using this
c     subroutine, we will track the stronger storm first, and thus
c     avoid this problem.
c
c     NOTE: The pressures used in the  sort are those obtained at the
c     previous forecast hour.  At forecast hour = 0, just use the
c     values as they were input to this routine, since they were
c     found in first_ges_center from strongest to weakest already.
c
c     INPUT:
c     gridprs  real array of storm mslp values
c     ifh      integer index for the current forecast hour
c     maxstorm max num of storms that can be handled in this run
c
c     OUTPUT:
c     sortindex contains a sorted array of indeces.  The  orders
c               sort routine does NOT rearrange the data.  Rather, it
c               returns this array of sorted indeces which point to
c               the correct order of data values in the data array.
c     issret    return code from this subroutine
c
      USE set_max_parms
      USE verbose_output

      real, allocatable :: iwork(:)
      real      gridprs(maxstorm,maxtime)
      integer   ifh,maxstorm
      integer   sortindex(maxstorm)
      integer, parameter  :: dp = selected_real_kind(12, 60)
      real (dp), allocatable ::  prstemp(:)
c
      allocate (prstemp(maxstorm),stat=iva)
      allocate (iwork(maxstorm),stat=iwa)
      if (iva /= 0 .or. iwa /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in sub sort_storms_by_pressure allocating'
          print *,'!!! prstemp or iwork arrays: '
          print *,'!!! iva= ',iva,' iwa= ',iwa
        endif

        STOP 94
        return
      endif

      if (ifh > 1) then

c        print *,' '
c        print *,'--- Before  sort, original prs values follow:'
c        print *,' '

        do ist = 1,maxstorm
          prstemp(ist) = gridprs(ist,ifh-1)
c           write (6,81) ist,prstemp(ist)/100.0
        enddo

        imode = 2
        sortindex = 0
        call qsort (prstemp,sortindex,maxstorm)

ccccc        call orders (imode,iwork,prstemp,sortindex,maxstorm,1,8,1)
ccccc        call orders_4byte (imode,iwork,prstemp,sortindex,maxstorm,1,8,1)

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'+++ Pressure-sorted storm list:'
          print *,' '

          do ist = 1,maxstorm
            if (prstemp(sortindex(ist))/100.0 < 9999.0) then
              write (6,82) ist,sortindex(ist)
     &             ,prstemp(sortindex(ist))/100.0
            endif
          enddo

 81       format (1x,'ist= ',i5,' Original (unsorted) prstemp= ',f7.2)
 82       format (1x,'ist= ',i5,'  sortindex(ist)= ',i5
     &           ,' prstemp= ',f7.2)
        endif

      else
        do ist = 1,maxstorm
          sortindex(ist) = ist
        enddo
      endif

      deallocate (prstemp); deallocate (iwork)
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine getvrvt (centlon,centlat,xlon,xlat
     &                   ,udat,vdat,vr,vt,igvtret)
c
c     ABSTRACT: This subroutine takes as input a u-wind and v-wind value
c     at an input (xlon,xlat) location and returns the tangential and
c     radial wind components relative to the input center lat/lon 
c     position (centlon,centlat).  The only trick to this whole 
c     subroutine is figuring out the angle from the center point to the
c     data point, and we do this by creating a triangle with the leg 
c     from the center point to the data point being the hypotenuse.
c
c     NOTE: All longitudes must be in positive degrees east (0-360) !!!
c
c     INPUT:
c     centlon  Longitude of center point
c     centlat  Latitude  of center point
c     xlon     Longitude of pt at which vr & vt will be computed
c     xlat     Latitude  of pt at which vr & vt will be computed
c     udat     u-value of wind at the point (xlon,xlat) 
c     vdat     v-value of wind at the point (xlon,xlat) 
c
c     OUTPUT:
c     vr      Radial wind component at (xlon,xlat) wrt (centlon,centlat)
c     vt      Tang   wind component at (xlon,xlat) wrt (centlon,centlat)
c     igvtret Return code from this subroutine
c
      USE trig_vals
      USE verbose_output

      implicit none

      real centlon,centlat,xlon,xlat,udat,vdat,vr,vt,degrees,tmpxlon
      real angle,xlondiff,xlatdiff,opp_dist,hyp_dist,sin_value
      real cos_value,adj_dist,tmpangle,sin_angle,cos_angle
      real uvrcomp,vvrcomp,uvtcomp,vvtcomp
      integer igvtret
c
      call calcdist(centlon,centlat,xlon,xlat,hyp_dist,degrees)

c      xxxx

      tmpxlon = xlon

      if (centlon > 330.0) then

        if (xlon > 360.0) then
         
          tmpxlon = xlon  ! All lons will be in the 300+ range, so for
                          ! consistency, we're ok.

        elseif (xlon < 30.0) then

          tmpxlon = xlon + 360.  ! In this case, the fix center is just
                          ! to the west of the GM with a lon (centlon) 
                          ! > 330, while the point being evaluated
                          ! (xlon) is just east of the GM, but with a 
                          ! lon (centlon) < 30.  Need to adjust here to
                          ! to get the xlon in the 330+ frame of 
                          ! reference.

        endif

      elseif (centlon >= 0 .and. centlon < 30.0) then

        if (xlon >= 360.0) then

          tmpxlon = xlon - 360.

        elseif (xlon > 330. .and. xlon < 360.) then

          tmpxlon = 360. - xlon

        endif

      elseif (centlon < 0.0) then

        if (xlon >= 360.0) then
 
          tmpxlon = xlon - 360.

        elseif (xlon > 330. .and. xlon < 360.) then

          tmpxlon = -1 * (360. - xlon)

        endif

      endif

      xlatdiff = abs(centlat - xlat)
      xlondiff = abs(centlon - tmpxlon)

      if (centlon > 355.0) then
        write (6,91) centlon,tmpxlon,hyp_dist,degrees,xlondiff
   91   format (1x,'centlon= ',f8.3,' tmpxlon= ',f8.3,' hyp_dist= '
     &            ,f10.2,' degrees= ',f10.2,' xlondiff= ',f12.2)
      endif

      if (xlondiff == 0 .and. xlatdiff > 0) then

        if (centlat > xlat) angle = 180   ! pt directly south of ctr
        if (centlat < xlat) angle = 0     ! pt directly north of ctr

      else if (xlondiff > 0 .and. xlatdiff == 0) then

        if (centlon > tmpxlon) angle = 270   ! pt directly west of ctr
        if (centlon < tmpxlon) angle = 90    ! pt directly east of ctr

      else

        ! This next part figures out the angle from the center point
        ! (centlon,centlat) to the data point (tmpxlon,xlat).  It does
        ! this by setting up a triangle and then using inverse trig
        ! functions to get the angle.  Since this is a kludgy way to
        ! do it that doesn't account for the curvature of the earth,
        ! we'll do it 2 ways, using asin and then acos, then take the
        ! average of those 2 for the angle.  hyp_dist, calculated just
        ! above, is the distance from the center pt to the data pt.

        opp_dist  = xlatdiff/360. * ecircum
        sin_value = opp_dist / hyp_dist
        if (sin_value > 1.0) then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! In getvrvt, sin_value > 1, setting to 1.'
            print *,'!!! opp_dist= ',opp_dist,' hyp_dist= ',hyp_dist
            print *,'!!! sin_value = ',sin_value
            print *,'!!! centlon= ',centlon,' centlat= ',centlat
            print *,'!!! tmpxlon=    ',tmpxlon,' xlat=    ',xlat
            print *,' '
          endif

          sin_value = 0.99999
        endif
        sin_angle = asin(sin_value) / dtr

        call calcdist(centlon,centlat,tmpxlon,centlat,adj_dist,degrees)
        cos_value = adj_dist / hyp_dist
        if (cos_value > 1.0) then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! In getvrvt, cos_value > 1, setting to 1.'
            print *,'!!! adj_dist= ',adj_dist,' hyp_dist= ',hyp_dist
            print *,'!!! cos_value = ',cos_value
            print *,'!!! centlon= ',centlon,' centlat= ',centlat
            print *,'!!! tmpxlon=    ',tmpxlon,' xlat=    ',xlat
            print *,' '
          endif

          cos_value = 0.99999
        endif
        cos_angle = acos(cos_value) / dtr

        tmpangle = 0.5 * (sin_angle + cos_angle)

        ! The previous lines of code just calculated an angle between
        ! 0 and 90.  This next if structure adjusts that angle to 
        ! instead be between 0 and 360.

        if      (centlat <= xlat .and. centlon <= tmpxlon) then
          angle = 90 - tmpangle
        else if (centlat >  xlat .and. centlon <= tmpxlon) then
          angle = 90 + tmpangle
        else if (centlat >= xlat .and. centlon >= tmpxlon) then
          angle = 270 - tmpangle
        else if (centlat <  xlat .and. centlon >= tmpxlon) then
          angle = 270 + tmpangle
        endif

      endif

      uvrcomp = udat * sin(angle * dtr)
      vvrcomp = vdat * cos(angle * dtr)
      vr      = uvrcomp + vvrcomp

      uvtcomp = (-udat) * cos(angle * dtr)
      vvtcomp = vdat    * sin(angle * dtr)
      vt      = uvtcomp + vvtcomp

      return 
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_atcfunix (outlon,outlat,inp,ist
     &         ,ifcsthour,vmaxwind,xminmslp,vradius,maxstorm
     &         ,trkrinfo,plastbar,rlastbar,rmax,cps_vals
     &         ,wcore_flag,ioaxret)

c     ABSTRACT: This subroutine  outputs a 1-line message for a given 
c     storm at an input forecast hour in the new ATCF UNIX format.  
c     Unlike the old atcf DOS format in which you waited until the 
c     whole tracking was over to write the  output for all forecast 
c     hours, with this atcfunix format, each time we are calling this
c     subroutine, it is to only write out 1 record, which will be the
c     fix info for a particular storm at a given time.  Also, even 
c     though we have some data (GFS, NAM) at 6-hour intervals, Jim 
c     Gross informed me that TPC does not need the positions at such
c     frequency, and keeping the reporting at 12 hour intervals is fine.
c
c     While this new atcfunix format contains much more information than
c     the old 1-line atcf dos message, for our purposes we will use the
c     slots for mslp and wind radii.  An example set of output records
c     will look like the following:
c
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  34,
c             NEQ,  242,  163,  124,  208
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  50,
c             NEQ,  155,  000,  000,  000
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  64,
c             NEQ,  000,  000,  000,  000
c
c     (NOTE: Each of the above lines beginning with "AL" is output as 
c            a single line of text.)
c
c     Note that in this example, for this 36h forecast hour, there are 
c     3 entries.  This is so that we can include the radii for the 
c     3 different wind thresholds (34kt, 50kt and 64kt).  So the only
c     thing different in each entry is the wind radii info;  all the
c     other info is identical for each entry.
c
c     This message also contains the intensity estimates (in knots) 
c     for every forecast hours  The  conversion for m/s to knots is 
c     to multiply m/s by 1.9427 (3.281 ft/m, 1 naut mile/6080 ft, 
c     3600s/h).
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The format for the 
c     atcfunix system requires that the  output be 0-180E or
c     0-180W, so we must adjust the values, if needed.  Also, the
c     values for southern latitudes must be positive (use 'N' and 
c     'S' to distinguish Northern/Southern Hemispheres).
c
c     INPUT:
c     outlon    longitude  fix position for this storm at this time 
c               which is to be written out to the  output file
c     outlat    latitude  fix position for this storm at this time 
c               which is to be written out to the  output file
c     inp       contains input date and model number information
c     ist       the number storm that we're processing (can be 1-15)
c     ifcsthr   the current forecast hour being output
c     vmaxwind  the max surface wind for this storm at this fcst hour
c     xminmslp  the min mslp for this storm at this fcst hour
c     vradius   Contains the distance from the storm fix position to
c               each of the various wind threshhold distances in each
c               quadrant. (3,4) ==> (# of threshholds, # of quadrants)
c     maxstorm  max # of storms that can be handled
c     plastbar  pressure of the outermost closed isobar
c     rlastbar  radius (nm) of the outermost closed isobar
c     rmax      radius of max winds (n mi).... it was already converted
c               from km to n mi in subroutine  get_max_wind
c     cps_vals  real array with the values for the 3 cyclone phase 
c               space parameters: (1) is for Parameter B (thermal
c               asymmetry); (2) is for lower level (600-900 mb) thermal
c               wind; (3) is for upper level (300-600 mb) thermal wind.
c     wcore_flag character for value of 300-500 mb warm core: y, n, or 
c               'u' for undetermined.
c     OUTPUT:
c     ioaxret   integer return code from this subroutine
c     
c     LOCAL:
c     intlon    integer that holds the value of outlon*10
c     intlat    integer that holds the value of outlat*10
c     storm     An array of type tcvcard.  Use this for the storm ID
c

      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE trkrparms; USE phase
      USE verbose_output

      type (datecard) inp
      type (trackstuff) trkrinfo

      real    cps_vals(3)
      real    outlon,outlat,rmax,mslp_outp_adj
      real    vmaxwind,conv_ms_knots,xminmslp,plastbar,rlastbar
      integer intlon,intlat,irmax,output_fhr,ic,iplastbar,irlastbar
      integer vradius(3,4),icps_vals(3)
      character  basinid*2,clatns*1,clonew*1,wcore_flag*1
      character comma_fill1*48,comma_fill2*31,comma_filler*79

      if ( verb .ge. 3 ) then
        print *,'TTT top of atcfunix, ist= ',ist,' ifh= ',ifcsthour
      endif

      if (xminmslp == 999999.0) xminmslp = 0.0

      if (xminmslp < 1100.0) then
        ! Pressure units are in mb...
        mslp_outp_adj = 1.0
      elseif (xminmslp >80000.0) then
        ! Pressure units are in Pa...
        mslp_outp_adj = 100.0
      else
        if (verb .ge. 3) then
          print *,' '
          print *,'ERROR: Something wrong in subroutine'
          print *,'       output_atcfunix.  The mslp value'
          print *,'       (xminmslp) is not in range.'
          print *,'       xminmslp = ',xminmslp
          print *,'       EXITING....'
          print *,' '
          stop 95
        endif
      endif

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0-180E or 0-180W, and convert the lat values so that they are
c     positive and use 'N' or 'S' to differentiate hemispheres.

      conv_ms_knots = 1.9427

      if (outlon < -998.0 .or. outlat < -998.0) then
        intlon = 0
        intlat = 0
        clonew = ' '
        clatns = ' '
      else
        if (outlon >= 180.0) then
          intlon = 3600 - int(outlon * 10. + 0.5)
          clonew = 'W'
        else
          intlon = int(outlon * 10. + 0.5)
          clonew = 'E'
        endif
        intlat = int(abs(outlat) * 10. + 0.5)
        if (outlat < 0.0) then
          clatns = 'S'
        else
          clatns = 'N'
        endif
      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'in output_atcfunix, tcv_storm_id= '
     &       ,storm(ist)%tcv_storm_id
        print *,'in output_atcfunix, tcv_storm_id(3:3)= '
     &       ,storm(ist)%tcv_storm_id(3:3)
      endif

      select case (storm(ist)%tcv_storm_id(3:3))
        case ('L','l');  basinid = 'AL'
        case ('E','e');  basinid = 'EP'
        case ('C','c');  basinid = 'CP'
        case ('W','w');  basinid = 'WP'
        case ('O','o');  basinid = 'SC'
        case ('T','t');  basinid = 'EC'
        case ('U','u');  basinid = 'AU'
        case ('P','p');  basinid = 'SP'
        case ('S','s');  basinid = 'SI'
        case ('B','b');  basinid = 'BB'
!zhang        case ('A','a');  basinid = 'NA'
        case ('A','a');  basinid = 'AA'
        case ('Q','q');  basinid = 'SL'
        case default;    basinid = 'HC'
      end select

      if (atcfname(1:2) == 'SP') then
        ! Add 3 for SREF to account for the 3-hour off-synoptic
        ! time offset....
        output_fhr = ifcsthour + 3
      else
        output_fhr = ifcsthour
      endif

      if (rmax == -99.0) then
        irmax = -99
      else    
        irmax = int(rmax + 0.5)
      endif

      if (trkrinfo%want_oci) then
        if (plastbar > 0.0) then
          iplastbar = int(plastbar/mslp_outp_adj + 0.5)
        else
          iplastbar = -99
        endif
        if (rlastbar > 0.0) then
          irlastbar = int(rlastbar + 0.5)
        else
          irlastbar = -99
        endif
      else
        iplastbar = -99
        irlastbar = -99
      endif

      if ( verb .ge. 3 ) then
        print *, 'output: rlastbar=',rlastbar,' irlastbar=',irlastbar
        print *, 'output: plastbar=',plastbar,' iplastbar=',iplastbar
      endif

c     Now convert all of the cyclone phase space parameter values from
c     real to integer.

      do ic = 1,3
        if (cps_vals(ic) > -9999.0) then
          if (cps_vals(ic) >= 0.0) then
            icps_vals(ic) = int(cps_vals(ic)*10. + 0.5)
          else
            icps_vals(ic) = int(cps_vals(ic)*10. - 0.5)
          endif
        else
          icps_vals(ic) = -9999
        endif
      enddo

      if (wcore_flag == 'y'.or. wcore_flag == 'Y') then
        wcore_flag = 'Y'
      elseif (wcore_flag == 'n' .or. wcore_flag == 'N') then
        wcore_flag = 'N'
      elseif (wcore_flag == 'u' .or. wcore_flag == 'U') then
        wcore_flag = 'U'
      else
        wcore_flag = 'U'
      endif

      comma_fill1 = ',   0,   0,    ,   0,    ,   0,   0,           ,'
      comma_fill2 = '  ,   ,    ,   0,   0,   0,   0'
      comma_filler = comma_fill1//comma_fill2

      if (trkrinfo%type == 'midlat' .or. trkrinfo%type == 'tcgen') then

        if (stcvtype(ist) == 'FOF') then
          ! If this is a TC vitals-described storm (i.e., one that is
          ! numbered by JTWC or NHC), then leave the basinid as is.
          ! Otherwise, we want to use the "basinid" location as a 
          ! label to identify what type of run this is.
          if (trkrinfo%type == 'midlat') basinid = 'ML'
          if (trkrinfo%type == 'tcgen')  basinid = 'TG'
        endif

        write (64,91) basinid,adjustr(storm(ist)%tcv_storm_id)
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  34, NEQ'
     &        ,vradius(1,1),vradius(1,2),vradius(1,3),vradius(1,4)
     &        ,iplastbar,irlastbar,irmax,0,0,stcvtype(ist)

        if (vradius(2,1) > 0 .or. vradius(2,2) > 0 .or.
     &      vradius(2,3) > 0 .or. vradius(2,4) > 0) then
          write (64,91) basinid,adjustr(storm(ist)%tcv_storm_id)
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  50, NEQ'
     &        ,vradius(2,1),vradius(2,2),vradius(2,3),vradius(2,4)
     &        ,iplastbar,irlastbar,irmax,0,0,stcvtype(ist)
        endif

        if (vradius(3,1) > 0 .or. vradius(3,2) > 0 .or.
     &      vradius(3,3) > 0 .or. vradius(3,4) > 0) then
          write (64,91) basinid,adjustr(storm(ist)%tcv_storm_id)
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  64, NEQ'
     &        ,vradius(3,1),vradius(3,2),vradius(3,3),vradius(3,4)
     &        ,iplastbar,irlastbar,irmax,0,0,stcvtype(ist)
        endif

      else

        write (64,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  34, NEQ'
     &        ,vradius(1,1),vradius(1,2),vradius(1,3),vradius(1,4)
     &        ,iplastbar,irlastbar,irmax,comma_filler,icps_vals(1)
     &        ,icps_vals(2),icps_vals(3),wcore_flag,int(wcore_depth*10)

        if (vradius(2,1) > 0 .or. vradius(2,2) > 0 .or.
     &      vradius(2,3) > 0 .or. vradius(2,4) > 0) then
          write (64,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)                   
     &        ,int(xminmslp/mslp_outp_adj + 0.5)         
     &        ,'XX,  50, NEQ'          
     &        ,vradius(2,1),vradius(2,2),vradius(2,3),vradius(2,4)
     &        ,iplastbar,irlastbar,irmax,comma_filler,icps_vals(1)
     &        ,icps_vals(2),icps_vals(3),wcore_flag,int(wcore_depth*10)
        endif

        if (vradius(3,1) > 0 .or. vradius(3,2) > 0 .or.
     &      vradius(3,3) > 0 .or. vradius(3,4) > 0) then
          write (64,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  64, NEQ'
     &        ,vradius(3,1),vradius(3,2),vradius(3,3),vradius(3,4)
     &        ,iplastbar,irlastbar,irmax,comma_filler,icps_vals(1)
     &        ,icps_vals(2),icps_vals(3),wcore_flag,int(wcore_depth*10)
        endif

      endif

      if ( verb .ge. 3 ) then
        print *,'rmax= ',rmax,'  irmax= ',irmax
      endif

   81 format (a2,', ',a2,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,4(', ',i4.4)
     &       ,2(', ',i4),', ',i3,a79,',       THERMO PARAMS'
     &       ,3(', ',i7),', ',a1,', ',i2,', DT, -999')
   91 format (a2,', ',a4,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,4(', ',i4.4)
     &       ,2(', ',i4),', ',i3,2(', ',i3),', ',a3)

c     bug fix for IBM: flush the output stream so it actually writes
      flush(64)

      return
      end

c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_all (fixlon,fixlat,inp,maxstorm,ifhmax,ioaret)
c
c     ABSTRACT: This subroutine  outputs a 1-line message for each
c     storm.  This message contains the model identifier, the forecast
c     initial date, and the positions for 0, 12, 24, 36, 48, 60 and 72
c     hours.  In the case of the regional models (NGM, Eta), which
c     only go out to 48h, zeroes are included for forecast hours
c     60 and 72.
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The  output of this
c     subroutine is used by Steve Lord for plotting purposes, and his
c     plotting routines need the longitudes in 0 - 360, increasing
c     westward.  Thus, a necessary adjustment is made.
c
      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE tracked_parms
c
      type (datecard) inp
c
      real    fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      integer modelnum(maxmodel)
      integer intlon(maxtime),intlat(maxtime)
      character  modelchar(maxmodel)*4

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0 - 360, increasing westward.

      print *,'top of output_all'

      stormloop: do ist = 1,maxstorm

        if (stormswitch(ist) == 3) cycle stormloop
        intlon = 0; intlat = 0

        ifhloop: do ifh = 1,maxtime

          if (ifh <= ifhmax) then
            if (ifhours(ifh) == 99) then
              intlon(ifh) = 0
              intlat(ifh) = 0
              cycle ifhloop
            endif
          else
            intlon(ifh) = 0
            intlat(ifh) = 0
            cycle ifhloop
          endif

          if (fixlon(ist,ifh) < -998.0 .or. fixlat(ist,ifh) < -998.0)
     &    then
            intlon(ifh) = 0
            intlat(ifh) = 0
          else
            intlon(ifh) = 3600 - int(fixlon(ist,ifh) * 10. + 0.5)
            intlat(ifh) = int(abs(fixlat(ist,ifh)) * 10. + 0.5)
            if (fixlat(ist,ifh) < 0.0) then
              intlat(ifh) = intlat(ifh) * (-1)
            endif
          endif

        enddo ifhloop

        print *,'before select case, atcfname= '

        select case (atcfname(1:3))

          case ('SEC','SEN','SEP','SKC','SKN','SKP','SRC','SRN','SRP')
            write (61,81) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(1),intlon(1)
     &           ,intlat(5),intlon(5),intlat(9),intlon(9),intlat(13)
     &           ,intlon(13),intlat(17),intlon(17),intlat(21),intlon(21)
     &           ,0,0,storm(ist)%tcv_storm_id

          case ('AVN','NGM','ETA','GFD','AP0','AN0','AP1','AN1','AC0'
     &         ,'AMM','CMC','HWR')
            write (61,81) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(1),intlon(1)
     &           ,intlat(3),intlon(3),intlat(5),intlon(5),intlat(7)
     &           ,intlon(7),intlat(9),intlon(9),intlat(11),intlon(11)
     &           ,intlat(13),intlon(13),storm(ist)%tcv_storm_id

          case ('MRF','UKX','NGX','EP0','EP1','EP2','EN0','EN1','EN2'
     &         ,'CP0','CN0','CC0','EC0','EMX')
            ! MRF, UKMET, NAVGEM, ECMWF Ensemble
            write (61,81) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(1),intlon(1)
     &           ,intlat(2),intlon(2),intlat(3),intlon(3),intlat(4)
     &           ,intlon(4),intlat(5),intlon(5),intlat(6),intlon(6)
     &           ,intlat(7),intlon(7),storm(ist)%tcv_storm_id

          case ('GDA','HDA')       ! GDAS, HDAS
            write (61,81) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(1),intlon(1)
     &           ,intlat(2),intlon(2),intlat(3),intlon(3)
     &           ,intlat(4),intlon(4),0,0,0,0,0,0
     &           ,storm(ist)%tcv_storm_id

          case ('WP0','WP1','WN0','WN1','XP0','XP1','XN0','XN1'
     &         ,'YP0','YP1','YN0','YN1','ZP0','ZP1','ZN0','ZN1')
            ! Ensemble RELOCATION ONLY
            write (61,81) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(1),intlon(1)
     &           ,intlat(2),intlon(2),0,0,0,0,0,0,0,0,0,0
     &           ,storm(ist)%tcv_storm_id

          case default
c            print *,'!!! ERROR in subroutine  output_all. '
c            print *,'!!! Model name is not identified.'
c            print *,'!!! Model name = ',atcfname
c            print *,'!!! ist = ',ist,' Model number = ',atcfnum
            print *,' '
            print *,'!!! Model name is not identified: ',atcfname

            write (61,81) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(1),intlon(1)
     &           ,intlat(2),intlon(2),intlat(3),intlon(3)
     &           ,intlat(4),intlon(4),0,0,0,0,0,0
     &           ,storm(ist)%tcv_storm_id

        end select

      enddo stormloop

  81  format (i2,a4,4i2.2,14i4,1x,a3)
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_atcf (fixlon,fixlat,inp,xmaxwind,maxstorm
     &                       ,ifhmax,ioaret)
c
c     ABSTRACT: This subroutine  outputs a 1-line message for each storm
c     in ATCF format.  This message contains the model identifier, the
c     forecast initial date, and the positions for 12, 24, 36, 48
c     and 72 hours.  This message also contains the intensity
c     estimates (in knots) for those same hours.  The  conversion for
c     m/s to knots is to multiply m/s by 1.9427 (3.281 ft/m,
c     1 naut mile/6080 ft, 3600s/h).
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The  output of this
c     subroutine is used by the atcf system at TPC for plotting
c     purposes, and the atcf plotting routines need the longitudes in
c     0 - 360, increasing westward.  Thus, a necessary adjustment is
c     made.
c
      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE tracked_parms
c
      type (datecard) inp
c
      real    fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real    xmaxwind(maxstorm,maxtime)
      real    conv_ms_knots
      integer modelnum(maxmodel)
      integer intlon(maxtime),intlat(maxtime)
      character  modelchar(maxmodel)*4,basinid*4

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0 - 360, increasing westward.

      conv_ms_knots = 1.9427

      stormloop: do ist = 1,maxstorm

        if (stormswitch(ist) == 3) cycle stormloop
        intlon = 0; intlat = 0

        ifhloop: do ifh = 1,maxtime

          if (ifh <= ifhmax) then
            if (ifhours(ifh) == 99) then
              intlon(ifh) = 0
              intlat(ifh) = 0
              cycle ifhloop
            endif
          else
            intlon(ifh) = 0
            intlat(ifh) = 0
            cycle ifhloop
          endif

          if (fixlon(ist,ifh) < -998.0 .or. fixlat(ist,ifh) < -998.0)
     &    then

            intlon(ifh) = 0
            intlat(ifh) = 0

          else
            intlon(ifh) = 3600 - int(fixlon(ist,ifh) * 10. + 0.5)
            intlat(ifh) = int(abs(fixlat(ist,ifh)) * 10. + 0.5)
            if (fixlat(ist,ifh) < 0.0) then
              intlat(ifh) = intlat(ifh) * (-1)
            endif

          endif

        enddo ifhloop

        basinid = '    '
        select case (storm(ist)%tcv_storm_id(3:3))
          case ('L','l');  basinid(1:2) = 'AL'
          case ('E','e');  basinid(1:2) = 'EP'
          case ('C','c');  basinid(1:2) = 'CP'
          case ('W','w');  basinid(1:2) = 'WP'
          case ('O','o');  basinid(1:2) = 'SC'
          case ('T','t');  basinid(1:2) = 'EC'
          case ('U','u');  basinid(1:2) = 'AU'
          case ('P','p');  basinid(1:2) = 'SP'
          case ('S','s');  basinid(1:2) = 'SI'
          case ('B','b');  basinid(1:2) = 'BB'
cPENG          case ('A','a');  basinid(1:2) = 'NA'
          case ('A','a');  basinid(1:2) = 'AA'
          case default;    basinid(1:2) = '**'
        end select
        basinid(3:4) = storm(ist)%tcv_storm_id(1:2)


        select case (atcfname(1:3))

          case ('SEC','SEN','SEP','SKC','SKN','SKP','SRC','SRN','SRP')
            write (62,82) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(5),intlon(5)
     &           ,intlat(9),intlon(9),intlat(13),intlon(13),intlat(17)
     &           ,intlon(17),0,0
     &           ,int((xmaxwind(ist,5)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,9)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,13)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,17)*conv_ms_knots) + 0.5)
     &           ,0
     &           ,basinid,inp%byy

          case ('AVN','NGM','ETA','GFD','AP0','AN0','AP1','AN1','AC0'
     &         ,'AMM','CMC','HWR')
            write (62,82) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(3),intlon(3)
     &           ,intlat(5),intlon(5),intlat(7),intlon(7),intlat(9)
     &           ,intlon(9),intlat(13),intlon(13)
     &           ,int((xmaxwind(ist,3)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,5)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,7)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,9)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,13)*conv_ms_knots) + 0.5)
     &           ,basinid,inp%byy

          case ('MRF','UKX','NGX','EP0','EP1','EP2','EN0','EN1','EN2'
     &         ,'CP0','CN0','CC0','EC0','EMX')
            ! MRF, UKMET, NAVGEM, ECMWF Ensemble, ECMWF hi-res
            write (62,82) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(2),intlon(2)
     &           ,intlat(3),intlon(3),intlat(4),intlon(4),intlat(5)
     &           ,intlon(5),intlat(7),intlon(7)
     &           ,int((xmaxwind(ist,2)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,3)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,4)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,5)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,7)*conv_ms_knots) + 0.5)
     &           ,basinid,inp%byy

          case ('GDA','HDA')        ! GDAS, HDAS
            write (62,82) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh
     &           ,intlon(1),intlat(1),intlat(2),intlon(2)
     &           ,intlat(3),intlon(3),intlat(4),intlon(4)
     &           ,0,0
     &           ,int((xmaxwind(ist,2)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,3)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,4)*conv_ms_knots) + 0.5)
     &           ,0,0,basinid,inp%byy

          case ('WP0','WP1','WN0','WN1','XP0','XP1','XN0','XN1'
     &         ,'YP0','YP1','YN0','YN1','ZP0','ZP1','ZN0','ZN1')
            ! Ensemble RELOCATION ONLY
            write (62,82) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh
     &           ,intlon(1),intlat(1),intlat(2),intlon(2)
     &           ,0,0,0,0
     &           ,0,0
     &           ,int((xmaxwind(ist,2)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,3)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,4)*conv_ms_knots) + 0.5)
     &           ,0,0,basinid,inp%byy

          case default
c            print *,'!!! ERROR in subroutine  output_atcf. '
c            print *,'!!! Model name is not identified.'
c            print *,'!!! Model name = ',atcfname
c            print *,'!!! ist = ',ist,' Model number = ',atcfnum
            print *,' '
            write (62,82) atcfnum,atcfname
     &           ,inp%byy,inp%bmm,inp%bdd,inp%bhh,intlat(3),intlon(3)
     &           ,intlat(5),intlon(5),intlat(7),intlon(7),intlat(9)
     &           ,intlon(9),intlat(13),intlon(13)
     &           ,int((xmaxwind(ist,3)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,5)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,7)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,9)*conv_ms_knots) + 0.5)
     &           ,int((xmaxwind(ist,13)*conv_ms_knots) + 0.5)
     &           ,basinid,inp%byy

        end select

      enddo stormloop

  82  format (i2,a4,4i2.2,10i4,5i3,1x,a4,i2.2)
c
      return
      end

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_hfip (outlon,outlat,inp,ist
     &          ,ifh,vmaxwind,xminmslp,vradius,rmax,ioaxret)

c     ABSTRACT: This subroutine  outputs a 1-line message for a given
c     storm at an input forecast hour in a modified ATCF UNIX format.
c     The modification is to allow for sub-hourly output.  That is,
c     instead of just integer output hours, we can have output at 
c     10, 15 or 20 past an hour.  This necessitates a change in the 
c     "forecast hour" placeholder in the ATCF format.  Instead of it
c     being an I3, we'll make it an I5, with something like a lead time
c     of 36.25h being rounded and truncated to 03625 for output.
c     
c     An example set of output records using the standard atcf format
c     looks like the following:
c     
c     AL, 13, 2000092500, 03, AVNO, 036, 243N, 675W, 42, 995, XX,  34,
c             NEQ,  242,  163,  124,  208
c     AL, 13, 2000092500, 03, AVNO, 036, 243N, 675W, 42, 995, XX,  50,
c             NEQ,  155,  000,  000,  000
c     AL, 13, 2000092500, 03, AVNO, 036, 243N, 675W, 42, 995, XX,  64,
c             NEQ,  000,  000,  000,  000
c     
c     An example set of modified output records will look like the
c     following, for the case of a lead time of 36:15 (36.25):
c     
c     AL, 13, 2000092500, 03, AVNO, 03625, 243N, 675W, 42, 995, XX,  34,
c             NEQ,  242,  163,  124,  208
c     AL, 13, 2000092500, 03, AVNO, 03625, 243N, 675W, 42, 995, XX,  50,
c             NEQ,  155,  000,  000,  000
c     AL, 13, 2000092500, 03, AVNO, 03625, 243N, 675W, 42, 995, XX,  64,
c             NEQ,  000,  000,  000,  000
c     
c     (NOTE: Each of the above lines beginning with "AL" is output as
c            a single line of text.)
c     
c     Note that in this example, for this 36h forecast hour, there are
c     3 entries.  This is so that we can include the radii for the
c     3 different wind thresholds (34kt, 50kt and 64kt).  So the only
c     thing different in each entry is the wind radii info;  all the
c     other info is identical for each entry.
c     
c     This message also contains the intensity estimates (in knots)
c     for every forecast hours  The  conversion for m/s to knots is
c     to multiply m/s by 1.9427 (3.281 ft/m, 1 naut mile/6080 ft,
c     3600s/h).
c     
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The format for the
c     atcfunix system requires that the  output be 0-180E or
c     0-180W, so we must adjust the values, if needed.  Also, the
c     values for southern latitudes must be positive (use 'N' and
c     'S' to distinguish Northern/Southern Hemispheres).
c     
c     INPUT:    
c     storm     An array of type tcvcard.  Use this for the storm ID
c     outlon    longitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     outlat    latitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     inp       contains input date and model number information
c     ist       the number storm that we're processing (can be 1-15)
c     ifh       index for the lead time array
c     vmaxwind  the max surface wind for this storm at this fcst hour
c     xminmslp  the min mslp for this storm at this fcst hour
c     vradius   Contains the distance from the storm fix position to
c               each of the various wind threshhold distances in each
c               quadrant. (3,4) ==> (# of threshholds, # of quadrants)
c     rmax      Radius of max winds (n mi).... it was already converted
c               from km to n mi in subroutine  get_max_wind
c
c     OUTPUT:
c     ioaxret   integer return code from this subroutine
c
c     LOCAL:
c     intlon    integer that holds the value of outlon*10
c     intlat    integer that holds the value of outlat*10
c

      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE tracked_parms
      USE verbose_output

      type (datecard) inp

      real    outlon,outlat,mslp_outp_adj
      real    vmaxwind,conv_ms_knots,xminmslp,rmax
      integer intlon,intlat,output_fhr,irmax,ileadtime
      integer vradius(3,4)
      character  basinid*2,clatns*1,clonew*1

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0-180E or 0-180W, and convert the lat values so that they are
c     positive and use 'N' or 'S' to differentiate hemispheres.

      if (xminmslp == 999999.0) xminmslp = 0.0

      if (xminmslp < 1100.0) then
        ! Pressure units are in mb...
        mslp_outp_adj = 1.0
      elseif (xminmslp >80000.0) then
        ! Pressure units are in Pa...
        mslp_outp_adj = 100.0
      else
        if (verb .ge. 3) then
          print *,' '
          print *,'ERROR: Something wrong in subroutine'
          print *,'       output_hfip.  The mslp value'
          print *,'       (xminmslp) is not in range.'
          print *,'       xminmslp = ',xminmslp
          print *,'       EXITING....'
          print *,' '
          stop 95
        endif
      endif

      conv_ms_knots = 1.9427

      if (outlon < -998.0 .or. outlat < -998.0) then
        intlon = 0
        intlat = 0
        clonew = ' '
        clatns = ' '
      else
        if (outlon >= 180.0) then
          intlon = 3600 - int(outlon * 10. + 0.5)
          clonew = 'W'
        else
          intlon = int(outlon * 10. + 0.5)
          clonew = 'E'
        endif
        intlat = int(abs(outlat) * 10. + 0.5)
        if (outlat < 0.0) then
          clatns = 'S'
        else
          clatns = 'N'
        endif
      endif

      select case (storm(ist)%tcv_storm_id(3:3))
        case ('L','l');  basinid = 'AL'
        case ('E','e');  basinid = 'EP'
        case ('C','c');  basinid = 'CP'
        case ('W','w');  basinid = 'WP'
        case ('O','o');  basinid = 'SC'
        case ('T','t');  basinid = 'EC'
        case ('U','u');  basinid = 'AU'
        case ('P','p');  basinid = 'SP'
        case ('S','s');  basinid = 'SI'
        case ('B','b');  basinid = 'BB'
        case ('A','a');  basinid = 'AA'
        case ('Q','q');  basinid = 'SL'
        case default;    basinid = '**'
      end select

      ! ST: ifcsthour does not exist, so output_fhr is always
      ! filled with invalid data here.  However, output_fhr is
      ! never used, so it is safe to remove.
      if (atcfname(1:2) == 'SP') then
        ! Add 3 for SREF to account for the 3-hour off-synoptic
        ! time offset....
        ! output_fhr = ifcsthour + 3
        ileadtime  = nint((fhreal(ifh) + 3.0) * 100.0)
      else
        ! output_fhr = ifcsthour
        ileadtime  = nint(fhreal(ifh) * 100.0)
      endif

      if (rmax == -99.0) then
        irmax = -99
      else
        irmax = int(rmax + 0.5)
      endif

      write (69,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &      ,atcfymdh
     &      ,adjustr(atcfname),ileadtime,intlat,clatns,intlon,clonew
     &      ,int((vmaxwind*conv_ms_knots) + 0.5)
     &      ,int(xminmslp/mslp_outp_adj + 0.5)
     &      ,'XX,  34, NEQ'
     &      ,vradius(1,1),vradius(1,2),vradius(1,3),vradius(1,4),irmax

      if (vradius(2,1) > 0 .or. vradius(2,2) > 0 .or.
     &    vradius(2,3) > 0 .or. vradius(2,4) > 0) then
        write (69,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &        ,atcfymdh
     &        ,adjustr(atcfname),ileadtime,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  50, NEQ'
     &        ,vradius(2,1),vradius(2,2),vradius(2,3),vradius(2,4),irmax
      endif

      if (vradius(3,1) > 0 .or. vradius(3,2) > 0 .or.
     &    vradius(3,3) > 0 .or. vradius(3,4) > 0) then
        write (69,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &        ,atcfymdh
     &        ,adjustr(atcfname),ileadtime,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  64, NEQ'
     &        ,vradius(3,1),vradius(3,2),vradius(3,3),vradius(3,4),irmax
      endif

   81 format (a2,', ',a2,', ',i10.10,', 03, ',a4,', ',i5.5,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,4(', ',i4.4)
     &       ,',    0,    0, ',i3)
c
c     bug fix for IBM: flush the output stream so it actually writes
      flush(69)

      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_fract_wind (outlon,outlat,xsfclon,xsfclat
     &          ,inp,ist,ifcsthour,vmaxwind,xminmslp,wfract_cov
     &          ,wfract_type,pdf_ct_bin,pdf_ct_tot,maxstorm,iofwret)
c
c     ABSTRACT: This subroutine  outputs a 1-line message for a given
c     storm at an input forecast hour.  This message contains the
c     values for the fractional areal coverage of various wind
c     thresholds.  In addition, this subroutine also writes out
c     records to a file containing data on the PDF of wind magnitudes
c     within r=350 km.
c
c     This format will mimic the current atcfunix format with the
c     difference coming late in the record, where the various wind radii
c     will be replaced with areal coverage thresholds.
c
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             000, 100,  34, NEE,  981,  857,  629,  810
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             000, 100,  50, NEE,  874,  732,  319,  610
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             000, 100,  64, NEE,  454,  327,   99,  270
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             000, 100,  34, AAE,  721,  721,  721,  721
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             000, 100,  50, AAE,  465,  465,  465,  465
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             000, 100,  64, AAE,  298,  298,  298,  298
c
c     (NOTE: Each of the above lines beginning with "AL" is output as
c            a single line of text.)
c
c     Note that in this example, for this 36h forecast hour, there are
c     3 entries.  This is so that we can include the pctgs for the
c     3 different wind thresholds (34kt, 50kt and 64kt).  So the only
c     thing different in each entry is the wind pctg info;  all the
c     other info is identical for each entry.
c
c     Listed after the "XX" in each record is the radius from which
c     the coverage is valid (000 km in this case); Next is the radius
c     at which the coverage stops (100 km in this case).  Next is the
c     wind threshold (34, 50, 64).  Next is an identifier for which
c     quadrant the coverage starts in (first 2 characters are NE, SE,
c     SW, NW); the last character indicates if the coverages are
c     computed in the quadrants as earth-relative ("E") or
c     storm-motion relative ("R").  The ones listed there as "AAE"
c     are for the full disc (i.e., 4-quadrant average), earth-relative.
c     Next are the wind coverage percentages, listed as percentage * 10
c     (e.g., 981 = 98.1%).
c
c     This message also contains the intensity estimates (in knots)
c     for every forecast hours  The  conversion for m/s to knots is
c     to multiply m/s by 1.9427 (3.281 ft/m, 1 naut mile/6080 ft,
c     3600s/h).
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The format for the
c     atcfunix system requires that the  output be 0-180E or
c     0-180W, so we must adjust the values, if needed.  Also, the
c     values for southern latitudes must be positive (use 'N' and
c     'S' to distinguish Northern/Southern Hemispheres).
c
c     INPUT:
c     outlon    longitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     outlat    latitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     xsfclon   low-level longitude estimate for this storm & time,
c               computed ideally from mean of mslp & low-level winds.
c     xsfclat   low-level latitude estimate for this storm & time,
c               computed ideally from mean of mslp & low-level winds.
c     inp       contains input date and model number information
c     ist       the number storm that we're processing (can be 1-15)
c     ifcsthr   the current forecast hour being output
c     vmaxwind  the max surface wind for this storm at this fcst hour
c     xminmslp  the min mslp for this storm at this fcst hour
c     wfract_cov percent areal coverage for various wind thresholds
c     wfract_type 'earth' or 'storm' relative analysis
c     pdf_ct_bin array for pdf of wind magnitudes within r=350 km
c     pdf_ct_tot total count of pdf points for r < 350 km
c
c     OUTPUT:
c     ioaxret   integer return code from this subroutine
c
c     LOCAL:
c     intlon    integer that holds the value of outlon*10
c     intlat    integer that holds the value of outlat*10
c

      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE verbose_output

      type (datecard) inp
c
      integer, parameter :: numdist=14,numquad=4,numbin=5,numthresh=3
      real    outlon,outlat,pdfval
      real    wfract_cov(numquad+1,numbin,numthresh)
      real    vmaxwind,conv_ms_knots,xminmslp,xsfclon,xsfclat
      integer ::  windthresh(numthresh) = (/34,50,64/)
      integer pdf_ct_bin(16)
      integer intlon,intlat,output_fhr,intlon100,intlat100,pdf_ct_tot
      integer maxstorm
      character  basinid*2,clatns*1,clonew*1,wfract_type*5,wt*1,cquad*2

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0-180E or 0-180W, and convert the lat values so that they are
c     positive and use 'N' or 'S' to differentiate hemispheres.

      conv_ms_knots = 1.9427

      if (outlon < -998.0 .or. outlat < -998.0) then
        intlon = 0
        intlat = 0
        intlon100 = 0
        intlat100 = 0
        clonew = ' '
        clatns = ' '
      else
        if (outlon >= 180.0) then
          intlon = 3600 - int(outlon * 10. + 0.5)
          intlon100 = 36000 - int(outlon * 100. + 0.5)
          clonew = 'W'
        else
          intlon = int(outlon * 10. + 0.5)
          intlon100 = int(outlon * 100. + 0.5)
          clonew = 'E'
        endif
        intlat = int(abs(outlat) * 10. + 0.5)
        intlat100 = int(abs(outlat) * 100. + 0.5)
        if (outlat < 0.0) then
          clatns = 'S'
        else
          clatns = 'N'
        endif
      endif

      select case (storm(ist)%tcv_storm_id(3:3))
        case ('L','l');  basinid = 'AL'
        case ('E','e');  basinid = 'EP'
        case ('C','c');  basinid = 'CP'
        case ('W','w');  basinid = 'WP'
        case ('O','o');  basinid = 'SC'
        case ('T','t');  basinid = 'EC'
        case ('U','u');  basinid = 'AU'
        case ('P','p');  basinid = 'SP'
        case ('S','s');  basinid = 'SI'
        case ('B','b');  basinid = 'BB'
        case ('A','a');  basinid = 'AA'
        case ('Q','q');  basinid = 'SL'
        case default;    basinid = '**'
      end select

      if (atcfname(1:2) == 'SP') then
        ! Add 3 for SREF to account for the 3-hour off-synoptic
        ! time offset....
        output_fhr = ifcsthour + 3
      else
        output_fhr = ifcsthour
      endif

      if (wfract_type == 'earth') then
        wt = 'E'
      else if (wfract_type == 'storm') then
        wt = 'R'
      else
        wt = 'X'
      endif

      do ib = 1,numbin
        do it = 1,numthresh

          write (73,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &      ,atcfymdh
     &      ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &      ,int((vmaxwind*conv_ms_knots) + 0.5)
     &      ,int(xminmslp/100.0 + 0.5)
     &      ,', XX, ',0,ib*100,windthresh(it),'NE',wt
     &      ,int((1000.*wfract_cov(1,ib,it))+0.5)
     &      ,int((1000.*wfract_cov(2,ib,it))+0.5)
     &      ,int((1000.*wfract_cov(3,ib,it))+0.5)
     &      ,int((1000.*wfract_cov(4,ib,it))+0.5)
     &      ,intlat100,clatns,intlon100,clonew

        enddo
      enddo

      do ib = 1,numbin
        do it = 1,numthresh

          write (73,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &      ,atcfymdh
     &      ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &      ,int((vmaxwind*conv_ms_knots) + 0.5)
     &      ,int(xminmslp/100.0 + 0.5)
     &      ,', XX, ',0,ib*100,windthresh(it),'AA',wt
     &      ,int((1000.*wfract_cov(5,ib,it))+0.5)
     &      ,int((1000.*wfract_cov(5,ib,it))+0.5)
     &      ,int((1000.*wfract_cov(5,ib,it))+0.5)
     &      ,int((1000.*wfract_cov(5,ib,it))+0.5)
     &      ,intlat100,clatns,intlon100,clonew

        enddo
      enddo

   81 format (a2,', ',a2,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a6,i3.3,', ',i3.3,', '
     &       ,i3,', ',a2,a1,4(', ',i4),', ',i4,a1,', ',i5,a1)

c     --------------------------------------------------
c     Now compute and write out the pdf values for the
c     wind magnitude....
c     --------------------------------------------------

      do ip = 1,16
        pdfval = float(pdf_ct_bin(ip)) / float(pdf_ct_tot)
        write (76,85) atcfymdh,basinid,storm(ist)%tcv_storm_id(1:2)
     &               ,output_fhr,10*(ip-1),10*ip,pdf_ct_bin(ip)
     &               ,pdf_ct_tot,pdfval
      enddo

   85 format (1x,i10.10,3x,a2,a2,3x,i3,3x,i3.3,'_',i3.3,3x,i7,2x,i7
     &       ,2x,f6.3)
c
c     bug fix for IBM: flush the output stream so it actually writes
      flush(73)

      return
      end

c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_wind_structure (outlon,outlat,xsfclon
     &          ,xsfclat,inp,ist,ifcsthour,vmaxwind,xminmslp,er_wind
     &          ,sr_wind,er_vr,sr_vr,er_vt,sr_vt,maxstorm,iofwret)
c
c     ABSTRACT: This subroutine  outputs a 1-line message for a given
c     storm at an input forecast hour.  This message contains the
c     values of the winds at specified distances along 45-degree
c     radials in each storm quadrant.  These are  output
c     twice -- First, for an earth-relative coordinate system, and
c     second, for a storm-relative coordinate system.  For the
c     earth-relative estimates, we will always have 4 radials: NE, SE,
c     SW and NW (45,135,225,315).  For the storm-relative estimates,
c     these radials will be computed at the same relative angles (i.e.,
c     45,135,225,315), but with respect (positive clockwise) to the
c     direction of storm motion.  For example, for a storm moving with
c     a heading of 280, the wind structure is evaluated at these
c     radials: 325 (front-right; 45 deg CW from heading), 55 (back-
c     right; 135 deg CW from heading), 145 (back-left; 225 deg CW from
c     heading), 235 (front-left; 315 deg CW from heading).
c
c     LOCAL:
c       numdist   Number of discrete radii at which the winds will
c                 be evaluated
c
c
c     This format will mimic the current atcfunix format with the
c     difference coming late in the record, where the various wind radii
c     will be replaced with wind values at the 13 specified distances
c     (10, 25, 50, 75, 100, 150, 200, 250, 300, 350, 400, 450, 500 km)
c
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             71, NEE, 1137, 1221,  854,  655, etc., ... out to 500 km
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             71, SEE,  947,  982,  474,  396, etc., ... out to 500 km
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             71, SWE,  645,  683,  328,  277, etc., ... out to 500 km
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             71, NWE,  725,  753,  619,  429, etc., ... out to 500 km
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             72, FRR, 1134, 1224,  852,  654, etc., ... out to 500 km
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             72, BRR,  944,  984,  472,  393, etc., ... out to 500 km
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             72, BLR,  649,  686,  321,  272, etc., ... out to 500 km
c     AL, 13, 2000092500, 03, AVNO, 036, 243N,  675W,  42,  995, XX,
c             72, FLR,  729,  756,  613,  421, etc., ... out to 500 km
c
c     NOTE: Each of the above lines beginning with "AL" is output as
c           a single line of text.
c     NOTE: These winds are in m/s coming into this routine and will
c           be converted to knots*10 for output (e.g., 1221 = 122.1 kts)
c
c     The "71" ID indicates earth-relative winds, the "72" ID indicates
c     storm-relative winds.  Here are the other IDs that will be used:
c       81: Tangential winds, earth-relative (m/s)
c       82: Tangential winds, storm-relative (m/s)
c       91: Radial winds, earth-relative (m/s)
c       92: Radial winds, storm-relative (m/s)
c
c     Note that in this example, for this 36h forecast hour, there are
c     8 entries.  This is so that we can include the wind values for
c     the 4 different quadrants, for both the earth relative analyses
c     (NEE, SEE, SWE, NWE) and the storm-relative analyses (FRR, BRR,
c     BLR, FLR).
c
c     This message also contains the intensity estimates (in knots)
c     for every forecast hours  The  conversion for m/s to knots is
c     to multiply m/s by 1.9427 (3.281 ft/m, 1 naut mile/6080 ft,
c     3600s/h).
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The format for the
c     atcfunix system requires that the  output be 0-180E or
c     0-180W, so we must adjust the values, if needed.  Also, the
c     values for southern latitudes must be positive (use 'N' and
c     'S' to distinguish Northern/Southern Hemispheres).
c
c     INPUT:
c     outlon    longitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     outlat    latitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     inp       contains input date and model number information
c     ist       the number storm that we're processing (can be 1-15)
c     ifcsthr   the current forecast hour being output
c     vmaxwind  the max surface wind for this storm at this fcst hour
c     xminmslp  the min mslp for this storm at this fcst hour
c     er_wind   Quadrant winds in earth-relative framework
c     sr_wind   Quadrant winds in storm-relative framework
c     er_vr     Quadrant radial winds in earth-relative framework
c     sr_vr     Quadrant radial winds in storm-relative framework
c     er_vt     Quadrant tangential winds in earth-relative framework
c     sr_vt     Quadrant tangential winds in storm-relative framework
c
c     OUTPUT:
c     ioaxret   integer return code from this subroutine
c
c     LOCAL:
c     intlon    integer that holds the value of outlon*10
c     intlat    integer that holds the value of outlat*10
c

      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE verbose_output

      type (datecard) inp

      integer, parameter :: numdist=14,numquad=4,numbin=5,numthresh=3
      integer  ioutwind(numdist)
      real     fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real     er_wind(numquad,numdist)
      real     sr_wind(numquad,numdist)
      real     er_vr(numquad,numdist)
      real     er_vt(numquad,numdist)
      real     sr_vr(numquad,numdist)
      real     sr_vt(numquad,numdist)
      real     outlon,outlat
      real     vmaxwind,conv_ms_knots,xminmslp,xsfclon,xsfclat
      integer intlon,intlat,output_fhr,id,intlon100,intlat100,ir
      character  basinid*2,clatns*1,clonew*1,wfract_type*5,wt*1
      character*2 :: cquad(4) = (/'NE','SE','SW','NW'/)
      character*2 :: crel(4) = (/'FR','BR','BL','FL'/)


c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0-180E or 0-180W, and convert the lat values so that they are
c     positive and use 'N' or 'S' to differentiate hemispheres.

      conv_ms_knots = 1.9427

      if (outlon < -998.0 .or. outlat < -998.0) then
        intlon = 0
        intlat = 0
        intlon100 = 0
        intlat100 = 0
        clonew = ' '
        clatns = ' '
      else
        if (outlon >= 180.0) then
          intlon = 3600 - int(outlon * 10. + 0.5)
          intlon100 = 36000 - int(outlon * 100. + 0.5)
          clonew = 'W'
        else
          intlon = int(outlon * 10. + 0.5)
          intlon100 = int(outlon * 100. + 0.5)
          clonew = 'E'
        endif
        intlat = int(abs(outlat) * 10. + 0.5)
        intlat100 = int(abs(outlat) * 100. + 0.5)
        if (outlat < 0.0) then
          clatns = 'S'
        else
          clatns = 'N'
        endif
      endif

      select case (storm(ist)%tcv_storm_id(3:3))
        case ('L','l');  basinid = 'AL'
        case ('E','e');  basinid = 'EP'
        case ('C','c');  basinid = 'CP'
        case ('W','w');  basinid = 'WP'
        case ('O','o');  basinid = 'SC'
        case ('T','t');  basinid = 'EC'
        case ('U','u');  basinid = 'AU'
        case ('P','p');  basinid = 'SP'
        case ('S','s');  basinid = 'SI'
        case ('B','b');  basinid = 'BB'
        case ('A','a');  basinid = 'AA'
        case ('Q','q');  basinid = 'SL'
        case default;    basinid = '**'
      end select

      if (atcfname(1:2) == 'SP') then
        ! Add 3 for SREF to account for the 3-hour off-synoptic
        ! time offset....
        output_fhr = ifcsthour + 3
      else
        output_fhr = ifcsthour
      endif

c     Total wind (converted to knots*10), earth relative....

      do iq = 1,numquad
        do ir = 1,numdist
          if (er_wind(iq,ir) < -998.0) then
            ioutwind(ir) = -999
          else
            ioutwind(ir) = int((er_wind(iq,ir)*conv_ms_knots*10)+0.5)
          endif
        enddo
        write (72,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &    ,atcfymdh
     &    ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &    ,int((vmaxwind*conv_ms_knots) + 0.5)
     &    ,int(xminmslp/100.0 + 0.5)
     &    ,', XX, 71, ',cquad(iq),'E'
     &    ,(ioutwind(it),it=1,numdist)
     &    ,intlat100,clatns,intlon100,clonew
      enddo

c     Total wind (converted to knots*10), storm relative....

      do iq = 1,numquad
        do ir = 1,numdist
          if (sr_wind(iq,ir) < -998.0) then
            ioutwind(ir) = -999
          else
            ioutwind(ir) = int((sr_wind(iq,ir)*conv_ms_knots*10)+0.5)
          endif
        enddo
        write (72,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &    ,atcfymdh
     &    ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &    ,int((vmaxwind*conv_ms_knots) + 0.5)
     &    ,int(xminmslp/100.0 + 0.5)
     &    ,', XX, 72, ',crel(iq),'R'
     &    ,(ioutwind(it),it=1,numdist)
     &    ,intlat100,clatns,intlon100,clonew
      enddo

c     Tangential wind (m/s * 10), earth relative....

      do iq = 1,numquad
        do ir = 1,numdist
          if (er_vt(iq,ir) < -998.0) then
            ioutwind(ir) = -999
          else
            ioutwind(ir) = int((er_vt(iq,ir)*conv_ms_knots*10)+0.5)
          endif
        enddo
        write (72,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &    ,atcfymdh
     &    ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &    ,int((vmaxwind*conv_ms_knots) + 0.5)
     &    ,int(xminmslp/100.0 + 0.5)
     &    ,', XX, 81, ',cquad(iq),'E'
     &    ,(ioutwind(it),it=1,numdist)
     &    ,intlat100,clatns,intlon100,clonew
      enddo

c     Tangential wind (m/s * 10), storm relative....

      do iq = 1,numquad
        do ir = 1,numdist
          if (sr_vt(iq,ir) < -998.0) then
            ioutwind(ir) = -999
          else
            ioutwind(ir) = int((sr_vt(iq,ir)*conv_ms_knots*10)+0.5)
          endif
        enddo
        write (72,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &    ,atcfymdh
     &    ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &    ,int((vmaxwind*conv_ms_knots) + 0.5)
     &    ,int(xminmslp/100.0 + 0.5)
     &    ,', XX, 82, ',crel(iq),'R'
     &    ,(ioutwind(it),it=1,numdist)
     &    ,intlat100,clatns,intlon100,clonew
      enddo

c     Radial wind (m/s * 10), earth relative....

      do iq = 1,numquad
        do ir = 1,numdist
          if (er_vr(iq,ir) < -998.0) then
            ioutwind(ir) = -999
          else
            ioutwind(ir) = int((er_vr(iq,ir)*conv_ms_knots*10)+0.5)
          endif
        enddo
        write (72,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &    ,atcfymdh
     &    ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &    ,int((vmaxwind*conv_ms_knots) + 0.5)
     &    ,int(xminmslp/100.0 + 0.5)
     &    ,', XX, 91, ',cquad(iq),'E'
     &    ,(ioutwind(it),it=1,numdist)
     &    ,intlat100,clatns,intlon100,clonew
      enddo

c     Radial wind (m/s * 10), storm relative....

      do iq = 1,numquad
        do ir = 1,numdist
          if (sr_vr(iq,ir) < -998.0) then
            ioutwind(ir) = -999
          else
            ioutwind(ir) = int((sr_vr(iq,ir)*conv_ms_knots*10)+0.5)
          endif
        enddo
        write (72,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &    ,atcfymdh
     &    ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &    ,int((vmaxwind*conv_ms_knots) + 0.5)
     &    ,int(xminmslp/100.0 + 0.5)
     &    ,', XX, 92, ',crel(iq),'R'
     &    ,(ioutwind(it),it=1,numdist)
     &    ,intlat100,clatns,intlon100,clonew
      enddo
c
   81 format (a2,', ',a2,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,a10,a2,a1,14(', ',i4)
     &       ,', ',i4,a1,', ',i5,a1)

c     bug fix for IBM: flush the output stream so it actually writes
      flush(72)

      return
      end

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_ike (outlon,outlat,xsfclon,xsfclat,inp,ist
     &          ,ifcsthour,vmaxwind,xminmslp,ike,sdp,wdp,maxstorm
     &          ,ioiret)
c
c     ABSTRACT: This subroutine  outputs a 1-line message for a given
c     storm at an input forecast hour.  This message contains the values
c     for the Integrated Kinetic Energy (IKE) and Storm Surge Damage
c     Potential (SDP), based on Powell (BAMS, 2007).  At this time, we
c     are only computing the IKE values for TS threshold (17.5 m/s) and
c     above.  We are not yet computing wind damage potential (WDP)
c     since, per Mark Powell (4/2008), he is currently re-formulating
c     an algorithm for it.
c
c     LOCAL:
c
c     Arrays:
c
c     ike   Integrated kinetic energy:
c           ike(1) = IKE_10m/s  (storm energy)
c           ike(2) = IKE_18m/s  (IKE_ts, tropical storm)
c           ike(3) = IKE_33m/s  (IKE_h,  hurricane)
c           ike(4) = IKE_25_40 m/s  (Not currently computed)
c           ike(5) = IKE_41_54 m/s  (Not currently computed)
c           ike(6) = IKE_55 m/s     (Not currently computed)
c
c
c     The format used will mimic the current atcfunix format with the
c     difference coming late in the record, where the various wind radii
c     will be replaced with WDP, SDP and IKE values:
c
c     AL, 13, 2000092500, 03, AVNO, 036, 243N, 675W, 42, 995, XX,  91,
c             IKE,  340,  560,  212,  174,   42,   93,   12,    0
c
c     Where the places are identified as follows:
c
c     AL, 13, 2000092500, 03, AVNO, 036, 243N, 675W, 42, 995, XX,  91,
c             IKE,  WDP,  SDP,  I10,  ITS,  IH ,I2540,I4154,  I55
c
c     (NOTE: Each of the above lines beginning with "AL" is output as
c            a single line of text.)
c
c     Values for WDP and SDP are multiplied by 10 in this routine
c     before being written out.
c
c     This message also contains the intensity estimates (in knots)
c     for every forecast hour.  The  conversion for m/s to knots is
c     to multiply m/s by 1.9427 (3.281 ft/m, 1 naut mile/6080 ft,
c     3600s/h).
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The format for the
c     atcfunix system requires that the  output be 0-180E or
c     0-180W, so we must adjust the values, if needed.  Also, the
c     values for southern latitudes must be positive (use 'N' and
c     'S' to distinguish Northern/Southern Hemispheres).
c
c     INPUT:
c     storm     An array of type tcvcard.  Use this for the storm ID
c     outlon    longitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     outlat    latitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     xsfclon   low-level longitude estimate for this storm & time,
c               computed ideally from mean of mslp & low-level winds.
c     xsfclat   low-level latitude estimate for this storm & time,
c               computed ideally from mean of mslp & low-level winds.
c     inp       contains input date and model number information
c     ist       the number storm that we're processing (can be 1-15)
c     ifcsthr   the current forecast hour being output
c     vmaxwind  the max surface wind for this storm at this fcst hour
c     xminmslp  the min mslp for this storm at this fcst hour
c     ike       integrated kinetic energy, in units of TJ
c     sdp       storm surge damage potential
c     wdp       wind damage potential
c
c     OUTPUT:
c     ioaxret   integer return code from this subroutine
c
c     LOCAL:
c     intlon    integer that holds the value of outlon*10
c     intlat    integer that holds the value of outlat*10
c

      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE verbose_output

      type (datecard) inp
c
      integer, parameter :: numdist=14,numquad=4,numbin=5,numthresh=3
      real    outlon,outlat,sdp,wdp
      real    ike(max_ike_cats)
      real    vmaxwind,conv_ms_knots,xminmslp,xsfclon,xsfclat
      integer intlon,intlat,output_fhr,intlon100,intlat100,maxstorm
      character  basinid*2,clatns*1,clonew*1,wfract_type*5,wt*1,cquad*2

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0-180E or 0-180W, and convert the lat values so that they are
c     positive and use 'N' or 'S' to differentiate hemispheres.

      conv_ms_knots = 1.9427

      if (outlon < -998.0 .or. outlat < -998.0) then
        intlon = 0
        intlat = 0
        intlon100 = 0
        intlat100 = 0
        clonew = ' '
        clatns = ' '
      else
        if (outlon >= 180.0) then
          intlon = 3600 - int(outlon * 10. + 0.5)
          intlon100 = 36000 - int(outlon * 100. + 0.5)
          clonew = 'W'
        else
          intlon = int(outlon * 10. + 0.5)
          intlon100 = int(outlon * 100. + 0.5)
          clonew = 'E'
        endif
        intlat = int(abs(outlat) * 10. + 0.5)
        intlat100 = int(abs(outlat) * 100. + 0.5)
        if (outlat < 0.0) then
          clatns = 'S'
        else
          clatns = 'N'
        endif
      endif

      select case (storm(ist)%tcv_storm_id(3:3))
        case ('L','l');  basinid = 'AL'
        case ('E','e');  basinid = 'EP'
        case ('C','c');  basinid = 'CP'
        case ('W','w');  basinid = 'WP'
        case ('O','o');  basinid = 'SC'
        case ('T','t');  basinid = 'EC'
        case ('U','u');  basinid = 'AU'
        case ('P','p');  basinid = 'SP'
        case ('S','s');  basinid = 'SI'
        case ('B','b');  basinid = 'BB'
        case ('A','a');  basinid = 'AA'
        case ('Q','q');  basinid = 'SL'
        case default;    basinid = '**'
      end select

      if (atcfname(1:2) == 'SP') then
        ! Add 3 for SREF to account for the 3-hour off-synoptic
        ! time offset....
        output_fhr = ifcsthour + 3
      else
        output_fhr = ifcsthour
      endif

      write (74,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &  ,atcfymdh
     &  ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &  ,int((vmaxwind*conv_ms_knots) + 0.5)
     &  ,int(xminmslp/100.0 + 0.5)
     &  ,', XX,  91, IKE',int((wdp*10)+0.5),int((sdp*10)+0.5)
     &  ,int(ike(1)+0.5),int(ike(2)+0.5),int(ike(3)+0.5)
     &  ,int(ike(4)+0.5),int(ike(5)+0.5),int(ike(6)+0.5)
     &  ,intlat100,clatns,intlon100,clonew
c
   81 format (a2,', ',a2,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,a14,8(',',i5)
     &       ,', ',i4,a1,', ',i5,a1)

c     bug fix for IBM: flush the output stream so it actually writes
      flush(74)

      return
      end

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_phase (outlon,outlat,inp,ist
     &          ,ifcsthour,vmaxwind,xminmslp,paramb,vtl_slope
     &          ,vtu_slope,ioiret)
c
c     ABSTRACT: This subroutine  outputs a 1-line message for a given
c     storm at an input forecast hour.  This message contains the values
c     for the three parameters that comprise Bob Hart's cyclone phase
c     space (CPS).  These parameters are his "parameter B", which
c     assesses the left-right thermal asymmetry, and the upper
c     troposphere (300-600 mb) and lower troposphere (900-600 mb)
c     thermal wind values.
c
c     LOCAL:
c
c     Arrays:
c
c     The format used will mimic the current atcfunix format with the
c     difference coming late in the record, where the various wind radii
c     will be replaced with paramb, vtl_slope and vtu_slope values:
c
c     AL, 13, 2000092500, 03, AVNO, 036, 243N, 675W, 42, 995, XX,  95,
c             CPS,   340,   560,   212
c
c     Where the places are identified as follows:
c
c     AL, 13, 2000092500, 03, AVNO, 036, 243N, 675W, 42, 995, XX,  95,
c             CPS,     B,   VTL,   VTU
c
c     (NOTE: Each of the above lines beginning with "AL" is output as
c            a single line of text.)
c
c     This message also contains the intensity estimates (in knots)
c     for every forecast hour.  The  conversion for m/s to knots is
c     to multiply m/s by 1.9427 (3.281 ft/m, 1 naut mile/6080 ft,
c     3600s/h).
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The format for the
c     atcfunix system requires that the  output be 0-180E or
c     0-180W, so we must adjust the values, if needed.  Also, the
c     values for southern latitudes must be positive (use 'N' and
c     'S' to distinguish Northern/Southern Hemispheres).
c
c     INPUT:
c     storm     An array of type tcvcard.  Use this for the storm ID
c     outlon    longitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     outlat    latitude  fix position for this storm at this time
c               which is to be written out to the  output file
c     inp       contains input date and model number information
c     ist       the number storm that we're processing (can be 1-15)
c     ifcsthr   the current forecast hour being output
c     vmaxwind  the max surface wind for this storm at this fcst hour
c     xminmslp  the min mslp for this storm at this fcst hour
c     paramb    thermal asymmetry
c     vtl_slope thermal wind value for lower troposphere (900-600 mb)
c     vtu_slope thermal wind value for upper troposphere (600-300 mb)
c
c     OUTPUT:
c     ioiret    integer return code from this subroutine
c
c     LOCAL:
c     intlon    integer that holds the value of outlon*10
c     intlat    integer that holds the value of outlat*10
c

      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE verbose_output

      type (datecard) inp

      real    outlon,outlat,paramb,vtl_slope,vtu_slope
      real    vmaxwind,conv_ms_knots,xminmslp
      integer intlon,intlat,output_fhr
      character  basinid*2,clatns*1,clonew*1

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0-180E or 0-180W, and convert the lat values so that they are
c     positive and use 'N' or 'S' to differentiate hemispheres.

      conv_ms_knots = 1.9427

      if (outlon < -998.0 .or. outlat < -998.0) then
        intlon = 0
        intlat = 0
        clonew = ' '
        clatns = ' '
      else
        if (outlon >= 180.0) then
          intlon = 3600 - int(outlon * 10. + 0.5)
          clonew = 'W'
        else
          intlon = int(outlon * 10. + 0.5)
          clonew = 'E'
        endif
        intlat = int(abs(outlat) * 10. + 0.5)
        if (outlat < 0.0) then
          clatns = 'S'
        else
          clatns = 'N'
        endif
      endif

      select case (storm(ist)%tcv_storm_id(3:3))
        case ('L','l');  basinid = 'AL'
        case ('E','e');  basinid = 'EP'
        case ('C','c');  basinid = 'CP'
        case ('W','w');  basinid = 'WP'
        case ('O','o');  basinid = 'SC'
        case ('T','t');  basinid = 'EC'
        case ('U','u');  basinid = 'AU'
        case ('P','p');  basinid = 'SP'
        case ('S','s');  basinid = 'SI'
        case ('B','b');  basinid = 'BB'
        case ('A','a');  basinid = 'AA'
        case ('Q','q');  basinid = 'SL'
        case default;    basinid = '**'
      end select

      if (atcfname(1:2) == 'SP') then
        ! Add 3 for SREF to account for the 3-hour off-synoptic
        ! time offset....
        output_fhr = ifcsthour + 3
      else
        output_fhr = ifcsthour
      endif

      write (71,81) basinid,storm(ist)%tcv_storm_id(1:2)
     &  ,atcfymdh
     &  ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &  ,int((vmaxwind*conv_ms_knots) + 0.5)
     &  ,int(xminmslp/100.0 + 0.5)
     &  ,', XX,  95, CPS',int(paramb+0.5),int(vtl_slope+0.5)
     &  ,int(vtu_slope+0.5)
c
   81 format (a2,', ',a2,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a14,3(',',i6))

c     bug fix for IBM: flush the output stream so it actually writes
      flush(71)

      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_atcf_gen (outlon,outlat,inp,ist
     &         ,ifcsthour,vmaxwind,xminmslp,vradius,maxstorm
     &         ,trkrinfo,istmspd,istmdir,plastbar,rlastbar,rmax
     &         ,cps_vals,wcore_flag,imeanzeta,igridzeta,ioaxret)

c     ABSTRACT: This subroutine  outputs a 1-line message for a given 
c     storm at an input forecast hour in a modified atcfunix format.  
c     The reason that it's called "modified" is that the format is 
c     slightly different from the standard TPC-accepted atcfunix 
c     format that they use for TCs.  Specifically, the first part that
c     identifies the storm is different.  Here's an example of the 
c     TPC standard atcfunix format:
c
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  34,
c             NEQ,  242,  163,  124,  208
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  50,
c             NEQ,  155,  000,  000,  000
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  64,
c             NEQ,  000,  000,  000,  000
c
c     (NOTE: Each of the above lines beginning with "AL" is output as 
c            a single line of text.... they're just broken up into 2 
c            lines here for readability.)
c
c     Here's an example of the modified output format for the same 
c     storm.  Note that the lat/lon identifier in the new storm id at
c     the beginning of the record is different from that shown later
c     in the record.  The reason is that the lat/lon identifier will
c     be the one that is pulled from the tcvitals or gen_vitals 
c     record:
c
c     2000092500_230N_0658W_13L, 2000092500, 03, GFSO, 036, 243N, 675W,
c             42, 995, XX,  34, NEQ,  242,  163,  124,  208
c     2000092500_230N_0658W_13L, 2000092500, 03, GFSO, 036, 243N, 675W,
c             42, 995, XX,  50, NEQ,  155,  000,  000,  000
c     2000092500_230N_0658W_13L, 2000092500, 03, GFSO, 036, 243N, 675W,
c             42, 995, XX,  64, NEQ,  000,  000,  000,  000
c
c
c     Note that in this example, for this 36h forecast hour, there are 
c     3 entries.  This is so that we can include the radii for the 
c     3 different wind thresholds (34kt, 50kt and 64kt).  So the only
c     thing different in each entry is the wind radii info;  all the
c     other info is identical for each entry.
c
c     This message also contains the intensity estimates (in knots) 
c     for every forecast hours  The  conversion for m/s to knots is 
c     to multiply m/s by 1.9427 (3.281 ft/m, 1 naut mile/6080 ft, 
c     3600s/h).
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The format for the 
c     atcfunix system requires that the  output be 0-180E or
c     0-180W, so we must adjust the values, if needed.  Also, the
c     values for southern latitudes must be positive (use 'N' and 
c     'S' to distinguish Northern/Southern Hemispheres).
c
c     INPUT:
c     outlon    longitude  fix position for this storm at this time 
c               which is to be written out to the  output file
c     outlat    latitude  fix position for this storm at this time 
c               which is to be written out to the  output file
c     inp       contains input date and model number information
c     ist       the number storm that we're processing (can be 1-15)
c     ifcsthr   the current forecast hour being output
c     vmaxwind  the max surface wind for this storm at this fcst hour
c     xminmslp  the min mslp for this storm at this fcst hour
c     vradius   Contains the distance from the storm fix position to
c               each of the various wind threshhold distances in each
c               quadrant. (3,4) ==> (# of threshholds, # of quadrants)
c     maxstorm  max # of storms that can be handled
c     istmspd   storm translation speed
c     istmdir   direction of storm movement
c     plastbar  pressure of last closed isobar
c     rlastbar  radius of last closed isobar
c     rmax      radius of max winds
c     cps_vals  Hart's cyclone phase space values: (1) is for parameter
c               B (thickness asymmetry), (2) and (3) are for thermal
c               wind values.
c     wcore_flag 'u'=undetermined, 'y'=yes, 'n'=no
c     imeanzeta array with values of mean 850 & 700 zeta
c     igridzeta array with values of max (gridpoint) 850 & 700 zeta
c 
c     OUTPUT:
c     ioaxret   integer return code from this subroutine
c     
c     LOCAL:
c     intlon    integer that holds the value of outlon*10
c     intlat    integer that holds the value of outlat*10
c     storm     An array of type tcvcard.  Use this for the storm ID
c

      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE trkrparms; USE gen_vitals; USE level_parms
      USE verbose_output

      type (gencard) gstm
      type (datecard) inp
      type (trackstuff) trkrinfo
c
      real    outlon,outlat,plastbar,rlastbar,rmax
      real    vmaxwind,conv_ms_knots,xminmslp,mslp_outp_adj
      real    cps_vals(3)
      integer intlon,intlat,istmspd,istmdir,iplastbar,irlastbar,irmax
      integer ivtl,ivtu,iparamb,output_fhr
      integer vradius(3,4)
      integer imeanzeta(nlevgrzeta),igridzeta(nlevgrzeta)
      character  basinid*2,clatns*1,clonew*1,wcore_flag*1

      if ( verb .ge. 3) then
        print *,'+++ Top of output_atcf_gen, ist= ',ist,' ifh= '
     &         ,ifcsthour
      endif


      if (xminmslp == 999999.0) xminmslp = 0.0

      if (xminmslp < 1100.0) then
        ! Pressure units are in mb...
        mslp_outp_adj = 1.0
      elseif (xminmslp >80000.0) then
        ! Pressure units are in Pa...
        mslp_outp_adj = 100.0
      else
        if (verb .ge. 3) then
          print *,' '
          print *,'ERROR: Something wrong in subroutine'
          print *,'       output_atcf_gen.  The mslp value'
          print *,'       (xminmslp) is not in range.'
          print *,'       xminmslp = ',xminmslp
          print *,'       EXITING....'
          print *,' '
          stop 95
        endif
      endif

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0-180E or 0-180W, and convert the lat values so that they are
c     positive and use 'N' or 'S' to differentiate hemispheres.

      conv_ms_knots = 1.9427

      if (outlon < -998.0 .or. outlat < -998.0) then
        intlon = 0
        intlat = 0
        clonew = ' '
        clatns = ' '
      else
        if (outlon >= 180.0) then
          intlon = 3600 - int(outlon * 10. + 0.5)
          clonew = 'W'
        else
          intlon = int(outlon * 10. + 0.5)
          clonew = 'E'
        endif
        intlat = int(abs(outlat) * 10. + 0.5)
        if (outlat < 0.0) then
          clatns = 'S'
        else
          clatns = 'N'
        endif
      endif

c     Unlike the regular atcfunix output, in which we  output a record
c     at forecast time = 00h even if the storm cannot be found, here
c     we don't want to do that.  So check the lat & lon positions and
c     exit this subroutine now if they're both zero.

      if (intlat == 0 .and. intlon == 0) then
        if ( verb .ge. 3 ) then
          print *,' '
          print *,'+++ Currently inside  output_atcf_gen.  The reported'
          print *,'+++ longitude and latitude are both zero, so that '
          print *,'+++ means that the  tracker could not get a fix '
          print *,'+++ for this storm at this hour.  Therefore, we will'
          print *,'+++ NOT write out an atcf_gen record for this'
          print *,'+++ storm & forecast hour.'
          print *,'+++ '
          print *,'+++ ist= ',ist
          print *,'+++ gstorm= ',gstorm(ist)
          print *,' '
        endif

        return
      endif

c     Initially, set all "gstm" components equal to the input "gstorm"
c     components for this storm, then we will change the specific
c     components that we need to.

      gstm = gstorm(ist)

c     If the "gv_gen_date" for this storm does not equal 99999,
c     then that means that a vitals was read in for this storm in
c     subroutine  read_gen_vitals, so be sure to use the genesis
c     date, genesis latitude and genesis longitude for the storm
c     identifier at the beginning of the modified atcfunix record.

      if (gstm%gv_gen_date /= 99999) then

        continue    ! Just use the info off the genesis vitals record

      else
          
        ! This storm was found on the fly during
        ! this run and there was no previous vitals record for
        ! this system.  The information that will be used to 
        ! identify the genesis location is the same exact info
        ! as the  tracker-found position for this time.

        gstm%gv_gen_date = inp%bcc * 100000000
     &                   + inp%byy * 1000000
     &                   + inp%bmm * 10000
     &                   + inp%bdd * 100
     &                   + inp%bhh

        gstm%gv_gen_fhr   = ifcsthour
        gstm%gv_gen_lat   = intlat
        gstm%gv_gen_latns = clatns
        gstm%gv_gen_lon   = intlon
        gstm%gv_gen_lonew = clonew
        gstm%gv_gen_type  = 'FOF'

      endif

      if (plastbar > -990.0) then
        iplastbar = int(plastbar/mslp_outp_adj + 0.5)
      else
        iplastbar = -999
      endif

      if (rlastbar > -990.0) then
        irlastbar = int(rlastbar + 0.5)
      else
        irlastbar = -999
      endif

      if (rmax > -90.0) then
        irmax = int(rmax + 0.5)
      else
        irmax = -99
      endif

      if (cps_vals(1) > -9999.0) then
        if (cps_vals(1) >= 0.0) then
          iparamb = int(cps_vals(1)*10 + 0.5)
        else
          iparamb = int(cps_vals(1)*10 - 0.5)
        endif
      else
        iparamb = -999
      endif

      if (cps_vals(2) > -9999.0) then
        if (cps_vals(2) >= 0.0) then
          ivtl = int(cps_vals(2)*10 + 0.5)
        else
          ivtl = int(cps_vals(2)*10 - 0.5)
        endif
      else
        ivtl = -9999
      endif

      if (cps_vals(3) > -9999.0) then
        if (cps_vals(3) >= 0.0) then
          ivtu = int(cps_vals(3)*10 + 0.5)
        else
          ivtu = int(cps_vals(3)*10 - 0.5)
        endif
      else
        ivtu = -9999
      endif

      select case (storm(ist)%tcv_storm_id(3:3))
        case ('L','l');  basinid = 'AL'
        case ('E','e');  basinid = 'EP'
        case ('C','c');  basinid = 'CP'
        case ('W','w');  basinid = 'WP'
        case ('O','o');  basinid = 'SC'
        case ('T','t');  basinid = 'EC'
        case ('U','u');  basinid = 'AU'
        case ('P','p');  basinid = 'SP'
        case ('S','s');  basinid = 'SI'
        case ('B','b');  basinid = 'BB'
        case ('A','a');  basinid = 'AA'
        case ('Q','q');  basinid = 'SL'
        case default;    basinid = 'HC'
      end select

      if (atcfname(1:2) == 'SP') then
        ! Add 3 for SREF to account for the 3-hour off-synoptic
        ! time offset....
        output_fhr = ifcsthour + 3
      else
        output_fhr = ifcsthour
      endif

      if (stcvtype(ist) == 'FOF') then
        ! If this is a TC vitals-described storm (i.e., one that is
        ! numbered by JTWC or NHC), then leave the basinid as is.
        ! Otherwise, we want to use the "basinid" location as a
        ! label to identify what type of run this is.
        if (trkrinfo%type == 'midlat') basinid = 'ML'
        if (trkrinfo%type == 'tcgen')  basinid = 'TG'
      endif

      write (66,87) basinid,adjustr(storm(ist)%tcv_storm_id)
     &      ,gstm%gv_gen_date,gstm%gv_gen_fhr,gstm%gv_gen_lat
     &      ,gstm%gv_gen_latns,gstm%gv_gen_lon
     &      ,gstm%gv_gen_lonew,gstm%gv_gen_type
     &      ,atcfymdh
     &      ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &      ,int((vmaxwind*conv_ms_knots) + 0.5)
     &      ,int(xminmslp/mslp_outp_adj + 0.5)
     &      ,'XX,  34, NEQ'
     &      ,vradius(1,1),vradius(1,2),vradius(1,3),vradius(1,4)
     &      ,iplastbar,irlastbar,irmax,iparamb,ivtl,ivtu,wcore_flag
     &      ,istmdir,istmspd
     &      ,imeanzeta(1),igridzeta(1),imeanzeta(2),igridzeta(2)

      if (vradius(2,1) > 0 .or. vradius(2,2) > 0 .or.
     &    vradius(2,3) > 0 .or. vradius(2,4) > 0) then
      write (66,87) basinid,adjustr(storm(ist)%tcv_storm_id)
     &        ,gstm%gv_gen_date,gstm%gv_gen_fhr,gstm%gv_gen_lat
     &        ,gstm%gv_gen_latns,gstm%gv_gen_lon
     &        ,gstm%gv_gen_lonew,gstm%gv_gen_type
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)                   
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  50, NEQ'
     &        ,vradius(2,1),vradius(2,2),vradius(2,3),vradius(2,4)
     &        ,iplastbar,irlastbar,irmax,iparamb,ivtl,ivtu,wcore_flag
     &        ,istmdir,istmspd
     &        ,imeanzeta(1),igridzeta(1),imeanzeta(2),igridzeta(2)
      endif

      if (vradius(3,1) > 0 .or. vradius(3,2) > 0 .or.
     &    vradius(3,3) > 0 .or. vradius(3,4) > 0) then
      write (66,87) basinid,adjustr(storm(ist)%tcv_storm_id)
     &        ,gstm%gv_gen_date,gstm%gv_gen_fhr,gstm%gv_gen_lat
     &        ,gstm%gv_gen_latns,gstm%gv_gen_lon
     &        ,gstm%gv_gen_lonew,gstm%gv_gen_type
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)                   
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  64, NEQ'
     &        ,vradius(3,1),vradius(3,2),vradius(3,3),vradius(3,4)
     &        ,iplastbar,irlastbar,irmax,iparamb,ivtl,ivtu,wcore_flag
     &        ,istmdir,istmspd
     &        ,imeanzeta(1),igridzeta(1),imeanzeta(2),igridzeta(2)
      endif

   87 format (a2,', ',a4,', ',i10.10,'_F',i3.3,'_',i3.3,a1,'_',i4.4,a1
     &       ,'_',a3,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,4(', ',i4.4)
     &       ,', ',3(i4,', '),3(i6,', '),a1,2(', ',i4),4(', ',i4))

c     bug fix for IBM: flush the output stream so it actually writes
      flush(66)

      return
      end

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_atcf_sink (outlon,outlat,inp,ist
     &         ,ifcsthour,vmaxwind,xminmslp,vradius,maxstorm
     &         ,trkrinfo,istmspd,istmdir,imeanzeta,igridzeta
     &         ,cps_vals,plastbar,rlastbar,ioaxret)

c     ABSTRACT: This subroutine  outputs a 1-line message for a given 
c     storm at an input forecast hour in a modified atcfunix format.  
c     The "sink" in the subroutine name indicates that this output
c     contains the whole kitchen sink of forecast storm info.
c     The reason that it's called "modified" is that the format is 
c     slightly different from the standard TPC-accepted atcfunix 
c     format that they use for TCs.  Specifically, the first part that
c     identifies the storm is different, and the part after the radii
c     data is different.  Here's an example of the TPC standard 
c     atcfunix format:
c
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  34,
c             NEQ,  242,  163,  124,  208
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  50,
c             NEQ,  155,  000,  000,  000
c     AL, 13, 2000092500, 03, GFSO, 036, 243N, 675W, 42, 995, XX,  64,
c             NEQ,  000,  000,  000,  000
c
c     (NOTE: Each of the above lines beginning with "AL" is output as 
c            a single line of text.... they're just broken up into 2 
c            lines here for readability.)
c
c     Here's an example of the modified output format for the same 
c     storm.  Note that the lat/lon identifier in the new storm id at
c     the beginning of the record is different from that shown later
c     in the record.  The reason is that the lat/lon identifier will
c     indicate the lat/lon at which the storm was *first* found in
c     the model.  The position may be either found within this run 
c     of the  tracker, or that position may have been pulled from the
c     tcvitals or gen_vitals record:
c
c     2000092500_F000_206N_0623W_13L, 2000092500, 03, GFSO, 036
c       , 243N, 675W,  42, 995, XX,  34, NEQ,  242,  163,  124,  208
c       , PLAS, RLAS, RMX, DIR, SPD,   B,   VTU,   VTL
c       , Z8MN, Z8MX, Z7MN, Z7MX
c
c     As noted above, there is extra info at the end, after the 
c     "34, NEQ,  242,  163,  124,  208" radii info.  Here is a key 
c     to indicate what these items are:
c
c     PLAS:  Pressure (mb) of last closed isobar
c     RLAS:  Radius of the last closed isobar in nm, 0 - 9999 nm.
c     RMX:   Radius of max winds, 0 - 999 nm.
c     DIR:   Direction of storm motion.
c     SPD:   Speed of storm motion (m/s * 10).
c     B:     Hart's CPS "Parameter B" thickness asymmetry value (m).
c     VTL:   Hart's CPS thermal wind (Lower, 900-600) value.
c     VTU:   Hart's CPS thermal wind (Upper, 600-300) value.
c     Z8MN:  Mean value of 850 mb zeta surrounding storm.
c     Z8MX:  Max value of 850 mb zeta near storm.
c     Z7MN:  Mean value of 700 mb zeta surrounding storm.
c     Z7MX:  Max value of 700 mb zeta near storm.
c
c     This message also contains the intensity estimates (in knots) 
c     for every forecast hour.  The  conversion for m/s to knots is 
c     to multiply m/s by 1.9427 (3.281 ft/m, 1 naut mile/6080 ft, 
c     3600s/h).
c
c     NOTE: The longitudes that are passed into this subroutine are
c     given in 0 - 360, increasing eastward.  The format for the 
c     atcfunix system requires that the  output be 0-180E or
c     0-180W, so we must adjust the values, if needed.  Also, the
c     values for southern latitudes must be positive (use 'N' and 
c     'S' to distinguish Northern/Southern Hemispheres).
c
c     INPUT:
c     outlon    longitude  fix position for this storm at this time 
c               which is to be written out to the  output file
c     outlat    latitude  fix position for this storm at this time 
c               which is to be written out to the  output file
c     inp       contains input date and model number information
c     ist       the number storm that we're processing (can be 1-15)
c     ifcsthr   the current forecast hour being output
c     vmaxwind  the max surface wind for this storm at this fcst hour
c     xminmslp  the min mslp for this storm at this fcst hour
c     vradius   Contains the distance from the storm fix position to
c               each of the various wind threshhold distances in each
c               quadrant. (3,4) ==> (# of threshholds, # of quadrants)
c     maxstorm  max # of storms that can be handled
c     istmspd   speed of storm translation
c     istmdir   direction of storm motion
c     cps_vals  Hart's cyclone phase space values: (1) is for parameter
c               B (thickness asymmetry), (2) and (3) are for thermal
c               wind values.
c     imeanzeta array with values of mean 850 & 700 zeta
c     igridzeta array with values of max (gridpoint) 850 & 700 zeta
c     plastbar  pressure of last closed isobar (pa)
c     rlastbar  radius of last closed isobar (nm)
c 
c     OUTPUT:
c     ioaxret   integer return code from this subroutine
c     
c     LOCAL:
c     intlon    integer that holds the value of outlon*10
c     intlat    integer that holds the value of outlat*10
c     storm     An array of type tcvcard.  Use this for the storm ID
c

      USE def_vitals; USE inparms; USE set_max_parms; USE atcf
      USE trkrparms; USE gen_vitals
      USE verbose_output

      type (gencard) gstm
      type (datecard) inp
      type (trackstuff) trkrinfo
c
      real    cps_vals(3)
      real    outlon,outlat,mslp_outp_adj
      real    vmaxwind,conv_ms_knots,xminmslp,plastbar,rlastbar
      integer intlon,intlat,istmspd,istmdir,iplastbar,irlastbar
      integer iparamb,ivtl,ivtu,output_fhr
      integer vradius(3,4)
      integer imeanzeta(2),igridzeta(2)
      character  basinid*2,clatns*1,clonew*1

      if ( verb .ge. 3 ) then
        print *,'+++ Top of output_atcf_sink, ist= ',ist,' ifh= '
     &       ,ifcsthour
      endif

      if (xminmslp == 999999.0) xminmslp = 0.0

      if (xminmslp < 1100.0) then
        ! Pressure units are in mb...
        mslp_outp_adj = 1.0
      elseif (xminmslp >80000.0) then
        ! Pressure units are in Pa...
        mslp_outp_adj = 100.0
      else
        if (verb .ge. 3) then
          print *,' '
          print *,'ERROR: Something wrong in subroutine'
          print *,'       output_atcf_gen.  The mslp value'
          print *,'       (xminmslp) is not in range.'
          print *,'       xminmslp = ',xminmslp
          print *,'       EXITING....'
          print *,' '
          stop 95
        endif
      endif

c     First convert all of the lat/lon values from reals into integers.
c     These integer values must be 10x their real value (eg. 125.4 will
c     be written out as 1254).  Convert the lon values so that they go
c     from 0-180E or 0-180W, and convert the lat values so that they are
c     positive and use 'N' or 'S' to differentiate hemispheres.

      conv_ms_knots = 1.9427

      if (outlon < -998.0 .or. outlat < -998.0) then
        intlon = 0
        intlat = 0
        clonew = ' '
        clatns = ' '
      else
        if (outlon >= 180.0) then
          intlon = 3600 - int(outlon * 10. + 0.5)
          clonew = 'W'
        else
          intlon = int(outlon * 10. + 0.5)
          clonew = 'E'
        endif
        intlat = int(abs(outlat) * 10. + 0.5)
        if (outlat < 0.0) then
          clatns = 'S'
        else
          clatns = 'N'
        endif
      endif

      select case (storm(ist)%tcv_storm_id(3:3))
        case ('L','l');  basinid = 'AL'
        case ('E','e');  basinid = 'EP'
        case ('C','c');  basinid = 'CP'
        case ('W','w');  basinid = 'WP'
        case ('O','o');  basinid = 'SC'
        case ('T','t');  basinid = 'EC'
        case ('U','u');  basinid = 'AU'
        case ('P','p');  basinid = 'SP'
        case ('S','s');  basinid = 'SI'
        case ('B','b');  basinid = 'BB'
        case ('A','a');  basinid = 'AA'
        case ('Q','q');  basinid = 'SL'
        case default;    basinid = 'HC'
      end select

      if (trkrinfo%type == 'midlat' .or. trkrinfo%type == 'tcgen') then

        if (stcvtype(ist) == 'FOF') then
          ! If this is a TC vitals-described storm (i.e., one that is
          ! numbered by JTWC or NHC), then leave the basinid as is.
          ! Otherwise, we want to use the "basinid" location as a 
          ! label to identify what type of run this is.
          if (trkrinfo%type == 'midlat') basinid = 'ML'
          if (trkrinfo%type == 'tcgen')  basinid = 'TG'
        endif
      endif

c     Unlike the regular atcfunix output, in which we  output a record
c     at forecast time = 00h even if the storm cannot be found, here
c     we don't want to do that.  So check the lat & lon positions and
c     exit this subroutine now if they're both zero.

      if (intlat == 0 .and. intlon == 0) then
        if ( verb .ge. 3 ) then
          print *,' '
          print *,'+++ Currently inside  output_atcf_gen.  The reported'
          print *,'+++ longitude and latitude are both zero, so that '
          print *,'+++ means that the  tracker could not get a fix '
          print *,'+++ for this storm at this hour.  Therefore, we will'
          print *,'+++ NOT write out an atcf_gen record for this'
          print *,'+++ storm & forecast hour.'
          print *,'+++ '
          print *,'+++ ist= ',ist
          print *,'+++ gstorm= ',gstorm(ist)
          print *,' '
        endif

        return
      endif

c     Initially, set all "gstm" components equal to the input "gstorm"
c     components for this storm, then we will change the specific
c     components that we need to.

      gstm = gstorm(ist)

c     If the "gv_gen_date" for this storm does not equal 99999,
c     then that means that a vitals was read in for this storm in
c     subroutine  read_gen_vitals, so be sure to use the genesis
c     date, genesis latitude and genesis longitude for the storm
c     identifier at the beginning of the modified atcfunix record.

      if (gstm%gv_gen_date /= 99999) then

        continue    ! Just use the info off the genesis vitals record

      else
          
        ! This storm was found on the fly during
        ! this run and there was no previous vitals record for
        ! this system.  The information that will be used to 
        ! identify the genesis location is the same exact info
        ! as the  tracker-found position for this time.

        gstm%gv_gen_date = inp%bcc * 100000000
     &                   + inp%byy * 1000000
     &                   + inp%bmm * 10000
     &                   + inp%bdd * 100
     &                   + inp%bhh

        gstm%gv_gen_fhr   = ifcsthour
        gstm%gv_gen_lat   = intlat
        gstm%gv_gen_latns = clatns
        gstm%gv_gen_lon   = intlon
        gstm%gv_gen_lonew = clonew
        gstm%gv_gen_type  = 'FOF'

        ! Transfer all this local "gstm" data back into the 
        ! saved "gstorm" array for use in subsequent fcst hrs...

        gstorm(ist) = gstm

      endif

      if (plastbar > -990.0) then
        iplastbar = int(plastbar/mslp_outp_adj + 0.5)
      else
        iplastbar = -999
      endif

      if (rlastbar > -990.0) then
        irlastbar = int(rlastbar + 0.5)
      else
        irlastbar = -999
      endif

      if (cps_vals(1) > -9999.0) then
        if (cps_vals(1) >= 0.0) then
          iparamb = int(cps_vals(1)*10 + 0.5)
        else
          iparamb = int(cps_vals(1)*10 - 0.5)
        endif
      else
        iparamb = -999
      endif

      if (cps_vals(2) > -9999.0) then
        if (cps_vals(2) >= 0.0) then
          ivtl = int(cps_vals(2)*10 + 0.5)
        else
          ivtl = int(cps_vals(2)*10 - 0.5)
        endif
      else
        ivtl = -9999
      endif

      if (cps_vals(3) > -9999.0) then
        if (cps_vals(3) >= 0.0) then
          ivtu = int(cps_vals(3)*10 + 0.5)
        else
          ivtu = int(cps_vals(3)*10 - 0.5)
        endif
      else
        ivtu = -9999
      endif

      if (atcfname(1:2) == 'SP') then
        ! Add 3 for SREF to account for the 3-hour off-synoptic
        ! time offset....
        output_fhr = ifcsthour + 3
      else
        output_fhr = ifcsthour
      endif

      write (68,87) basinid,storm(ist)%tcv_storm_id
     &      ,gstm%gv_gen_date,gstm%gv_gen_fhr,gstm%gv_gen_lat
     &      ,gstm%gv_gen_latns,gstm%gv_gen_lon
     &      ,gstm%gv_gen_lonew,gstm%gv_gen_type
     &      ,atcfymdh
     &      ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &      ,int((vmaxwind*conv_ms_knots) + 0.5)
     &      ,int(xminmslp/mslp_outp_adj + 0.5)
     &      ,'XX,  34, NEQ'
     &      ,vradius(1,1),vradius(1,2),vradius(1,3),vradius(1,4)
     &      ,iplastbar,irlastbar,-99,istmdir,istmspd
     &      ,iparamb,ivtl,ivtu
     &      ,imeanzeta(1),igridzeta(1),imeanzeta(2),igridzeta(2)
     &      ,storm(ist)%tcv_storm_name

      if (vradius(2,1) > 0 .or. vradius(2,2) > 0 .or.
     &    vradius(2,3) > 0 .or. vradius(2,4) > 0) then
        write (68,87) basinid,storm(ist)%tcv_storm_id
     &        ,gstm%gv_gen_date,gstm%gv_gen_fhr,gstm%gv_gen_lat
     &        ,gstm%gv_gen_latns,gstm%gv_gen_lon
     &        ,gstm%gv_gen_lonew,gstm%gv_gen_type
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  50, NEQ'
     &        ,vradius(2,1),vradius(2,2),vradius(2,3),vradius(2,4)
     &        ,iplastbar,irlastbar,-99,istmdir,istmspd
     &        ,iparamb,ivtl,ivtu
     &        ,imeanzeta(1),igridzeta(1),imeanzeta(2),igridzeta(2)
     &        ,storm(ist)%tcv_storm_name
      endif

      if (vradius(3,1) > 0 .or. vradius(3,2) > 0 .or.
     &    vradius(3,3) > 0 .or. vradius(3,4) > 0) then
        write (68,87) basinid,storm(ist)%tcv_storm_id
     &        ,gstm%gv_gen_date,gstm%gv_gen_fhr,gstm%gv_gen_lat
     &        ,gstm%gv_gen_latns,gstm%gv_gen_lon
     &        ,gstm%gv_gen_lonew,gstm%gv_gen_type
     &        ,atcfymdh
     &        ,adjustr(atcfname),output_fhr,intlat,clatns,intlon,clonew
     &        ,int((vmaxwind*conv_ms_knots) + 0.5)
     &        ,int(xminmslp/mslp_outp_adj + 0.5)
     &        ,'XX,  64, NEQ'
     &        ,vradius(3,1),vradius(3,2),vradius(3,3),vradius(3,4)
     &        ,iplastbar,irlastbar,-99,istmdir,istmspd
     &        ,iparamb,ivtl,ivtu
     &        ,imeanzeta(1),igridzeta(1),imeanzeta(2),igridzeta(2)
     &        ,storm(ist)%tcv_storm_name
      endif

c   87 format (i10.10,'_',i3.3,a1,'_',i4.4,a1,'_',a3,', ',5i2.2
c     &       ,', 03, ',a4,', ',i3.3,', ',i3,a1
c     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,4(', ',i4.4))

c   87 format (a2,', ',a4,', ',i10.10,'_F',i3.3,'_',i3.3,a1,'_',i4.4,a1
c     &       ,'_',a3,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
c     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,4(', ',i4.4)
c     &       ,', ',2(i4,', '),4(i3,', '),2(i5,', '),4(i4,', '),a9)

   87 format (a2,', ',a4,', ',i10.10,'_F',i3.3,'_',i3.3,a1,'_',i4.4,a1
     &       ,'_',a3,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,4(', ',i4.4)
     &       ,', ',2(i4,', '),i3,', ',2(i4,', '),3(i6,', '),4(i6,', ')
     &       ,a9)

c      write (68,87) gstm%gv_gen_date,gstm%gv_gen_lat
c     &      ,gstm%gv_gen_latns,gstm%gv_gen_lon
c     &      ,gstm%gv_gen_lonew,gstm%gv_gen_type
c     &      ,inp%bcc,inp%byy,inp%bmm,inp%bdd,inp%bhh
c     &      ,adjustr(atcfname),ifcsthour,intlat,clatns,intlon,clonew
c     &      ,int((vmaxwind*conv_ms_knots) + 0.5)
c     &      ,int(xminmslp/100.0 + 0.5)
c     &      ,'XX,  34, NEQ'
c     &      ,istmspd,istmdir,imeanzeta(1),igridzeta(1)
c     &      ,imeanzeta(2),igridzeta(2)
c
c   87 format (i10.10,'_',i3.3,a1,'_',i4.4,a1,'_',a3,', ',5i2.2
c     &       ,', 03, ',a4,', ',i3.3,', ',i3,a1
c     &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,6(', ',i4))

c     bug fix for IBM: flush the output stream so it actually writes
      flush(68)

      return
      end

c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine output_tcvitals (xlon,xlat,inp,ist,iovret)
c
c     ABSTRACT: This subroutine  outputs a tcvitals record.  The
c     lat/lon location is given by the xlon and xlat that are
c     input to this subroutine.
c
c     INPUT:
c     xlon   longitude of storm position to be  output
c     xlat   latitude of storm position to be  output
c     inp    contains input date and model number information
c     ist    the number storm that we're processing (can be 1-15)
c
c     OUTPUT:
c     iovret return code from this subroutine
c
c     OTHER:
c     storm  contains the tcvitals info (from module def_vitals)
c
      USE def_vitals; USE inparms; USE set_max_parms
      USE verbose_output

      type (tcvcard) stm
      type (datecard) inp
      real       xlon,xlat
c
      iovret = 0

c     Initially, set all "stm" components equal to the input "storm"
c     components for this storm, then we will change the specific
c     components that we need to.

      stm = storm(ist)

      stm%tcv_center = 'AEAR'

      stm%tcv_lat = int(abs(xlat) * 10. + 0.5)
      if (xlat < 0.0) then
        stm%tcv_latns = 'S'
      else
        stm%tcv_latns = 'N'
      endif

      if (xlon >= 180.) then
        stm%tcv_lon = 3600 - int(xlon * 10. + 0.5)
        stm%tcv_lonew = 'W'
      else
        stm%tcv_lon = int(xlon * 10. + 0.5)
        stm%tcv_lonew = 'E'
      endif
      
      if ( verb .ge. 3 ) then
        write (6,*) ' '
        write (6,21) stm
      endif

      write (65,21) stm
      
   21 format (a4,1x,a3,1x,a9,1x,i8.8,1x,i4.4,1x,i3,a1,1x,i4,a1,1x
     &       ,i3,1x,i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)
      
c     
c     bug fix for IBM: flush the output stream so it actually writes
      flush(65)

      return
      end

c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine output_gen_vitals (xlon,xlat,inp,ist,istmspd,istmdir
     &                             ,iovret)
c
c     ABSTRACT: This subroutine  outputs a modified vitals record.  
c     The lat/lon location is given by the xlon and xlat that are
c     input to this subroutine.
c
c     The reason that these are referred to as modified tcvitals is
c     that the format is different from standard TC vitals format.
c     The storm identifier is different than that for a standard 
c     tcvitals.  The storm identifier contains the date/time that 
c     the storm was first identified, and the lat/lon position at
c     which it was first identified.
c
c     EXAMPLE:  The following is a standard TC Vitals record, split
c               up over 3 lines:           
c
c       NHC  01L ALBERTO   20060614 1200 343N 0807W 035 093 1004 1012
c            0278 15 222 -999 -999 -999 -999 M -999 -999 -999 -999 72
c            520N  410W  -999 -999 -999 -999
c
c     EXAMPLE:  The following is the format for the "genesis" vitals,
c               split over 3 lines, for the same system:
c
c       2006061000_F000_210N_0853W_01L 20060614 1200 343N 0807W 035 093
c            1004 1012 0278 15 222 -999 -999 -999 -999 M -999 -999
c            -999 -999 72 520N  410W  -999 -999 -999 -999
c
c     EXAMPLE:  If the vitals record is for a non-officially numbered
c               system (i.e., any system that's not a TC being tracked
c               by NHC or JTWC), then the storm number is replaced
c               by the characters "FOF", for "Found On the Fly" by
c               the  tracker.               
c                                          
c       2006071500_F000_150N_0681W_FOF 20060718 1200 185N 0792W 035 093
c            1004 1012 0278 15 222 -999 -999 -999 -999 M -999 -999
c            -999 -999 72 520N  410W  -999 -999 -999 -999
c
c
c     INPUT:
c     xlon   longitude of storm position to be  output
c     xlat   latitude of storm position to be  output
c     inp    contains input date and model number information
c     ist    the number storm that we're processing (can be 1-15)
c
c     OUTPUT:
c     iovret return code from this subroutine
c
c     OTHER:
c     storm  contains the tcvitals info (from module def_vitals)
c
      USE def_vitals; USE gen_vitals; USE inparms; USE set_max_parms
      USE verbose_output

      implicit none

      type (gencard) gstm
      type (datecard) inp
      real       xlon,xlat
      integer    ist,iovret,istmspd,istmdir
c
      iovret = 0

c     Initially, set all "stm" components equal to the input "gstorm"
c     components for this storm, then we will change the specific
c     components that we need to.

      gstm = gstorm(ist)

c     If the "gv_gen_date" for this storm does not equal 99999, 
c     then that means that a vitals was read in for this storm in 
c     subroutine  read_gen_vitals, so be sure to use the genesis 
c     date, genesis latitude and genesis longitude for the storm
c     identifier at the beginning of the vitals record.

      if (gstm%gv_gen_date /= 99999) then

        if (gstm%gv_gen_type /= 'FOF') then
          ! If this is not a 'FOF' storm (found on the fly storm), then
          ! it must be a TC vitals storm, or a tropical cyclone, and we
          ! don't want to create a vitals record for a tropical cyclone,
          ! since we will rely on reading them from the TC Vitals 
          ! database instead.
          return
        endif

      else

        ! This storm is new in this forecast/analysis and was found on
        ! the fly in the first time level for this run and there was no
        ! previous vitals record for this system

        gstm%gv_gen_date = inp%bcc * 100000000
     &                   + inp%byy * 1000000
     &                   + inp%bmm * 10000
     &                   + inp%bdd * 100
     &                   + inp%bhh

        gstm%gv_gen_fhr = 0

        gstm%gv_gen_lat = int(abs(xlat) * 10. + 0.5)
        if (xlat < 0.0) then                    
          gstm%gv_gen_latns = 'S'
        else                 
          gstm%gv_gen_latns = 'N'
        endif                
                           
        if (xlon >= 180.) then
          gstm%gv_gen_lon = 3600 - int(xlon * 10. + 0.5)
          gstm%gv_gen_lonew = 'W'                      
        else                                        
          gstm%gv_gen_lon = int(xlon * 10. + 0.5)
          gstm%gv_gen_lonew = 'E'               
        endif

        gstm%gv_gen_type = 'FOF'

        ! Transfer all this local "gstm" data back into the 
        ! saved "gstorm" array for use in subsequent fcst hrs...

        gstorm(ist) = gstm

      endif

      gstm%gv_obs_ymd = inp%bcc * 1000000
     &                + inp%byy * 10000
     &                + inp%bmm * 100
     &                + inp%bdd

      gstm%gv_obs_hhmm = inp%bhh * 100

      gstm%gv_obs_lat = int(abs(xlat) * 10. + 0.5)
      if (xlat < 0.0) then                       
        gstm%gv_obs_latns = 'S'              
      else                    
        gstm%gv_obs_latns = 'N'
      endif                   
                          
      if (xlon >= 180.) then
        gstm%gv_obs_lon = 3600 - int(xlon * 10. + 0.5)
        gstm%gv_obs_lonew = 'W'                      
      else                                          
        gstm%gv_obs_lon = int(xlon * 10. + 0.5)  
        gstm%gv_obs_lonew = 'E'               
      endif

      gstm%gv_stdir = istmdir
      gstm%gv_stspd = istmspd

      gstm%gv_depth = 'U'

      if ( verb .ge. 3 ) then
        write (6,*) ' '
        write (6,21) gstm
      endif

      write (67,21) gstm

   21 format (i10,'_F',i3.3,'_',i3.3,a1,'_',i4.4,a1,'_',a3,1x,i8,1x
     &       ,i4.4,1x,i3.3,a1,1x,i4.4,a1,1x,i3,1x,i3,3(1x,i4),1x,i2,1x
     &       ,i3,4(1x,i4),1x,a1)
c
c     bug fix for IBM: flush the output stream so it actually writes
      flush(67)

      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine output_tracker_mask (masked_outc,lb,ifh,ifcsthour
     &                ,imax,jmax,iotmret)
c
c     ABSTRACT: This subroutine  outputs a GRIB record that contains the
c     "mask" used to mask out areas surrounding low pressure centers 
c     that have been found during the search at each forecast hour. This
c     mask is written out purely for diagnostic purposes.  The GRIB 
c     identifier given to the mask in the pds is 850 mb height (you can 
c     make it anything you want).  This is only done for the "midlat"
c     and "tcgen" cases, since the runs for those cases use a mask while
c     the regular "tracker" run (that is, the run which strictly tracks
c     only those storms in the TC vitals file) does not.
c
c     INPUT:
c     masked_outc logical array containing mask
c     ifh         integer counter for current forecast hour
c     ifcsthour   integer current forecast hour
c     imax     num points is i-direction of input grid
c     jmax     num points is j-direction of input grid
c
c     OUTPUT:
c     iotmret  return code from this subroutine

      implicit none
c
      integer   ifh,imax,jmax,iotmret,kf,igoret,iix,jjx,ipret
      integer   ifcsthour
      integer   kpds(200),kgds(200)
      logical(1) masked_outc(imax,jmax),lb(imax,jmax)
      real      xmask(imax,jmax)
c
      if (ifh == 1) then
        call baopenw (77,"fort.77",igoret)
        print *,'baopenw: igoret= ',igoret

        if (igoret /= 0) then
          print *,' '
          print *,'!!! ERROR in sub output_tracker_mask opening'
          print *,'!!! **OUTPUT** grib files.  baopenw return codes:'
          print *,'!!! grib file 1 return code = igoret = ',igoret
          STOP 95
          return    
        endif   
      endif  

      xmask = 0.0
      do jjx = 1,jmax
        do iix = 1,imax
          if (masked_outc(iix,jjx)) then
            xmask(iix,jjx) = 1.0
          else
            xmask(iix,jjx) = 0.0
          endif
        enddo  
      enddo  

      kf = imax * jmax

c      kpds(5)  =       7  
c      kpds(6)  =     100
c      kpds(7)  =     850
c      kpds(22) =       0

      kpds(1)  =       7  ;    kpds(2)  =      80
      kpds(3)  =     255  ;    kpds(4)  =     192
      kpds(5)  =       7  ;    kpds(6)  =     100
      kpds(7)  =     850  ;    kpds(8)  =      99
      kpds(9)  =       7  ;    kpds(10) =      20
      kpds(11) =      12  ;    kpds(12) =       0
      kpds(13) =       1  ;    kpds(14) =  ifcsthour
      kpds(15) =       0  ;    kpds(16) =      10
      kpds(17) =       0  ;    kpds(18) =       1
      kpds(19) =       2  ;    kpds(20) =       0
      kpds(21) =      20  ;    kpds(22) =       0
      kpds(23) =       0  ;    kpds(24) =       0
      kpds(25) =       0
      kgds(1)  =       0  ;    kgds(2)  =    imax
      kgds(3)  =    jmax  ;    kgds(4)  =  -90000
      kgds(5)  =       0  ;    kgds(6)  =     128
      kgds(7)  =   90000  ;    kgds(8)  =  359750
      kgds(9)  =     250  ;    kgds(10) =     250
      kgds(11) =      64  ;    kgds(12) =       0
      kgds(13) =       0  ;    kgds(14) =       0
      kgds(15) =       0  ;    kgds(16) =       0
      kgds(17) =       0  ;    kgds(18) =       0
      kgds(19) =       0  ;    kgds(20) =     255

      write(*,980) kpds(1),kpds(2)
      write(*,981) kpds(3),kpds(4)
      write(*,982) kpds(5),kpds(6)
      write(*,983) kpds(7),kpds(8)
      write(*,984) kpds(9),kpds(10)
      write(*,985) kpds(11),kpds(12)
      write(*,986) kpds(13),kpds(14)
      write(*,987) kpds(15),kpds(16)
      write(*,988) kpds(17),kpds(18)
      write(*,989) kpds(19),kpds(20)
      write(*,990) kpds(21),kpds(22)
      write(*,991) kpds(23),kpds(24)
      write(*,992) kpds(25)
      write(*,880) kgds(1),kgds(2)
      write(*,881) kgds(3),kgds(4)
      write(*,882) kgds(5),kgds(6)
      write(*,883) kgds(7),kgds(8)
      write(*,884) kgds(9),kgds(10)
      write(*,885) kgds(11),kgds(12)
      write(*,886) kgds(13),kgds(14)
      write(*,887) kgds(15),kgds(16)
      write(*,888) kgds(17),kgds(18)
      write(*,889) kgds(19),kgds(20)
      write(*,890) kgds(21),kgds(22)
c
  980 format('tmow    kpds(1)  = ',i7,'  kpds(2)  = ',i7)
  981 format('tmow    kpds(3)  = ',i7,'  kpds(4)  = ',i7)
  982 format('tmow    kpds(5)  = ',i7,'  kpds(6)  = ',i7)
  983 format('tmow    kpds(7)  = ',i7,'  kpds(8)  = ',i7)
  984 format('tmow    kpds(9)  = ',i7,'  kpds(10) = ',i7)
  985 format('tmow    kpds(11) = ',i7,'  kpds(12) = ',i7)
  986 format('tmow    kpds(13) = ',i7,'  kpds(14) = ',i7)
  987 format('tmow    kpds(15) = ',i7,'  kpds(16) = ',i7)
  988 format('tmow    kpds(17) = ',i7,'  kpds(18) = ',i7)
  989 format('tmow    kpds(19) = ',i7,'  kpds(20) = ',i7)
  990 format('tmow    kpds(21) = ',i7,'  kpds(22) = ',i7)
  991 format('tmow    kpds(23) = ',i7,'  kpds(24) = ',i7)
  992 format('tmow    kpds(25) = ',i7)
  880 format('tmow    kgds(1)  = ',i7,'  kgds(2)  = ',i7)
  881 format('tmow    kgds(3)  = ',i7,'  kgds(4)  = ',i7)
  882 format('tmow    kgds(5)  = ',i7,'  kgds(6)  = ',i7)
  883 format('tmow    kgds(7)  = ',i7,'  kgds(8)  = ',i7)
  884 format('tmow    kgds(9)  = ',i7,'  kgds(10) = ',i7)
  885 format('tmow    kgds(11) = ',i7,'  kgds(12) = ',i7)
  886 format('tmow    kgds(13) = ',i7,'  kgds(14) = ',i7)
  887 format('tmow    kgds(15) = ',i7,'  kgds(16) = ',i7)
  888 format('tmow    kgds(17) = ',i7,'  kgds(18) = ',i7)
  889 format('tmow    kgds(19) = ',i7,'  kgds(20) = ',i7)
  890 format('tmow    kgds(20) = ',i7,'  kgds(22) = ',i7)
c
      print *,'just before call to putgb, kf= ',kf
      call putgb (77,kf,kpds,kgds,lb,xmask,ipret)
      print *,'just after call to putgb, kf= ',kf
      if (ipret == 0) then
        print *,' '
        print *,'+++ IPRET = 0 after call to putgb'
        print *,' '
      else
        print *,' '
        print *,'!!!!!! ERROR: IPRET NE 0 AFTER CALL TO PUTGB !!!'
        print *,' '
      endif
c
c     bug fix for IBM: flush the output stream so it actually writes
      flush(6)

      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_next_ges (fixlon,fixlat,ist,ifh,imax,jmax
     &          ,dx,dy,modelid,valid_pt,readflag,maxstorm,istmspd
     &          ,istmdir,ctype,trkrinfo,ignret)
c
c     ABSTRACT: This subroutine calculates a guess position for the next
c               forecast time.  It does this by using two different 
c               methods and averaging the results from those two.  The
c               first method is a simple linear extrapolation made by
c               basically drawing a line from the previous position 
c               through the current fix position and assuming straight
c               line motion.  The second method is to do a barnes 
c               smoothing of u & v in the vicinity of the storm at 850, 
c               700 & 500 mb to get an average environmental wind 
c               vector at each level, and then move the storm according 
c               to the vector at each level.  Then a weighted average is
c               taken of all these positions from methods 1 & 2 to get 
c               the consensus for the guess position.  NOTE: For a 
c               regional model and a storm that is relatively close to
c               the model boundary, there is a strong possibility that
c               the  barnes analysis subroutine will fail due to trying
c               to access grid points beyond the model's lateral  
c               boundary.  In this case, the redlm & ridlm are halved
c               and barnes is called again.  If it still fails, then 
c               just use the result from method 1 as a default.
c
c     INPUT:
c     fixlon  Array with longitudes of fix positions
c     fixlat  Array with latitudes of fix positions
c     ist     Storm number currently being processed
c     ifh     Forecast hour currently being processed
c     imax    Max number of pts in x-direction for this grid
c     jmax    Max number of pts in y-direction for this grid
c     dx      grid-spacing of the model in the i-direction
c     dy      grid-spacing of the model in the j-direction
c     modelid Integer indicating what model's data is being processed
c     valid_pt Logical; bitmap indicating if valid data at that pt.
c     readflag Logical; Tells whether or not a variable was read in
c              for this model
c     maxstorm Max # of storms that can be handled in this run
c     ctype   character that lets subroutine know if this is a search 
c             for the next position for the purposes of tc vitals or
c             for general tracking.  In the case of vitals, eventually
c             in the  barnes subroutine we are more lax and allow the 
c             routine to keep searching even if we are close to the 
c             grid boundary.  In a general tracking search, if we hit
c             the grid boundary even just once, we exit.
c     trkrinfo derived type detailing user-specified grid info
c
c     OUTPUT:
c     istmspd The speed that the storm would have to move to get from
c             the current position to the next guess position
c     istmdir The direction in which the storm would have to move to 
c             get from the current position to the next guess position
c
c     LOCAL:
c     dt      Number of seconds between successive forecast times
c             for this particular model.
c     dtkm    Distance in meters of 1 degree latitude
c     icutmax Max number of times to cut the ridlm and redlm in half,
c             for use in calling barnes.  If you're using a regional
c             model and on the first call to barnes you try to access
c             a point that's outside the model grid boundary, we'll
c             call  barnes again, but not before cutting the redlm and
c             ridlm in half.  icutmax says how many times to allow 
c             this cutting in half before giving up and just going
c             with the extrapolation method.  At first writing, we'll
c             set icutmax to 2, so that it will allow the ridlm to 
c             get down to 500 km (originally 2000 km) and the redlm 
c             to 125 km (originally 500 km).
c         *** NOTE: After testing the system, it was found that if
c             we cut these radii, the u and v values that are 
c             calculated from barnes are too strongly influenced by
c             the near-storm environment and, especially for asymmetric
c             systems, resulted in u and v values being much too strong.
c             As such, we will not allow these values to be cut, and if
c             we hit the boundaries in barnes, we'll just use the 
c             extrapolation method, which has seemed to work just fine.
c
c     OTHER:  (slonfg, slatfg & storm defined in module def_vitals)
c     slonfg  Array containing first guess longitude positions
c     slatfg  Array containing first guess latitude positions
c     storm   Contains tcvitals information
c
      USE radii; USE def_vitals; USE set_max_parms; USE grid_bounds
      USE tracked_parms; USE level_parms; USE trig_vals; USE trkrparms
      USE gen_vitals
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo
      integer   icutmax,istmspd,istmdir,bskip,ileadtime,ifcsthour
      integer   ifh,ist,npts,ilonfix,jlatfix,ibeg,jbeg,iend,jend
      integer   igiret,ignret,icut,iuret,ivret,ibarnct,n,ix1,ix2
      integer   icount,imax,jmax,modelid,maxstorm
      real      fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real      dist,distm,xincr,yincr,stmspd,stmdir,atan,arct,degrees
      real      barneswt,extrapwt,dtkm,dt,ucomp,vcomp,xdist,ydist,ydeg
      real      extraplat,avglat,cosfac,xdeg,extraplon,ylatdegmove_last
      real      xlondegmove_last,xnumh_last,ylatdegmove_last_perhour
      real      xlondegmove_last_perhour,xnumh_next,yoldavglat
      real      yoldcosfac,xdistmove_last,xdistmove_last_perhour
      real      ynewavglat,ynewcosfac,xdegnew,dx,dy,re,ri,ubar,vbar
      real      wgttot,uavg,vavg,reold,riold,barnlat,barnlon,wt_total
      real      tmp_fix_lon_curr,tmp_fix_lon_prev
      character*1 :: in_grid, extrap_flag, barnes_flag
      character(*)  ctype
      logical(1) valid_pt(imax,jmax),readflag(14)
c
      in_grid = 'n'
      extrap_flag = 'y'

      ileadtime = nint(fhreal(ifh) * 100.0)
      ifcsthour = ileadtime / 100
c
c     For updating the first guess, if Method 1 and Method 2 are both 
c     able to be done, give the following weights to the 2 methods.
c      
      data barneswt /0.50/, extrapwt /0.50/
c
c     -------------------------------
c     METHOD 1: LINEAR EXTRAPOLATION
c     -------------------------------
c     First, just do a simple linear extrapolation from the previous
c     fix position through the current fix position.  If it's the 
c     first time (vt=0), then use the storm motion vector and storm 
c     speed information from the TC Vitals card.
c
      dtkm = dtk * 1000.
      dt   = (fhreal(ifh+1) - fhreal(ifh)) * 3600.0
c
      if (ifh == 1) then
        if (storm(ist)%tcv_stdir == -99 .or.
     &      storm(ist)%tcv_stspd == -99) then
          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! IN GET_NEXT_GES, at fcst hour = 0, either '
            print *,'!!! storm motion or storm speed = -99 on TCV card.'
            print *,'!!! ist= ',ist,' ifh= ',ifh
            print *,'!!! Storm name = ',storm(ist)%tcv_storm_name
            print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
            print *,'!!! storm motion vector= ',storm(ist)%tcv_stdir
            print *,'!!! storm motion speed= ',storm(ist)%tcv_stspd
            print *,'!!! CANNOT USE LINEAR EXTRAP TO GET NEXT GUESS !!!'
          endif

          extrap_flag = 'n'
        else
          ucomp = sin(float(storm(ist)%tcv_stdir) * dtr) *
     &                float(storm(ist)%tcv_stspd)/10.0
          vcomp = cos(float(storm(ist)%tcv_stdir) * dtr) *
     &                float(storm(ist)%tcv_stspd)/10.0
          xdist = ucomp * dt
          ydist = vcomp * dt
          ydeg = ydist / dtkm
          extraplat = fixlat(ist,ifh) + ydeg
          avglat = 0.5 * (extraplat + fixlat(ist,ifh))
          if (avglat > 89.5)  avglat =  89.0
          if (avglat < -89.5) avglat = -89.0
          cosfac = cos(avglat * dtr)
          xdeg = xdist / (dtkm*cosfac)
          extraplon = fixlon(ist,ifh) + xdeg
        endif
      else

c       Do a simple linear extrapolation of the current motion of the
c       storm.  Follow a line from the  fix position from the last fix
c       through the current fix and extrapolate out.  To figure out the
c       new latitude, just see how many deg lat the storm moved since
c       last time and add it to the current fix latitude.  To calculate
c       the new fix longitude, though, we need to see how many deg lon
c       the storm moved since the last time, convert that to the 
c       distance (km) the storm travelled in the x-direction (at an
c       average latitude between the current and previous latitudes),
c       and then add that distance on to the current longitude and 
c       convert that distance to the num of degrees the storm has 
c       travelled in the x-direction (at an average latitude between
c       the current and next(extrap) latitudes).
c
c       UPDATE Feb 2009: To account for the possibility of using
c       irregularly spaced forecast hours (e.g., 6,10,10.5,...etc),
c       I had to modify this linear extrapolation.

        print *,' '
        print *,'xxxx get_next_ges, prev fix lon= ',fixlon(ist,ifh-1)
        print *,'xxxx get_next_ges, curr fix lon= ',fixlon(ist,ifh)
        print *,' '

        if (fixlat(ist,ifh-1) > -900.0 .and.
     &      fixlon(ist,ifh-1) > -900.0) then

          ylatdegmove_last = fixlat(ist,ifh) - fixlat(ist,ifh-1)

          tmp_fix_lon_curr = fixlon(ist,ifh)
          tmp_fix_lon_prev = fixlon(ist,ifh-1)

          if (tmp_fix_lon_prev < 0.0 .and. tmp_fix_lon_prev > -25.0)
     &    then
            ! previous lon position is within 25 deg west of the GM
            ! and is listed in negative degrees.
            if (tmp_fix_lon_curr < 0.0 .and. tmp_fix_lon_curr > -25.0)
     &      then
              if (verb .ge. 3) then
                print *,' '
                print *,'+++ GM WRAP ALERT 1 in get_next_ges.'
                print *,'+++ In get_next_ges, lon for previous and  '
                print *,'    current time are both negative.  All ok!'
                print *,'    tmp_fix_lon_prev= ',tmp_fix_lon_prev
                print *,'    tmp_fix_lon_curr= ',tmp_fix_lon_curr
              endif 
            elseif (tmp_fix_lon_curr > 0.0 .and.
     &              tmp_fix_lon_curr < 25.0) then
              if (verb .ge. 3) then
                print *,' '
                print *,'+++ GM WRAP ALERT 2 in get_next_ges.'
                print *,'+++ In get_next_ges, lon for previous time'
                print *,'    is negative, while lon for current time'
                print *,'    is positive, but within 0-25 deg East.'
                print *,'    All ok!'
              endif
            endif

          elseif (tmp_fix_lon_prev > 335.0 .and. 
     &            tmp_fix_lon_prev <= 360.0) then
            ! previous lon position is within 25 deg west of the GM
            ! and is listed in positive degrees.
            if (tmp_fix_lon_curr > 335.0 .and.
     &          tmp_fix_lon_curr <= 360.0) then
              if (verb .ge. 3) then
                print *,' '
                print *,'+++ GM WRAP ALERT 3 in get_next_ges.'
                print *,'+++ In get_next_ges, lon for previous and  '
                print *,'    current time are both positive.  All ok!'
                print *,'    tmp_fix_lon_prev= ',tmp_fix_lon_prev
                print *,'    tmp_fix_lon_curr= ',tmp_fix_lon_curr
              endif 
            elseif (tmp_fix_lon_curr > 0.0 .and.
     &              tmp_fix_lon_curr <= 25.0) then
              tmp_fix_lon_curr = tmp_fix_lon_curr + 360.0
              if (verb .ge. 3) then
                print *,' '
                print *,'+++ GM WRAP ALERT 4 in get_next_ges.'
                print *,'+++ In get_next_ges, lon for previous '
                print *,'    time is between 335 & 360, while lon'
                print *,'    for current time is east of the GM and'
                print *,'    is between 0 & 25.  Current tmp_lon'
                print *,'    has been adjusted to be > 360 for the'
                print *,'    purpose of computation.'
                print *,'    tmp_fix_lon_prev= ',tmp_fix_lon_prev
                print *,'    tmp_fix_lon_curr= ',tmp_fix_lon_curr
              endif
            elseif (tmp_fix_lon_curr < 0.0 .and.
     &              tmp_fix_lon_curr >= -25.0) then
              tmp_fix_lon_curr = tmp_fix_lon_curr + 360.0
              if (verb .ge. 3) then
                print *,' '
                print *,'+++ GM WRAP ALERT 5 in get_next_ges.'
                print *,'+++ In get_next_ges, lon for previous '
                print *,'    time is between 335 & 360, while lon'
                print *,'    for current time is west of the GM and'
                print *,'    is between 0 & -25.  Current tmp_lon'
                print *,'    has been adjusted to be positive and '
                print *,'    > 360 for the purpose of computation.'
                print *,'    tmp_fix_lon_prev= ',tmp_fix_lon_prev
                print *,'    tmp_fix_lon_curr= ',tmp_fix_lon_curr
              endif
            elseif (tmp_fix_lon_curr < -335.0 .and.
     &              tmp_fix_lon_curr >= -360.0) then
              tmp_fix_lon_curr = 720.0 - tmp_fix_lon_curr
              if (verb .ge. 3) then
                print *,' '
                print *,'+++ GM WRAP ALERT 6 in get_next_ges.'
                print *,'+++ In get_next_ges, lon for previous '
                print *,'    time is between 335 & 360, while lon'
                print *,'    for current time is east of the GM and'
                print *,'    is between -335 & -360.  Current tmp_lon'
                print *,'    has been adjusted to be positive and '
                print *,'    > 360 for the purpose of computation.'
                print *,'    tmp_fix_lon_prev= ',tmp_fix_lon_prev
                print *,'    tmp_fix_lon_curr= ',tmp_fix_lon_curr
              endif

            endif

          endif

          xlondegmove_last = tmp_fix_lon_curr - tmp_fix_lon_prev

          xnumh_last = fhreal(ifh) - fhreal(ifh-1)

          ylatdegmove_last_perhour = ylatdegmove_last / xnumh_last
          xlondegmove_last_perhour = xlondegmove_last / xnumh_last

          xnumh_next = fhreal(ifh+1) - fhreal(ifh)

          extraplat = fixlat(ist,ifh)  
     &              + (ylatdegmove_last_perhour * xnumh_next)

          yoldavglat = 0.5 * (fixlat(ist,ifh) + fixlat(ist,ifh-1))
          yoldcosfac = cos (dtr * yoldavglat)
          xdistmove_last  = xlondegmove_last * dtk * yoldcosfac
      
          xdistmove_last_perhour = xdistmove_last / xnumh_last
      
          ynewavglat = 0.5 * (extraplat + fixlat(ist,ifh))
          ynewcosfac = cos(dtr * ynewavglat)
          xdegnew    = (xdistmove_last_perhour * xnumh_next)
     &               / (dtk * ynewcosfac) 
          extraplon  = tmp_fix_lon_curr + xdegnew

        else 

          if ( verb .ge. 3 ) then
            print *,' '
            write(6,92) '!!! IN GET_NEXT_GES, at fcst hour = '
     &             ,ifhours(ifh),ifclockmins(ifh)
            print *,'!!! the lon and lat positions for the previous'
            print *,'!!! forecast hour are -999, meaning that this is a'
            print *,'!!! new storm, so we cannot use the extrap method.'
            print *,'!!! Storm name = ',storm(ist)%tcv_storm_name
            print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
            print *,'!!! CANNOT USE LINEAR EXTRAP TO GET NEXT GUESS !!!'
          endif

  92      format (1x,a36,i4,':',i2.2)

          extrap_flag = 'n'

        endif

      endif

c     -------------------------------
c     METHOD 2: Barnes analysis
c     -------------------------------
c     Do a barnes analysis on the u & v components of the wind near the
c     storm to get an average u & v, then advect the storm according to
c     the average wind vector obtained.  The call to get_ij_bounds is 
c     needed in order to restrict the number of grid points that are 
c     searched in the  barnes subroutine.  See Abstract from this 
c     subroutine for further details.
 
      npts = ceiling(ridlm/(dtk*((dx+dy)/2)))
 
      call get_ij_bounds (npts,0,ridlm,imax,jmax,dx,dy
     & ,glatmax,glatmin,glonmax,glonmin,fixlon(ist,ifh),fixlat(ist,ifh)
     & ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if (igiret /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in get_next_ges from call to '
          print *,'!!! get_ij_bounds, STOPPING processing for '
          print *,'!!! storm number ',ist
        endif

        ignret = 92
        return
      endif

      if (verb >= 3) then
        print *,' '
        print *,' +++ In get_next_ges after call to get_ij_bounds,'
        print *,'     getting bounds for the barnes analysis...'
        print *,'     glatmax= ',glatmax,'  glatmin= ',glatmin
        print *,'     glonmax= ',glonmax,'  glonmin= ',glonmin
        print *,'     fixlon= ',fixlon(ist,ifh),'  fixlat= '
     &                ,fixlat(ist,ifh)
        print *,'     ilonfix= ',ilonfix,'  jlatfix= ',jlatfix
        print *,'     ibeg= ',ibeg,'  iend= ',iend
        print *,'     jbeg= ',jbeg,'  jend= ',jend
      endif

c     For the  barnes analysis, we will want to speed things up for
c     finer resolution grids.  We can do this by skipping some of
c     the points in the  barnes analysis.

      if ((dx+dy)/2 > 0.20) then
        bskip = 1
      else if ((dx+dy)/2 > 0.10 .and. (dx+dy)/2 <= 0.20) then
        bskip = 2
      else if ((dx+dy)/2 > 0.05 .and. (dx+dy)/2 <= 0.10) then
        bskip = 3
      else if ((dx+dy)/2 > 0.03 .and. (dx+dy)/2 <= 0.05) then
        bskip = 5
      else if ((dx+dy)/2 <= 0.03) then
        bskip = 10
      endif

c     Calculate average wind at each level (currently: 850, 700 & 500)

      re = redlm
      ri = ridlm
      icut = 0

      if (trkrinfo%type == 'midlat') then
        icutmax = 2
      else
        icutmax = 1
      endif

      radmaxloop:  do while (icut <= icutmax .and. in_grid == 'n')

        ubar  = 0.0; vbar  = 0.0
        iuret = 0; ivret = 0
        wgttot = 0.0
        ibarnct = 0
        barnes_flag = 'n'

        levelloop: do n=1,nlevg

          select case (n)
           case (1); ix1=3; ix2=4    ! For 850 mb readflags
           case (2); ix1=5; ix2=6    ! For 700 mb readflags
           case (3); ix1=12; ix2=13  ! For 500 mb readflags
          end select

          if (readflag(ix1) .and. readflag(ix2)) then

            call barnes (fixlon(ist,ifh),fixlat(ist,ifh),glon,glat
     &           ,imax,jmax,ibeg,jbeg,iend,jend,u(1,1,n),valid_pt
     &           ,bskip,re,ri,uavg,icount,ctype,trkrinfo,iuret)

            call barnes (fixlon(ist,ifh),fixlat(ist,ifh),glon,glat
     &           ,imax,jmax,ibeg,jbeg,iend,jend,v(1,1,n),valid_pt
     &           ,bskip,re,ri,vavg,icount,ctype,trkrinfo,ivret)
      
            if (iuret /= 0 .or. ivret /= 0) then
 
c             ...barnes probably tried to access a pt outside the grid
c             domain.  So, reduce by half the distance from the center
c             of the farthest pt that barnes tries to access, exit this
c             loop, and try it again with the smaller re and ri.
 
              iuret = 96; ivret = 96
              reold = re
              riold = ri
              re = 0.5 * re
              ri = 0.5 * ri
              if ( verb .ge. 3 ) then
                print *,' ' 
                print *,'NOTE: While attempting to use the  barnes '
                print *,'method to update the first guess, the '
                print *,'algorithm tried to access a grid point that '
                print *,'does not have valid data, meaning that too '
                print *,'large a radius is being searched.  So, the 2 '
                print *,'radii, re and ri, are being halved and, if the'
                print *,'value of icutmax > 0,  the algorithm will be '
                print *,'run again.  Otherwise, if icutmax = 0, only '
                print *,'the extrapolation method will be used.'
                print *,'iuret= ',iuret,' ivret= ',ivret,' icut= ',icut
                print *,'Old re = ',reold,' New re = ',re
                print *,'Old ri = ',riold,' New ri = ',ri
              endif
                
              exit levelloop

            else
              ubar = ubar + wgts(n) * uavg
              vbar = vbar + wgts(n) * vavg
              wgttot = wgttot + wgts(n)
              ibarnct = ibarnct + 1
              if (verb >= 3) then
                print *,' '
                print *,' --- In get_next_ges, ix1= ',ix1,' ix2= ',ix2
                print *,'     uavg= ',uavg,' vavg= ',vavg
                print *,'     ubar= ',ubar,' vbar= ',vbar
                print *,'     n= ',n,' wgts(n)= ',wgts(n),' wgttot= '
     &                       ,wgttot
                print *,'     ibarnct= ',ibarnct
                print *,' '
                print *,' '
              endif
            endif

          endif
              
        enddo levelloop

        if (ibarnct > 0 .and. wgttot > 0.0) then
          barnes_flag = 'y'
          in_grid = 'y'    
          ubar = ubar / wgttot
          vbar = vbar / wgttot
          barnlat = fixlat(ist,ifh) + (vbar * dt)/dtkm
          cosfac = cos (dtr * 0.5 * (fixlat(ist,ifh) + barnlat))
          barnlon = fixlon(ist,ifh) + (ubar * dt)/(dtkm * cosfac)

          if (verb >= 3) then
            print *,' '
            print *,' --- In get_next_ges, mean stats follow: '
            print *,'     ubar= ',ubar,' vbar= ',vbar
            print *,'     wgttot= ',wgttot
            print *,'     fixlon= ',fixlon(ist,ifh),'  fixlat= '
     &                   ,fixlat(ist,ifh)
            print *,'     barnlon= ',barnlon,' barnlat= ',barnlat
            print *,'     dt= ',dt,' dtkm= ',dtkm,' cosfac= ',cosfac
          endif


c         This next if statement says that if we've had to reduce the
c         size of the  barnes analysis domain twice already, then we've
c         only done the analysis on a much smaller area, and this 
c         doesn't give us as good a picture of the average winds in the
c         area of the storm, so reduce the emphasis we place on the 
c         barnes method.

          if (icut >= 2) barneswt = barneswt / 2.

        else
          barnes_flag = 'n'
        endif

        icut = icut + 1

      enddo radmaxloop

c     ---------------------
c     Average the results
c     ---------------------
c     Now do a weighted average of the positions obtained from the 
c     linear extrapolation and the  barnes analysis methods.

      if (extrap_flag == 'y' .and. barnes_flag == 'y') then
        wt_total = barneswt + extrapwt
        slatfg(ist,ifh+1) = (barneswt * barnlat + extrapwt * extraplat)
     &                      / wt_total

        ! Note that in any of these statements just below, in order for
        ! any of these to be > 360, the original fixlon must be close
        ! to 360, i.e., in the far eastern part of the grid, as opposed
        ! to being in the far western part (e.g., 0-2 deg East or so).
        ! Conversely, for any of these to be < 0, the original fixlon 
        ! must be close to 0, i.e., in the far *western* part of the 
        ! grid.

c         yyyy

        if (fixlon(ist,ifh) > 330.0) then

          ! In this part of the IF, we will make sure that the two 
          ! guess lons (barnlon and extraplon) are consistent as 
          ! both being 330+, to be consistent with the fixlon for
          ! this time.

          if (extraplon > 330. .and. barnlon > 330.) then

            continue  ! All lons will be in the 300+ range, so for 
                      ! consistency, we're ok.

          elseif (extraplon > 330. .and. 
     &            (barnlon >= 0.0 .and. barnlon < 30.)) then

            ! extraplon > 330, but barnlon is in the 0-30 range, so
            ! we need to convert the barnlon value to be 360+

            barnlon = barnlon + 360.

          elseif (extraplon > 330. .and. barnlon < 0.) then

            ! extraplon > 330, but barnlon is < 0, so
            ! we need to convert the barnlon value to be positive...

            barnlon = barnlon + 360.

          elseif (barnlon > 330. .and.
     &            (extraplon >= 0.0 .and. extraplon < 30.)) then

            ! barnlon > 330, but extraplon is in the 0-30 range, so
            ! we need to convert the extraplon value to be 360+

            extraplon = extraplon + 360.

          elseif (barnlon > 330. .and. extraplon < 0.) then

            ! barnlon > 330, but extraplon is < 0, so
            ! we need to convert the extraplon value to be positive...

            extraplon = extraplon + 360.

          endif

        elseif (fixlon(ist,ifh) >= 0. and. fixlon(ist,ifh) < 30.0) then

          ! In this part of the ELSEIF, we will make sure that the two 
          ! guess lons (barnlon and extraplon) are consistent as 
          ! both being in the reference of >360 since that is what the 
          ! code below this is expecting with the computation of 
          ! slonfg for the next lead time.

          if ((extraplon >= 0. .and. extraplon < 60.) .and. 
     &        (barnlon   >= 0. .and. barnlon < 60.)) then

              extraplon = extraplon + 360.
              barnlon   = barnlon + 360.

          elseif ((extraplon < 0. .and. extraplon > -60.) .and. 
     &            (barnlon   < 0. .and. barnlon > -60.)) then

            ! convert extraplon and barnlon to be positive

            extraplon = extraplon + 360.
            barnlon   = barnlon + 360.

          elseif ((extraplon >= 0. .and. extraplon < 60.) .and.
     &            barnlon < 0.) then

            extraplon = extraplon + 360.
            barnlon   = barnlon + 360.

          elseif ((barnlon >= 0. .and. barnlon < 60.) .and.
     &            extraplon < 0.) then

            extraplon = extraplon + 360.

          elseif ((barnlon >= 0. .and. barnlon < 60.) .and.
     &            extraplon > 330.) then

            barnlon = barnlon + 360.

          elseif (barnlon >= 330. .and. extraplon < 60.) then

            extraplon = extraplon + 360.

          elseif (extraplon >= 330. .and. barnlon < 60.) then

            barnlon = barnlon + 360.

          elseif ((extraplon >= 0. .and. extraplon < 60.) .and.
     &            barnlon > 330.) then

            extraplon = extraplon + 360.

          endif

        else

          continue   ! extraplon and barnlon do not need to be modified
                     ! since there should be no way that a storm 
                     ! currently east of 30E and west of 30W could make
                     ! it to the Greenwich Mer in one forecast interval

        endif

        print *,' '
        print *,'+++ In get_next_ges, before averaging the 2 methods, '
        print *,'    Raw (no conversion for GM wrap) barnlon=   '
     &         ,barnlon
        print *,'    Raw (no conversion for GM wrap) extraplon= '
     &         ,extraplon

        slonfg(ist,ifh+1) = (barneswt * barnlon + extrapwt * extraplon)
     &                      / wt_total

        if (slonfg(ist,ifh+1) > 360.) then
          ! If we've GM-wrapped past 360, adjust it to be 0-360...
          slonfg(ist,ifh+1) = slonfg(ist,ifh+1) - 360.
        endif

        if ( verb .ge. 3 ) then
          write (6,*) ' '
          if (barnlon >= 360.) then
            write (6,41) barnlon-360.,720.-barnlon,barnlat        
          elseif (barnlon >= 0. .and. barnlon < 360.) then
            write (6,41) barnlon,360.-barnlon,barnlat        
          elseif (barnlon < 0.) then
            write (6,41) barnlon+360.,-1.*barnlon,barnlat        
          endif
          if (extraplon >= 360.) then
            write (6,43) extraplon-360.,720.-extraplon,barnlat        
          elseif (extraplon >= 0. .and. extraplon < 360.) then
            write (6,43) extraplon,360.-extraplon,barnlat        
          elseif (extraplon < 0.) then
            write (6,43) extraplon+360.,-1.*extraplon,barnlat        
          endif
        endif

        ignret = 0
      else if (extrap_flag == 'y' .and. barnes_flag == 'n') then

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'!!! NOTE: In get_next_ges, barnes method was not '
          print *,'!!! done for updating the first guess for this '
          print *,'!!! storm. Only the linear extrapolation method '
          print *,'!!! was used.'
          print *,'!!! ist= ',ist,' ifh= ',ifh
          print *,'!!! Storm Name = ',storm(ist)%tcv_storm_name
          print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
        endif

        slatfg(ist,ifh+1) = extraplat
        if (extraplon > 360.) then
          if (trkrinfo%gridtype == 'global') then
            slonfg(ist,ifh+1) = extraplon - 360.
          else

            if ( verb .ge. 1 ) then
              print *,'!!! ERROR in get_next_ges, extraplon >360'
              print *,'!!! for non-global grid.  We only'
              print *,'!!! do GM wrapping for global grids.'
            endif

            ignret = 95
            return
          endif
        elseif (extraplon < 0.) then
          if (trkrinfo%gridtype == 'global') then
            slonfg(ist,ifh+1) = extraplon + 360.
          else

            if ( verb .ge. 1 ) then
              print *,'!!! ERROR in get_next_ges, extraplon < 0'
              print *,'!!! for non-global grid.  We only'
              print *,'!!! do GM wrapping for global grids.'
            endif

            ignret = 95
            return
          endif
        else
          slonfg(ist,ifh+1) = extraplon
        endif

        if ( verb .ge. 3 ) then
          write (6,*) ' '
          write (6,41) 0.0,0.0,0.0
          if (extraplon >= 360.) then
            write (6,43) extraplon-360.,720.-extraplon,barnlat
          elseif (extraplon >= 0. .and. extraplon < 360.) then
            write (6,43) extraplon,360.-extraplon,barnlat
          elseif (extraplon < 0.) then
            write (6,43) extraplon+360.,-1.*extraplon,barnlat
          endif
        endif

        ignret = 0
      else if (extrap_flag == 'n' .and. barnes_flag == 'y') then
        slatfg(ist,ifh+1) = barnlat
        if (barnlon > 360.) then
          if (trkrinfo%gridtype == 'global') then
            slonfg(ist,ifh+1) = barnlon - 360.
          else

            if ( verb .ge. 1 ) then
              print *,'!!! ERROR in get_next_ges, barnlon >360'
              print *,'!!! for non-global grid.  We only'       
              print *,'!!! do GM wrapping for global grids.'
            endif

            ignret = 95  
            return    
          endif  
        elseif (barnlon < 0.) then
          if (trkrinfo%gridtype == 'global') then
            slonfg(ist,ifh+1) = barnlon + 360.
          else 
          
            if ( verb .ge. 1 ) then
              print *,'!!! ERROR in get_next_ges, barnlon < 0'
              print *,'!!! for non-global grid.  We only'
              print *,'!!! do GM wrapping for global grids.'
            endif

            ignret = 95  
            return    
          endif  
        else
          slonfg(ist,ifh+1) = barnlon
        endif


        if ( verb .ge. 3 ) then
          write (6,*) ' '
          write (6,41) 360.-barnlon,barnlat
          if (barnlon >= 360.) then
            write (6,41) barnlon-360.,720.-barnlon,barnlat
          elseif (barnlon >= 0. .and. barnlon < 360.) then
            write (6,41) barnlon,360.-barnlon,barnlat
          elseif (barnlon < 0.) then
            write (6,41) barnlon+360.,-1.*barnlon,barnlat
          endif
          write (6,43) 0.0,0.0,0.0
        endif

        ignret = 0
      else

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in get_next_ges, new position guess not'
          print *,'!!! made.  Could not get guess using either barnes'
          print *,'!!! method or extrapolation method.'
          print *,'!!! extrap_flag = ',extrap_flag
          print *,'!!! barnes_flag = ',barnes_flag
          print *,'!!! Storm number = ',ist,' ifh = ',ifh
          print *,'!!! Storm Name = ',storm(ist)%tcv_storm_name
          print *,'!!! Storm ID = ',storm(ist)%tcv_storm_id
          write (6,41) 0.0,0.0,0.0
          write (6,43) 0.0,0.0,0.0
        endif

        ignret = 95 
      endif


      if ( verb .ge. 3 ) then
        print *,' '
        print *,'-------------------------------------------------- '
        print *,'|      Current fix & updated fix positions       |'
        print *,'-------------------------------------------------- '
        print *,'| In get_next_ges, current fcst hour    = ',fhreal(ifh)
        print *,'|                 current storm number  = ',ist
        print *,'| Return code from get_next_ges = ',ignret
        print *,'| Storm Name = ',storm(ist)%tcv_storm_name
        print *,'| Storm ID = ',storm(ist)%tcv_storm_id
        write (6,420) gstorm(ist)%gv_gen_date,gstorm(ist)%gv_gen_fhr
     &       ,gstorm(ist)%gv_gen_lat
     &       ,gstorm(ist)%gv_gen_latns,gstorm(ist)%gv_gen_lon
     &       ,gstorm(ist)%gv_gen_lonew,gstorm(ist)%gv_gen_type
        write (6,21) fixlat(ist,ifh)
        write (6,23) 360.-fixlon(ist,ifh),fixlon(ist,ifh)
        write (6,25) slatfg(ist,ifh+1)
        write (6,27) 360.-slonfg(ist,ifh+1),slonfg(ist,ifh+1)
        print *,'-------------------------------------------------'
        print *,' '
      endif

 420  format (' | Gen ID (if available): ',i10.10,'_F',i3.3,'_'
     &             ,i3.3,a1,'_',i4.4,a1,'_',a3)
 21   format (' | Current fix lat is ',f7.2)
 23   format (' | Current fix lon is ',f7.2,'W   (',f7.2,'E)')
 25   format (' | Updated guess lat for next fcst hour is ',f7.2)
 27   format (' | Updated guess lon for next fcst hour is ',f7.2
     &       ,'W   (',f7.2,'E)')
c 41   format (' --- barnlon=   ',f7.2,'W    barnlat=   ',f7.2)
c 43   format (' --- extraplon= ',f7.2,'W    extraplat= ',f7.2)

 41   format (' --- barnlon=   ',f7.2,'E  (',f7.2
     &       ,'W)    barnlat=   ',f7.2)
 43   format (' --- extraplon= ',f7.2,'E  (',f7.2
     &       ,'W)    extraplat= ',f7.2)
 
c     Now calculate the speed that the storm would have to move at in
c     order to make it to the next forecast position.  We will use
c     this information in writing out the "gen_vitals" record, if this
c     is requested.

      call calcdist (fixlon(ist,ifh),fixlat(ist,ifh)
     &              ,slonfg(ist,ifh+1),slatfg(ist,ifh+1),dist,degrees)

      ! convert distance from km to meters, then get speed in m/s.

      distm   = dist * 1000.
      stmspd  = distm / dt
      istmspd = int ((stmspd * 10) + 0.5)

      xincr = slonfg(ist,ifh+1) - fixlon(ist,ifh)
      yincr = slatfg(ist,ifh+1) - fixlat(ist,ifh)

      if ( verb .ge. 3 ) then
        print *,'iocheck, dist= ',dist,'  distm= ',distm
        print *,'iocheck, stmspd= ',stmspd,'  istmspd= ',istmspd
        print *,'iocheck, xincr= ',xincr,'  yincr= ',yincr
      endif
 
      if (xincr < 0.0 .and. slonfg(ist,ifh+1) < 30.0 .and.
     &                      fixlon(ist,ifh) > 300.0) then
        ! This means we have a storm moving east across the GM, and
        ! so we are  subtracting, for example, something like
        ! 0.5 - 359.5, so redo xincr, but add 360 to slonfg first...
        xincr = (slonfg(ist,ifh+1) + 360.0) - fixlon(ist,ifh)
      else if (xincr > 300.0) then
        ! This means we have a storm moving west across the GM, and
        ! so we are  subtracting, for example, something like
        ! 359.5 - 0.5, so redo xincr, but add 360 to fixlon first...
        xincr = slonfg(ist,ifh+1) - (fixlon(ist,ifh) + 360.0)
      endif

      if (xincr == 0.0) then
        if (yincr == 0.0) then 
          stmdir = 0.0
        else if (yincr > 0) then
          stmdir = 360.0
        else if (yincr < 0) then
          stmdir = 180.0
        endif
      else if (xincr > 0.0) then
        if (yincr == 0.0) then 
          stmdir = 90.0
        else 
          arct = atan(yincr/xincr) 
          stmdir = 90. - arct / dtr
        endif
      else if (xincr < 0.0) then
        if (yincr == 0.0) then 
          stmdir = 270.0
        else
          arct = atan(yincr/xincr)
          stmdir = 270. - arct / dtr
        endif
      endif

      istmdir = int (stmdir + 0.5)
      if (istmdir > 360) then
        istmdir = 360
      else if (istmdir < 0) then
        istmdir = 0
      endif

      if ( verb .ge. 3 ) then
        print *,'iocheck, stmdir= ',stmdir,'  istmdir= ',istmdir
      endif

      return
      end       

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine advect_tcvitals_from_hour0 (fixlon,fixlat,maxstorm
     &                                 ,inctcv,ifh,trkrinfo,iatret)
c
c     ABSTRACT: This subroutine calculates a guess position for the next
c     forecast time.  As of 11/2016, it is called only for the case in
c     which we've got NetCDF data and no hour0 data, and so we want to 
c     simply take the TC Vitals data and advect the current position to 
c     a position at the next lead time.  We can't use the code in 
c     subroutine  get_next_ges because there are certain allocatable 
c     arrays in that subroutine that need to have been allocated first, 
c     and at this point prior to the first lead time in hour0, they 
c     haven't been allocated.
c
c     INPUT:
c     inctcv  Index for storm number currently being processed
c     ifh     Forecast hour currently being processed
c     trkrinfo derived type detailing user-specified grid info
c
c     OUTPUT:
c     iatret  Return code from this subroutine
c
      USE def_vitals; USE trkrparms; USE tracked_parms
      USE verbose_output; USE trig_vals; USE set_max_parms
      USE gen_vitals

      type (trackstuff) trkrinfo
      integer   iatret,inctcv
      real      fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real      dist,distm,xincr,yincr,stmspd,stmdir,atan,arct,degrees
      real      ucomp,vcomp,xdist,ydist,ydeg,dt,extraplat
      real      cosfac
      real      dtkm
c
      in_grid = 'n'
      extrap_flag = 'y'

      ileadtime = nint(fhreal(ifh) * 100.0)
      ifcsthour = ileadtime / 100
c
c     ------------------------------------------------------------------
c     Using the storm motion vector and storm translation speed as read
c     from the TC Vitals card, do a simple linear extrapolation from the
c     current observed (TC Vitals) position and advect the storm to a 
c     position at the next lead time.
c     ------------------------------------------------------------------

      iatret = 0

      dtkm = dtk * 1000.
      dt   = (fhreal(ifh+1) - fhreal(ifh)) * 3600.0
c
      if (ifh == 1) then
        if (storm(inctcv)%tcv_stdir == -99 .or.
     &      storm(inctcv)%tcv_stspd == -99) then
          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! In advect_tcvitals_from_hour0, at fcst hour= 0'
            print *,'!!! either storm motion or storm speed = -99 on '
            print *,'!!! TCV card,  ist= inctcv= ',inctcv,' ifh= ',ifh
            print *,'!!! Storm name = ',storm(inctcv)%tcv_storm_name
            print *,'!!! Storm ID = ',storm(inctcv)%tcv_storm_id
            print *,'!!! storm motion vector= ',storm(inctcv)%tcv_stdir
            print *,'!!! storm motion speed= ',storm(inctcv)%tcv_stspd
            print *,'... CANNOT USE LINEAR EXTRAP TO GET NEXT GUESS ...'
            print *,' '
            print *,'... Instead, we will simply use the current '
            print *,'... observed position from TC Vitals and hope that'
            print *,'... it is close enough at the next lead time for '
            print *,'... the tracker to be able to still track it.'
            print *,' '
          endif
          extraplat = slatfg(inctcv,ifh)
          extraplon = slonfg(inctcv,ifh)
        else
          ucomp = sin(float(storm(inctcv)%tcv_stdir) * dtr) *
     &                float(storm(inctcv)%tcv_stspd)/10.0
          vcomp = cos(float(storm(inctcv)%tcv_stdir) * dtr) *
     &                float(storm(inctcv)%tcv_stspd)/10.0
          xdist = ucomp * dt
          ydist = vcomp * dt
          ydeg = ydist / dtkm
          extraplat = fixlat(inctcv,ifh) + ydeg
          cosfac = cos(extraplat * dtr)
          xdeg = xdist / (dtkm*cosfac)
          extraplon = fixlon(inctcv,ifh) + xdeg
        endif
      else
        print *,' '
        print *,'!!! ERROR: In advect_tcvitals_from_hour0, the value of'
        print *,'    ifh is > 1, and this routine should only be called'
        print *,'    if ifh=1 (i.e., for hour0).  STOPPING....'
        print *,' '
        stop 95
      endif

      slatfg(inctcv,ifh+1) = extraplat

      if (extraplon > 360.) then
        if (trkrinfo%gridtype == 'global') then
          slonfg(inctcv,ifh+1) = extraplon - 360.
        else  

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in advect_tcvitals_from_hour0,' 
            print *,'!!! extraplon >360 for non-global grid.  We only'
            print *,'!!! do GM wrapping for global grids.'
          endif 

          iatret = 95
          return
        endif 
      elseif (extraplon < 0.) then
        if (trkrinfo%gridtype == 'global') then
          slonfg(inctcv,ifh+1) = extraplon + 360.
        else  

          if ( verb .ge. 1 ) then
            print *,'!!! ERROR in advect_tcvitals_from_hour0,'
            print *,'!!! extraplon < 0 for non-global grid.  We only'
            print *,'!!! do GM wrapping for global grids.'
          endif 

          iatret = 95
          return
        endif 
      else  
        slonfg(inctcv,ifh+1) = extraplon
      endif

      if ( verb .ge. 3 ) then
        print *,' ' 
        print *,'-------------------------------------------------- '
        print *,'| In advect_tcvitals_from_hour0, info on the '
        print *,'| positions for the current and next lead times '
        print *,'| follow: '
        print *,'-------------------------------------------------- '
        print *,'| current fcst hour     = ',fhreal(ifh)
        print *,'| current storm number  = ',inctcv
        print *,'| Return code from advect_tcvitals_from_hour0= ',iatret
        print *,'| Storm Name = ',storm(inctcv)%tcv_storm_name
        print *,'| Storm ID = ',storm(inctcv)%tcv_storm_id
        write (6,420) gstorm(inctcv)%gv_gen_date
     &       ,gstorm(inctcv)%gv_gen_fhr
     &       ,gstorm(inctcv)%gv_gen_lat
     &       ,gstorm(inctcv)%gv_gen_latns,gstorm(inctcv)%gv_gen_lon
     &       ,gstorm(inctcv)%gv_gen_lonew,gstorm(inctcv)%gv_gen_type
        write (6,21) fixlat(inctcv,ifh)
        write (6,23) 360.-fixlon(inctcv,ifh),fixlon(inctcv,ifh)
        write (6,25) slatfg(inctcv,ifh+1)
        write (6,27) 360.-slonfg(inctcv,ifh+1),slonfg(inctcv,ifh+1)
        print *,'-------------------------------------------------'
        print *,' ' 
      endif 

 420  format (' | Gen ID (if available): ',i10.10,'_F',i3.3,'_'
     &             ,i3.3,a1,'_',i4.4,a1,'_',a3)
 21   format (' | Current TC Vitals lat is ',f7.2)
 23   format (' | Current TC Vitals lon is ',f7.2,'W   (',f7.2,'E)')
 25   format (' | Updated guess lat for next fcst hour is ',f7.2)
 27   format (' | Updated guess lon for next fcst hour is ',f7.2
     &       ,'W   (',f7.2,'E)')


      return
      end       
c
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine getradii (xcenlon,xcenlat,imax,jmax,dx,dy,valid_pt
     &                    ,cstormid,ifcsthr,vmaxwind,vradius,trkrinfo
     &                    ,need_to_expand_r34,radmax
     &                    ,first_time_thru_getradii,igrct,igrret)
c
c     ABSTRACT: This subroutine looks through the wind data near an
c     input storm center (fixlon,fixlat) and gets the radii of various
c     surface winds in each of the 4 storm quadrants (NE,NW,SE,SW).  
c     The wind thresholds that are sought are gale force (34kt|17.5m/s),
c     storm force (50kt|25.7m/s), and hurricane force (64kt|32.9m/s). 
c     This subroutine calls the Cray subroutine  orders, which is a 
c     Cray-optimized sort routine.
c
c     UPDATE (AUG 2001): The Cray subroutine  orders was ported to the
c     SP by NCEP personnel.  On the SP version, some changes were
c     apparently made so that the size of the arrays for calling
c     arguments 2, 3 and 4 (iwork, dtemp and isortix in my calling
c     routine) must be the same.  This was not the case on the Crays,
c     and this was causing the  tracker to crash for cases far north
c     on fine grids (GFDL 1/3 grid).
c
c     UPDATE (AUG 2012): The call to the Cray subroutine orders was
c     replaced with a call to qsort, which uses a quicksort sorting
c     algorithm.  While this is not the fastest sorting routine out
c     there, we don't do a lot of sorting here, and qsort is simple
c     and it is portable.
c
c     UPDATE (April 2013):  For the radii, we encountered a problem with
c     radmax being too small.  It was set at 650 km.  Hurricane Sandy
c     exceeded this in the models, so the values returned from getradii
c     were close to the default radmax value of 650 km (350 nm), instead
c     of much higher as they should have been.  To fix it, we now use an
c     iterative technique, where we start with radmax as a small value
c     (450 km).  If getradii returns a value for R34 in a quadrant that
c     does not exceed 0.97*radmax, then that value is ok.  If it does
c     exceed 0.97*radmax, then we bump up radmax by 50 km and call
c     getradii again, looking to diagnose radii only in those quadrants
c     where the need_to_expand_r34 flag = 'n'.
c
c     INPUT:
c
c     xcenlon   fix longitude of storm center for current forecast hour
c     xcenlat   fix latitude of storm center for current forecast hour
c     imax      max i dimension of model grid
c     jmax      max j dimension of model grid
c     dx        grid spacing in i-direction of model grid
c     dy        grid spacing in j-direction of model grid
c     valid_pt  logical bitmap for valid data at a grid point
c     cstormid  3-character storm ATCF ID (e.g., 03L, 11E, etc)
c     ifcsthr   integer value for current forecast hour
c     trkrinfo  derived type containing various info on the storm
c     need_to_expand_r34 1-character array that specifies which of the
c               4 quadrants still need to be expanded on this time
c               through getradii in order to get an R34 value that is
c               not right at the outermost boundary.
c     vmaxwind  max wind (in m/s) that was reported from the 
c               get_max_wind subroutine
c     radmax    input max radius (km) that will be used for this
c               iteration of getradii.
c     first_time_thru_getradii  logical flag.  It is used so that any
c               checking for 50- or 64-kt radii is only done on the 
c               first time through getradii.  Only the checking for 
c               34-kt radii is done on multiple iterations.
c     igrct     integer that indicates what iteration of getradii this
c               call is.
c
c     OUTPUT:
c   
c     igrret    return code from this subroutine
c     vradius   Contains the distance from the storm fix position to
c               each of the various wind threshhold distances in each
c               quadrant. (3,4) ==> (# of threshholds, # of quadrants)
c
c     LOCAL:
c
c     radmax    the maximum radius to look for winds for the various
c               thresholds.
c     quadinfo  This array contains the magnitude of the near-surface 
c               winds and the distance from the gridpoint to the fix 
c               position for each point in each quadrant that is within
c               the maximum allowed radius, radmax.  quadinfo is 
c               allocated within this subroutine, and is allocated as
c               (quadrant, num_pts_in_quadrant, data_type), where 
c               data_type is either windspeed(1) or distance(2) from 
c               storm center to grid point.
c     quadmax   This array contains the max surface wind in each 
c               quadrant, plus the location of it and the distance from
c               the storm center.  This information is critical to 
c               identifying when this subroutine is malfunctioning.

      USE grid_bounds; USE tracked_parms; USE trig_vals; USE level_parms
      USE trkrparms
      USE verbose_output

c
      type (trackstuff) trkrinfo
c
      logical(1) valid_pt(imax,jmax)     
      logical(1) first_time_thru_getradii
c      dimension iwork(257)
      real, allocatable :: quadinfo(:,:,:),iwork(:)
      real      quadmax(4,4)
      real      exactdistnm,exactdistkm,radmax,degrees,cosarg
      real      rlonb,rlonc,rlatb,rlatc,vmaxwind
      real      pt_heading_rad,pt_heading,d
      integer, allocatable :: isortix(:)
      integer   iwindix,ipoint,ifcsthr,igrct
      integer   quadct(4),vradius(3,4)
      integer, parameter  :: dp = selected_real_kind(12, 60)
      real (dp), allocatable :: dtemp(:)
      real ::   windthresh(3) = (/17.5,25.7,32.9/)
      character cstormid*3
      character :: need_to_expand_r34(4)*1

      if ( verb .ge. 3 ) then
        print *,' '
        print *,' *************************************************** '
        print *,' AT BEGINNING OF GETRADII, input radmax= ',radmax
        print *,' *************************************************** '
        print *,' '
        print *,'xcenlon= ',xcenlon,' xcenlat= ',xcenlat
        print *,'imax= ',imax,' jmax= ',jmax,' dx= ',dx,' dy= ',dy
      endif

      igrret  = 0
      
c     -----------------------------------------------------------
c     PART 1: Define the maximum radius for which you'll search
c     for the wind values, and then get the beginning and ending 
c     i and j points for that sub-region to search.  Define this
c     maximum radius (radmax) in terms of km.
c     -----------------------------------------------------------
 
c      radmax = 650.0  ! This value is in units of km. With April 2013
c                      ! update, this is now defined in calling routine

c     Roughly fix xcenlat to the grid point just poleward of xcenlat,
c     and fix xcenlon to the grid point just EASTward of xcenlon.

      if (xcenlat >= 0.0) then
        jlatfix = int((glatmax - xcenlat)/dy + 1.)
      else
        jlatfix = ceiling((glatmax - xcenlat)/dy + 1.)
      endif

      ilonfix = int((xcenlon - glonmin)/dx + 2.)

      if (ilonfix > imax) then
        if (trkrinfo%gridtype == 'global') then
          ilonfix = ilonfix - imax   ! If wrapping past GM
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: In getradii, the '
            print *,'!!!    user-requested eastern boundary'
            print *,'!!!    is beyond the eastern bounds of '
            print *,'!!!    this regional grid.  '
            print *,'!!!         '
            print *,'!!!   imax of regional grid    = ',imax
            print *,'!!!   eastern ilonfix = ',ilonfix
            print *,'!!!         '
            print *,'!!! Radii will not be computed for this time.'
            print *,' '
          endif

          idta=0; iisa=0; iwa=0; iqa=0
          if (allocated(dtemp))    deallocate (dtemp,stat=idta)
          if (allocated(isortix))  deallocate (isortix,stat=iisa)
          if (allocated(iwork))    deallocate (iwork,stat=iwa)
          if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

          if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0) then
            print *,' '
            print *,'!!! ERROR in getradii deallocating arrays.'
            print *,'!!! iqa= ',iqa,' idta= ',idta
            print *,'!!! iisa= ',iisa,' iwa= ',iwa
            print *,'!!! EXITING at GR-A....'
            stop 98
          endif

          igrret = 99
          return
        endif   
      endif

      if (ilonfix < 1) then
        if (trkrinfo%gridtype == 'global') then
          ilonfix = ilonfix + imax
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: ilonfix < 1 in subroutine  getradii'
            print *,'!!! for a non-global grid.'
            print *,'!!! ilonfix= ',ilonfix
            print *,'!!!         '
            print *,'!!! Radii will not be computed for this time.'
            print *,' '
          endif

          idta=0; iisa=0; iwa=0; iqa=0
          if (allocated(dtemp))    deallocate (dtemp,stat=idta)
          if (allocated(isortix))  deallocate (isortix,stat=iisa)
          if (allocated(iwork))    deallocate (iwork,stat=iwa)
          if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

          if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0) then
            print *,' '
            print *,'!!! ERROR in getradii deallocating arrays.'
            print *,'!!! iqa= ',iqa,' idta= ',idta
            print *,'!!! iisa= ',iisa,' iwa= ',iwa
            print *,'!!! EXITING at GR-B....'
            stop 98
          endif

          igrret = 99
          return
        endif   
      endif

c     Calculate number of grid points to have surrounding the storm so
c     that we are sure radmax is within those points.

      cosfac  = cos (xcenlat * dtr)
      numipts = ceiling((radmax/(dtk*dx))/cosfac)
      numjpts = ceiling(radmax/(dtk*dy))

      jbeg = jlatfix - numjpts
      jend = jlatfix + numjpts + 1
      ibeg = ilonfix - (numipts + 1)
      iend = ilonfix + numipts

      if (ibeg < 1) then

        if (trkrinfo%gridtype == 'global') then
          continue   ! If wrapping past GM, there is code below in this
                     ! getradii routine that can modify the indices
                     ! appropriately.  So... do nothing here.
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: In getradii, the '
            print *,'!!!    user-requested western boundary'
            print *,'!!!    is beyond the western bounds of '
            print *,'!!!    this regional grid.  '
            print *,'!!!         '
            print *,'!!!   imax of regional grid    = ',imax
            print *,'!!!   ilonfix = ',ilonfix,' ibeg= ',ibeg
            print *,'!!!         '
            print *,'!!! Radii will not be computed for this time.'
            print *,' '
          endif

          idta=0; iisa=0; iwa=0; iqa=0
          if (allocated(dtemp))    deallocate (dtemp,stat=idta)
          if (allocated(isortix))  deallocate (isortix,stat=iisa)
          if (allocated(iwork))    deallocate (iwork,stat=iwa)
          if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

          if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0) then
            print *,' '
            print *,'!!! ERROR in getradii deallocating arrays.'
            print *,'!!! iqa= ',iqa,' idta= ',idta
            print *,'!!! iisa= ',iisa,' iwa= ',iwa
            print *,'!!! EXITING at GR-C...'
            stop 98
          endif

          igrret = 99
          return
        endif

      endif

      if (jbeg < 1) jbeg = 1

      if (jbeg > jmax .or. jbeg < 1 .or. jend < 1) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'ERROR in getradii calculating jbeg or jend.'
          print *,'jbeg= ',jbeg,' jend= ',jend
          print *,'Wind radii will not be calculated for this time.'
        endif

        idta=0; iisa=0; iwa=0; iqa=0
        if (allocated(dtemp))    deallocate (dtemp,stat=idta)
        if (allocated(isortix))  deallocate (isortix,stat=iisa)
        if (allocated(iwork))    deallocate (iwork,stat=iwa)
        if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

        if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0) then
          print *,' '
          print *,'!!! ERROR in getradii deallocating arrays.'
          print *,'!!! iqa= ',iqa,' idta= ',idta
          print *,'!!! iisa= ',iisa,' iwa= ',iwa
          print *,'!!! EXITING at GR-D....'
          stop 98
        endif

        igrret = 99
        return
      endif

      if (iend > imax) then

        if (trkrinfo%gridtype == 'global') then
          continue   ! If wrapping past GM, there is code below in this
                     ! getradii routine that can modify the indices
                     ! appropriately.  So... do nothing here.
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: In getradii, the '
            print *,'!!!    user-requested eastern boundary'
            print *,'!!!    is beyond the eastern bounds of '
            print *,'!!!    this regional grid.  '
            print *,'!!!         '
            print *,'!!!   imax of regional grid    = ',imax
            print *,'!!!   ilonfix = ',ilonfix,' iend= ',iend
            print *,'!!!         '
            print *,'!!! Radii will not be computed for this time.'
            print *,' '
          endif

          idta=0; iisa=0; iwa=0; iqa=0
          if (allocated(dtemp))    deallocate (dtemp,stat=idta)
          if (allocated(isortix))  deallocate (isortix,stat=iisa)
          if (allocated(iwork))    deallocate (iwork,stat=iwa)
          if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

          if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0) then
            print *,' '
            print *,'!!! ERROR in getradii deallocating arrays.'
            print *,'!!! iqa= ',iqa,' idta= ',idta
            print *,'!!! iisa= ',iisa,' iwa= ',iwa
            print *,'!!! EXITING at GR-E....'
            stop 98
          endif

          igrret = 99
          return
        endif

      endif

      if (jend > jmax) jend = jmax
 
      if ( verb .ge. 3 ) then
        print *,' '
        print *,'In getradii, ibeg= ',ibeg,' iend= ',iend
        print *,'             jbeg= ',jbeg,' jend= ',jend
        print *,'  ilonfix= ',ilonfix,' jlatfix= ',jlatfix
      endif
 
c     -----------------------------------------------------------
c     PART 2: Within the area of grid points defined by jbeg, 
c     jend, ibeg and iend, (1) calculate all the wind speeds at 
c     each grid point, (2) calculate all of the distances from 
c     each grid point to the storm center, (3) assign each grid 
c     point to one of the 4 quadrants (NE,NW,SE,SW), (4) in each 
c     quadrant, sort the points, based on windspeed.
c     -----------------------------------------------------------

      jnum = jend - jbeg + 1
      inum = iend - ibeg + 1
c      numalloc = ((jnum * inum) / 2) + inum/2 + jnum/2
      numalloc = jnum * inum + inum/2 + jnum/2

      if ( verb .ge. 3 ) then
        print *,'in getradii, numalloc= ',numalloc,' radmax= ',radmax
      endif

      if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

      allocate (quadinfo(4,numalloc,2),stat=iqa)

      if (iqa /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in sub getradii allocating quadinfo array.'
          print *,'!!! iqa = ',iqa
        endif

        idta=0; iisa=0; iwa=0; iqa=0
        if (allocated(dtemp))    deallocate (dtemp,stat=idta)
        if (allocated(isortix))  deallocate (isortix,stat=iisa)
        if (allocated(iwork))    deallocate (iwork,stat=iwa)
        if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

        if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0) then
          print *,' '
          print *,'!!! ERROR in getradii deallocating arrays.'
          print *,'!!! iqa= ',iqa,' idta= ',idta
          print *,'!!! iisa= ',iisa,' iwa= ',iwa
          print *,'!!! EXITING at GR-F....'
          stop 98
        endif

        igrret = 94
        return
      endif

      quadct = 0

c     Calculate the distances and wind speeds at each grid point.  If
c     the distance is < radmax, include that wind info in the 
c     appropriate quadinfo array location for that quadrant.

      quadmax = 0.0

      jloop: do j=jbeg,jend
        iloop: do i=ibeg,iend

          ip = i
      
          if (i > imax) then
            if (trkrinfo%gridtype == 'global') then
              ip = i - imax   ! If wrapping past GM
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: In getradii, the '
                print *,'!!!    user-requested point '
                print *,'!!!    is beyond the eastern bounds of '
                print *,'!!!    this regional grid.  '
                print *,'!!!    At location B in subroutine.'
                print *,'!!!         '
                print *,'!!!   imax of regional grid    = ',imax
                print *,'!!!   eastern point in question = ',i
                print *,'!!!         '
                print *,'!!! Radii will not be computed for this time'
                print *,' '
              endif

              idta=0; iisa=0; iwa=0; iqa=0
              if (allocated(dtemp))    deallocate (dtemp,stat=idta)
              if (allocated(isortix))  deallocate (isortix,stat=iisa)
              if (allocated(iwork))    deallocate (iwork,stat=iwa)
              if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

              if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0) 
     &        then
                print *,' '
                print *,'!!! ERROR in getradii deallocating arrays.'
                print *,'!!! iqa= ',iqa,' idta= ',idta
                print *,'!!! iisa= ',iisa,' iwa= ',iwa
                print *,'!!! EXITING at GR-G...'
                stop 98
              endif

              igrret = 99
              return
            endif
          endif
      
          if (i < 1) then
            if (trkrinfo%gridtype == 'global') then
              ip = i + imax
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i < 1 in sub getradii'
                print *,'!!! for a non-global grid.  i= ',i
                print *,'!!! At location C in subroutine.'
                print *,'!!!         '
                print *,'!!! Radii will not be computed for this time'
                print *,' '
              endif

              idta=0; iisa=0; iwa=0; iqa=0
              if (allocated(dtemp))    deallocate (dtemp,stat=idta)
              if (allocated(isortix))  deallocate (isortix,stat=iisa)
              if (allocated(iwork))    deallocate (iwork,stat=iwa)
              if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

              if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0)
     &        then
                print *,' '
                print *,'!!! ERROR in getradii deallocating arrays.'
                print *,'!!! iqa= ',iqa,' idta= ',idta
                print *,'!!! iisa= ',iisa,' iwa= ',iwa
                print *,'!!! EXITING at GR-H....'
                stop 98
              endif
              
              igrret = 99
              return
            endif
          endif

          call calcdist (xcenlon,xcenlat,glon(ip),glat(j),dist,degrees)
          if (dist > radmax) cycle iloop

          if (valid_pt(ip,j)) then

            vmag = sqrt (u(ip,j,levsfc)**2  + v(ip,j,levsfc)**2)

cc            print *,'i= ',i,' j= ',j,' dist= ',dist,' vmag= ',vmag

            ! Calculate the angle from the center point to this point
            ! and then assign this point to the appropriate quadrant bin

            rlonc = (360.-glon(ip)) * dtr
            rlatc = glat(j) * dtr
            rlonb = (360.-xcenlon) * dtr
            rlatb = xcenlat * dtr
            d     = degrees * dtr

c            write (6,59) 360.-xcenlon,xcenlat,360.-glon(ip),glat
c
c            write (6,61) d/dtr,rlatc/dtr,360.-(rlonc/dtr),rlatb/dtr
c     &                  ,360.-(rlonb/dtr),sin(rlatc),sin(rlatb),cos(d)
c     &                  ,sin(d),cos(rlatb)
c
c
c   59       format (1x,'+++ gr, xcenlon= ',f8.3,'W   xcenlat= '
c     &            ,f8.3,'  glon= ',f8.3,'W   glat= ',f8.3)
c
c   61       format (1x,'+++ gr, d rlatc rlonc rlatb rlonb= ',5f9.4
c     &            ,' sin(rlatc)= ',f8.6,' sin(rlatb)= ',f8.6
c     &            ,' cos(d)= ',f8.6,' sin(d)= ',f8.6
c     &            ,' cos(rlatb)= ',f8.6)

            if (d == 0.0) then

              pt_heading = 0.0

            else

              cosarg = (sin(rlatc)-sin(rlatb)*cos(d)) /
     &                 (sin(d)*cos(rlatb))
              if (cosarg > 1.0)  cosarg = 1
              if (cosarg < -1.0) cosarg = -1
  
              if (sin(rlonc-rlonb) < 0.0) then
                pt_heading_rad = acos(cosarg)
              else
                pt_heading_rad = 2*pi - acos(cosarg)
              endif

              pt_heading = pt_heading_rad / dtr
 
            endif

            if (pt_heading >= 0.0 .and. pt_heading < 90.) then
              ! NE quadrant
              iq = 1
            else if (pt_heading >= 90.0 .and. pt_heading < 180.) then
              ! SE quadrant
              iq = 2
            else if (pt_heading >= 180.0 .and. pt_heading < 270.) then
              ! SW quadrant
              iq = 3
            else if (pt_heading >= 270.0 .and. pt_heading <= 360.) then
              ! NW quadrant
              iq = 4
            endif

c            write (6,73) xcenlat,360.-xcenlon,j,i,ip,glat(j)
c     &                  ,360.-glon(ip),pt_heading,iq

   73       format (1x,'+++ getradii  clat clon: ',f6.2,' ',f7.2,'W',3i4
     &            ,'  plat plon: ',f6.2,' ',f7.2,'W   Dir: ',f7.2
     &            ,'  Quad: ',i2)

            quadct(iq) = quadct(iq) + 1
            quadinfo(iq,quadct(iq),1) = vmag
            quadinfo(iq,quadct(iq),2) = dist
            if (vmag > quadmax(iq,4)) then
              quadmax(iq,1) = glon(ip)
              quadmax(iq,2) = glat(j)
              quadmax(iq,3) = dist
              quadmax(iq,4) = vmag
            endif

          endif

        enddo iloop
      enddo jloop

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'After loop, quadct(1)= ',quadct(1),' quadct(2)= '
     &       ,quadct(2)
        print *,'            quadct(3)= ',quadct(3),' quadct(4)= '
     &       ,quadct(4)
        print *,' '
        
        write (6,110) cstormid,ifcsthr,'NE',quadmax(1,1),quadmax(1,2)
     &       ,quadmax(1,3)*0.539638,quadmax(1,4)*1.9427
        write (6,110) cstormid,ifcsthr,'SE',quadmax(2,1),quadmax(2,2)
     &       ,quadmax(2,3)*0.539638,quadmax(2,4)*1.9427
        write (6,110) cstormid,ifcsthr,'SW',quadmax(3,1),quadmax(3,2)
     &       ,quadmax(3,3)*0.539638,quadmax(3,4)*1.9427
        write (6,110) cstormid,ifcsthr,'NW',quadmax(4,1),quadmax(4,2)
     &       ,quadmax(4,3)*0.539638,quadmax(4,4)*1.9427
        print *,' '
        
 110    format (' quadmax: ',a3,1x,i3.3,1x,a2,1x,' lon: ',f6.2,'E',1x
     &       ,' lat: ',f6.2,' radius: ',f7.2,' nm',2x,' vmag: '
     &       ,f6.2,' kts')
      endif
        
c     Now go through each quadrant and put the wind speed distance info
c     into a temporary array (dtemp), sort that array, and then scan 
c     through that array to find the various thresholds.  

      quadrantloop: do k=1,4

        if (need_to_expand_r34(k) == 'y') then
          print *,'---> R34 search underway for quadrant ',k
     &           ,' radmax= ',radmax
          continue
        else
          print *,'+ R34 okay for quadrant ',k,'... skipping...'
          cycle quadrantloop
        endif

        if (allocated(isortix)) deallocate (isortix)
        if (allocated(dtemp)) deallocate (dtemp)
        if (allocated(iwork)) deallocate (iwork)
        allocate (isortix(quadct(k)),stat=iisa)
        allocate (dtemp(quadct(k)),stat=idta)
        allocate (iwork(quadct(k)),stat=iwa)
        if (iisa /= 0 .or. idta /= 0 .or. iwa /= 0) then
          
          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in getradii allocating isortix, dtemp'
            print *,'!!! or iwork array for quadrant= ',k
            print *,'!!! iisa = ',iisa,' idta= ',idta,' iwa= ',iwa
          endif

          idta=0; iisa=0; iwa=0; iqa=0
          if (allocated(dtemp))    deallocate (dtemp,stat=idta)
          if (allocated(isortix))  deallocate (isortix,stat=iisa)
          if (allocated(iwork))    deallocate (iwork,stat=iwa)
          if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

          if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0)
     &    then
            print *,' '
            print *,'!!! ERROR in getradii deallocating arrays.'
            print *,'!!! iqa= ',iqa,' idta= ',idta
            print *,'!!! iisa= ',iisa,' iwa= ',iwa
            print *,'!!! EXITING at GR-I....'
            stop 98
          endif

          itret = 94
          return
        endif

c       -------------------

        do m=1,quadct(k)
          dtemp(m) = quadinfo(k,m,2)
        enddo

        imode = 2
        isortix = 0

        call qsort (dtemp,isortix,quadct(k))

ccccc        call orders (imode,iwork,dtemp,isortix,quadct(k),1,8,1)
cccc        call orders_4byte (imode,iwork,dtemp,isortix
cccc     &                   ,quadct(k),1,8,1)

        if ( verb .ge. 3 ) then
          print *,' '
c         **************************************************************
c---      mf 20100609
c         CAUSE OF SEG FAULT!!!!!!!! -- not sure still an issue if dtemp
c         properly allocated
c
          !print *,' dtemp(isortix(1)) = ',dtemp(isortix(1))
          print *,' dtemp(isortix(quadct(k)))= '
     &           ,dtemp(isortix(quadct(k)))
          print *,' isortix(1) = ',isortix(1)
          print *,' isortix(quadct(k)) = ',isortix(quadct(k))
        endif

c        ! Uncomment these next lines to see a listing in the  output of
c        ! all wind values & distances in this quadrant less than radmax
c        do iqq = 1,quadct(k)
c          print *,' iqq= ',iqq,'  vmag= ',quadinfo(k,isortix(iqq),1)
c     &           ,' dist= ',quadinfo(k,isortix(iqq),2)
c        enddo

c       -------------------

        if (quadct(k) < 2) then   ! not enough members in array

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! IN GETRADII, NOT ENOUGH MEMBERS IN ARRAY FOR'
            print *,'!!! QUADRANT #',k,' .... # members = quadct(k)= '
     &           ,quadct(k)
            print *,'!!! SETTING ALL VRADII = 0 for quadrant = ',k
          endif

          vradius(1,k) = 0
          vradius(2,k) = 0
          vradius(3,k) = 0
          cycle quadrantloop
        endif

c       Within this quadrant, go through the sorted array of wind
c       magnitudes and compare those wind values against the set
c       wind thresholds to get the wind radii.   The array has 
c       been sorted by distance from the storm center in order of
c       closest (ipoint=1) to farthest (ipoint=quadct(k)).  We 
c       analyze these wind values by starting at the farthest 
c       point and moving inward until we hit a point that has a
c       wind value of at least 34-knot winds (17.5 m/s).  When
c       we find that point, we interpolate between that point and
c       the next farthest out point to get the distance that would
c       be for the exact 17.5 m/s value.  We then continue searching
c       through the wind values down closer to the storm center to
c       see if we can find values for the 50- and 64-knot winds.

        iwindix = 1
        ipoint = quadct(k) + 1

c        print *,'drp: quad= ',k,' quadct= ',quadct(k)

        threshloop: do while (iwindix <= 3 .and. ipoint > 1)

          if (iwindix > 1) then
            if (first_time_thru_getradii) then

              ! We are only doing the wind radii for 50 and 64 kts on
              ! the first time through subroutine getradii (we only
              ! need to do the multiple call iterations for 34 kts).
              !
              ! Make sure vmax for this lead time exceeds the radii
              ! threshold being diagnosed.  The check below avoids,
              ! for example, reporting 50-kt wind radii when the max
              ! wind diagnosed was only 44 kts.  This can happen since
              ! the radius for searching for radii is larger than the 
              ! radius for searching for the max wind.
              if (vmaxwind >= windthresh(iwindix)) then
                if (verb >= 3) then
c                  print *,' '
c                  print *,' +++ vmaxwind of ',vmaxwind,' m/s exceeds'
c                  print *,' +++ threshold of ',windthresh(iwindix)
c                  print *,' +++ (m/s), so radii checking will continue'
c                  print *,' +++ for this threshold.'
c                  print *,' +++ igrct= ',igrct,' ipoint= ',ipoint
c     &                   ,' iwindix= ',iwindix
                  continue
                endif
                continue
              else
                if (verb >= 3) then
                  print *,' '
                  print *,' --- vmaxwind of ',vmaxwind,' m/s does NOT'
                  print *,' - - exceed threshold of '
     &                   ,windthresh(iwindix)
                  print *,' - - (m/s), so radii checking will NOT be '
                  print *,' - - performed for this threshold.'
                endif
                iwindix = iwindix + 1
                cycle threshloop
              endif
            else
              iwindix = iwindix + 1
              cycle threshloop
            endif
          endif

          ipoint = ipoint - 1

          if (quadinfo(k,isortix(ipoint),1) < windthresh(iwindix)) then
            cycle threshloop
          else
            if (ipoint == quadct(k)) then

              if ( verb .ge. 3 ) then
                print *,' ' 
                print *,'!!! NOTE: In getradii, a max wind radius was' 
                print *,'!!! found at the maximum radius checked, so ' 
                print *,'!!! you may want to make sure that you are'
                print *,'!!! checking at a far enough distance from  ' 
                print *,'!!! the fix position, that is, you may want to'
                print *,'!!! increase the value of radmax in subroutine'
                print *,'!!! getradii. Currently, radmax (km) = ',radmax
                print *,'!!! iwindix = ',iwindix,' quadrant= ',k
              endif

              vradius(iwindix,k) = int( ((quadinfo(k,isortix(ipoint),2) 
     &                                  * 0.5396) / 5.0) + 0.5) * 5
            else 

c             Interpolate between the 2 closest distances to each wind
c             threshold to get "exact" distance to that wind threshold
c             radius, convert from km to nm, and then round to the 
c             nearest 5 nm (since TPC uses this precision). 
c             7/23/98 UPDATE: Jim Gross has asked that values not be
c             rounded to the nearest 5 nm, but rather only to the 
c             nearest 1 nm.

              exactdistkm = quadinfo(k,isortix(ipoint),2) +
     &        ( (quadinfo(k,isortix(ipoint),1) - windthresh(iwindix)) /
     &          (quadinfo(k,isortix(ipoint),1) -
     &           quadinfo(k,isortix(ipoint+1),1)) *
     &          ( (quadinfo(k,isortix(ipoint+1),2) -
     &             quadinfo(k,isortix(ipoint),2)) ) )

              exactdistnm = exactdistkm * 0.5396   ! Convert km to nm
              vradius(iwindix,k) = int(exactdistnm + 0.5)

cc             vradius(iwindix,k) = int( (exactdistnm / 5.0) + 0.5) * 5


              if ( verb .ge. 3 ) then
                print *,'iwindix= ',iwindix,' exactdistnm = '
     &                 ,exactdistnm
                print *,'vradius(iwindix,k) =',vradius(iwindix,k)
              endif

            endif

c           The possibility exists, especially for coarse  output 
c           grids, that there could be a jump over more than 1 wind-
c           thresh category when going from 1 grid point to the next, so
c           we need to account for this.  For example, if 1 point has
c           vmag = 15 m/s and the next point closer in has vmag = 28 
c           m/s, then between those 2 points you have the thresholds
c           for gale force AND storm force winds, so to be safe, we
c           actually need to add 1 to ipoint and re-check the current 
c           point, if the wind value at that point is found to be 
c           greater than a wind threshold value (which it has if you've
c           gotten to this point in threshloop).

            ipoint = ipoint + 1

            iwindix = iwindix + 1

          endif

        enddo threshloop

        if (allocated(dtemp))    deallocate (dtemp,stat=idta)
        if (allocated(isortix))  deallocate (isortix,stat=iisa)
        if (allocated(iwork))    deallocate (iwork,stat=iwa)
        if (idta /= 0 .or. iisa /= 0 .or. iwa /= 0) then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in getradii deallocating isortix or'
            print *,'!!! dtemp or work for quadrant= ',k
            print *,'!!! idta= ',idta,' iisa= ',iisa,' iwa= ',iwa
          endif

          idta=0; iisa=0; iwa=0; iqa=0
          if (allocated(dtemp))    deallocate (dtemp,stat=idta)
          if (allocated(isortix))  deallocate (isortix,stat=iisa)
          if (allocated(iwork))    deallocate (iwork,stat=iwa)
          if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

          if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0)
     &    then
            print *,' '
            print *,'!!! ERROR in getradii deallocating arrays.'
            print *,'!!! iqa= ',iqa,' idta= ',idta
            print *,'!!! iisa= ',iisa,' iwa= ',iwa
            print *,'!!! EXITING at GR-J....'
            stop 98
          endif

          itret = 94
          return
        endif

      enddo quadrantloop

      if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

      if (iqa /= 0) then
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in getradii deallocating quadinfo array.'
          print *,'!!! iqa= ',iqa
        endif

        idta=0; iisa=0; iwa=0; iqa=0
        if (allocated(dtemp))    deallocate (dtemp,stat=idta)
        if (allocated(isortix))  deallocate (isortix,stat=iisa)
        if (allocated(iwork))    deallocate (iwork,stat=iwa)
        if (allocated(quadinfo)) deallocate (quadinfo,stat=iqa)

        if (iqa /= 0 .or. iwa /= 0 .or. idta /= 0 .or. iisa /= 0)
     &  then
          print *,' '
          print *,'!!! ERROR in getradii deallocating arrays.'
          print *,'!!! iqa= ',iqa,' idta= ',idta
          print *,'!!! iisa= ',iisa,' iwa= ',iwa
          print *,'!!! EXITING at GR-K....'
          stop 98
        endif

        itret = 94
        return
      endif
c
      return
      end

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_max_wind (xcenlon,xcenlat,imax,jmax,dx,dy
     &                    ,valid_pt,levsfc,vmax,trkrinfo,rmax,igmwret)
c
c     ABSTRACT: This subroutine looks for the maximum near-surface wind
c     near the storm center.  This subroutine is only concerned with the 
c     value of the max wind, NOT where it's located radially with 
c     respect to the center.  The value that's returned in vmax is the 
c     max wind speed in m/s, which are the units the data are stored in.
c     However, when the max wind values are  output in output_atcf, they
c     will be converted from m/s to knots.
c
c     INPUT:
c
c     xcenlon   fix longitude of storm center for current forecast hour
c     xcenlat   fix latitude of storm center for current forecast hour
c     imax      max i dimension of model grid
c     jmax      max j dimension of model grid
c     dx        grid spacing in i-direction of model grid
c     dy        grid spacing in j-direction of model grid
c     valid_pt  logical bitmap for valid data at a grid point
c     levsfc    integer holding the value of the array member that holds
c               the near-surface winds in the u and v arrays (at orig
c               writing, it's = 4).
c
c     OUTPUT:
c    
c     vmax      value of maximum near-surface wind near the storm ctr
c     rmax      radius of max winds
c     igmwret   return code from this subroutine
c
c     LOCAL:
c
c     radmaxwind the maximum radius to look for a max wind near the 
c                storm center.  You have to allow this to be bigger for
c                model grids with coarse resolution (ECMWF 2.5 degree).

      USE grid_bounds; USE tracked_parms; USE trig_vals; USE trkrparms
      USE verbose_output

      type (trackstuff) trkrinfo

      real      radmaxwind,degrees,dx,dy,rmax
      logical(1) valid_pt(imax,jmax)
c
      igmwret = 0
      rmax    = -99.0

      if ((dx+dy)/2. <= 1.25) then
        if ((dx+dy)/2. <= 0.25) then
          radmaxwind = 300.0
        else
          radmaxwind = 300.0
        endif
      else
        radmaxwind = 500.0
      endif

c     Roughly fix xcenlat to the grid point just poleward of xcenlat,
c     and fix xcenlon to the grid point just EASTward of xcenlon.

      if (xcenlat >= 0.0) then
        jlatfix = int((glatmax - xcenlat)/dy + 1.)
      else
        jlatfix = ceiling((glatmax - xcenlat)/dy + 1.)
      endif

      ilonfix = int((xcenlon - glonmin)/dx + 2.)

      if (ilonfix > imax) then
        if (trkrinfo%gridtype == 'global') then
          ilonfix = ilonfix - imax   ! If wrapping past GM
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: In get_max_wind, the '
            print *,'!!!    user-requested eastern boundary'
            print *,'!!!    is beyond the eastern bounds of '
            print *,'!!!    this regional grid.  '
            print *,'!!!         '
            print *,'!!!   imax of regional grid    = ',imax
            print *,'!!!   eastern ilonfix = ',ilonfix
            print *,'!!!         '
            print *,'!!! Value of vmax will be set to 0 for this time.'
            print *,' '
          endif

          igmwret = 99
          return
        endif    
      endif   

      if (ilonfix < 1) then
        if (trkrinfo%gridtype == 'global') then
          ilonfix = ilonfix + imax
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: ilonfix < 1 in subroutine  get_max_wind'
            print *,'!!! for a non-global grid.'
            print *,'!!! ilonfix= ',ilonfix
            print *,'!!!         '
            print *,'!!! Value of vmax will be set to 0 for this time.'
            print *,' '
          endif

          igmwret = 99
          return
        endif    
      endif

c     Calculate number of grid points to have surrounding the storm so
c     that we are sure radmaxwind is within those points.

      cosfac  = cos (xcenlat * dtr)
      numipts = ceiling((radmaxwind/(dtk*dx))/cosfac)
      numjpts = ceiling(radmaxwind/(dtk*dy))
 
      jbeg = jlatfix - numjpts
      jend = jlatfix + numjpts + 1
      ibeg = ilonfix - (numipts + 1)
      iend = ilonfix + numipts

      if (jbeg > jmax .or. jbeg < 1 .or. jend < 1) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'ERROR in get_max_wind calculating jbeg or jend.'
          print *,'jbeg= ',jbeg,' jend= ',jend
          print *,'Value of vmax will be set to 0 for this time.'
        endif

        vmax = 0.0
        igmwret = 99
        return
      endif

      if (jend > jmax) jend = jmax

      if ( verb .ge. 3 ) then

        print *,' '
        print *,'In get_max_wind, ibeg= ',ibeg,' iend= ',iend
        print *,'                 jbeg= ',jbeg,' jend= ',jend
        print *,'        ilonfix= ',ilonfix,' jlatfix= ',jlatfix
      endif

      vmax = 0.0
      do j=jbeg,jend
        do i=ibeg,iend

          ip = i

          if (i > imax) then
            if (trkrinfo%gridtype == 'global') then
              ip = i - imax   ! If wrapping past GM
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: In get_max_wind, the '
                print *,'!!!    user-requested point '
                print *,'!!!    is beyond the eastern bounds of '
                print *,'!!!    this regional grid.  '
                print *,'!!!    At location B in subroutine.'
                print *,'!!!         '
                print *,'!!!   imax of regional grid    = ',imax
                print *,'!!!   eastern point = ',i
                print *,'!!!         '
                print *,'!!! Value of vmax will be set to 0 for '
                print *,'!!! this time.'
                print *,' '
              endif

              igmwret = 99
              return
            endif
          endif

          if (i < 1) then
            if (trkrinfo%gridtype == 'global') then
              ip = i + imax
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i < 1 in sub get_max_wind'
                print *,'!!! for a non-global grid.'
                print *,'!!! ilonfix= ',ilonfix
                print *,'!!! At location C in subroutine.'
                print *,'!!!         '
                print *,'!!! Value of vmax will be set to 0 for '
                print *,'!!! this time'
                print *,' '
              endif

              igmwret = 99
              return
            endif   
          endif

          call calcdist (xcenlon,xcenlat,glon(ip),glat(j),dist,degrees)

          if (dist > radmaxwind) cycle

          if (valid_pt(ip,j)) then
            vmag = sqrt (u(ip,j,levsfc)**2  + v(ip,j,levsfc)**2)
            if (vmag > vmax) then
              vmax = vmag
              rmax = dist * 0.539638  ! convert from km to nm
            endif
          endif

        enddo
      enddo

      if ( verb .ge. 3 ) then
        print *,'At end of get_max_wind, vmax= ',vmax,' rmax= ',rmax
      endif

      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine fixcenter (clon,clat,ist,ifh,calcparm,geslon,geslat
     &               ,inp,stderr,fixlon,fixlat,xvalues,maxstorm,ifret)
c
c     ABSTRACT: This subroutine loops through the different parameters
c               for the input storm number (ist) and calculates the 
c               center position of the storm by taking an average of
c               the center positions obtained for those parameters.
c               First we check to see which parameters are within a 
c               max error range (errmax), and we discard those that are
c               not within that range.  Of the remaining parms, we get 
c               a mean position, and then we re-calculate the position
c               by giving more weight to those estimates that are closer
c               to this mean first-guess position estimate.
c
c     INPUT:
c     clon     Center longitudes of tracked parms for this storm & ifh
c     clat     Center latitudes of tracked parms for this storm & ifh
c     ist      Storm number
c     ifh      Index for forecast hour
c     calcparm Logical; Use this parm's location for this storm or not
c     geslon   Initial guess longitude for this storm at this fcst hour
c     geslat   Initial guess latitude for this storm at this fcst hour
c     inp      contains the input date and model number information
c     xvalues  The actual max or min data values for each parameter
c     maxstorm max # of storms to be handled in this run
c
c     INPUT/OUTPUT:
c     stderr   Standard deviation of the position "error" of the parms
c              relative to the guess storm position.  As long as the 
c              distance of a parm center to the guess center is <=
c              errpmax, it is included in the std dev calculation.
c
c     OUTPUT:
c     fixlon   Best approximation of storm center's longitude
c     fixlat   Best approximation of storm center's latitude
c     ifret    Return code from this subroutine
c
c     LOCAL:
c     storm       Contains tcvitals info for the storms (def_vitals)
c     trkerr_avg  Sum/avg of the track errors for all parms for this
c                 fcst hour, regardless of whether or not the error was
c                 > errmax.  It's used for getting the std deviation of
c                 the position error for this forecast time, to be used
c                 as part of the errmax calculation for the next fcst 
c                 time.
c     iclose      Number of parameters whose position estimates are 
c                 found to be within a distance errmax of the guess pos
c     wtpos       The weight given to each position estimate.  It's 
c                 based on the distance from the average position.
c     errdist     The "error" of the parameter center position relative
c                 to the storm's guess position.
c     avgerr      Average "error" of the parameter center positions
c                 relative to the storm's guess position.
c     use4next    Logical; If a parm center has been calculated but its
c                 distance from the guess position is > errmax, we don't
c                 use this center in calculating the new guess position,
c                 however we will use this position in calculating the 
c                 standard deviation of the current time's guess 
c                 positions, to be used in calculating the new errmax 
c                 for the next forecast time.  So in this subroutine,
c                 calcparm may be set to FALSE if errdist > errmax, but
c                 use4next will not be set to FALSE (Actually, it is 
c                 only set to FALSE if errdist > errpmax, which is 
c                 defined in error_parms and is roughly 600km).
c     stderr_close  Standard deviation of position errors for parms that
c                 have center estimates that are within a distance 
c                 errmax of the guess position.
c     clon_fguess These are the first-guess mean position estimates, 
c     clat_fguess which are the means of the position estimates that
c                 are within a distance errmax.  These first-guess mean
c                 positions will be refined by giving more weight to
c                 individual parameter estimates that are closer to 
c                 this first-guess mean position.
c     dist_from_mean Contains the "error" distance of each parameter
c                 from the first-guess mean position (clon_fguess,
c                 clat_fguess).  NOTE: If a parameter is not within
c                 a distance errmax of the guess position for this
c                 time (geslon,geslat), then there will be NO 
c                 dist_from_mean calculated for that parm.
c
      USE error_parms; USE set_max_parms; USE inparms; USE def_vitals
      USE atcf; USE gen_vitals; USE tracked_parms
      USE verbose_output

      type (datecard) inp

      real      clon(maxstorm,maxtime,maxtp),temp_clon(maxtp)
      real      clat(maxstorm,maxtime,maxtp),temp_clat(maxtp)
      real      fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real      trkerr(maxtp),errdist(maxtp),xvalues(maxtp)
      real      stderr(maxstorm,maxtime),devia(maxtp),wtpos(maxtp)
      real      dist_from_mean(maxtp)
      real      degrees,errtmp
      integer   gt345_ct,lt15_ct
      logical(1) calcparm(maxtp,maxstorm),use4next(maxtp)
      character charparm(maxtp)*8,charmaxmin(maxtp)*8
c
      data charparm /'zeta 850','zeta 700','circ 850','NOT USED'
     &   ,'circ 700','NOT USED',' gph 850',' gph 700','    MSLP'
     &   ,'circ sfc','zeta sfc',' thk 5-8',' thk 2-5',' thk 2-8'/
      data charmaxmin /'  Max   ','  Max   ','  Min   ','NOT USED'
     &   ,'  Min   ','NOT USED','  Min   ','  Min   ','  Min   '
     &   ,'  Min   ','  Max   ','  Max   ','  Max   ','  Max   '/
c
      ifret=0
c
c     We need to judge whether each parameter position is reasonable,
c     so we'll check to make sure that the dist from each parameter's 
c     estimate to the guess position is less than a maximum allowable 
c     error. If it's the first forecast time, use the initial error max 
c     (defined as errinit in error_parms) as errmax.  Otherwise, the 
c     max error criterion is that the distance error must not exceed 3 
c     times the previous forecast time's standard deviation (after a 
c     small growth factor has been applied).
c     UPDATE 3/5/98: During testing, it was found that just using the
c     previous time's stdev made errmax too "jumpy" (i.e., at vt=48h,
c     errmax could = 380, and then at vt=54h, errmax could jump down
c     to 190, so we've changed it so that it uses an average of the 
c     stdev's from the 3 previous forecast times to maintain some
c     continuity between successive forecast times).
c
      if (ifh == 1) then
        if (atcfname == 'GFSO' .or. atcfname == 'MRFO' .or. 
     &      atcfname == 'GDAS' .or. atcfname == 'GFDT' .or.
     &      atcfname(1:3) == 'AP0' .or. atcfname(1:3) == 'AN0' .or.
     &      atcfname(1:3) == 'AP1' .or. atcfname(1:3) == 'AN1' .or.
     &      atcfname(1:3) == 'AC0' .or. atcfname == 'AEAR' ) then
          errmax  = err_gfs_init
          errinit = err_gfs_init
        else if (atcfname == 'EMX ' .or. atcfname == 'FV3 ') then
          errmax  = err_ecm_max
          errinit = err_ecm_max
        else
          errmax  = err_reg_init
          errinit = err_reg_init
        endif
      else
        if (atcfname == 'GFSO' .or. atcfname == 'MRFO' .or.
     &      atcfname == 'GDAS' .or. atcfname == 'GFDT' .or.
     &      atcfname(1:3) == 'AP0' .or. atcfname(1:3) == 'AN0' .or.
     &      atcfname(1:3) == 'AP1' .or. atcfname(1:3) == 'AN1' .or.
     &      atcfname(1:3) == 'AC0' .or. atcfname == 'AEAR') then
          errinit = err_gfs_init
        else if (atcfname == 'EMX ' .or. atcfname == 'FV3 ') then
          errinit = err_ecm_max
        else
          errinit = err_reg_max
        endif

        if (ifh >= 4) then
          xavg_stderr = (stderr(ist,ifh-3) + stderr(ist,ifh-2)
     &                +  stderr(ist,ifh-1)) / 3.0
        else if (ifh == 3) then
          xavg_stderr = (stderr(ist,ifh-2) + stderr(ist,ifh-1)) / 2.0
        else if (ifh == 2) then
          xavg_stderr = stderr(ist,ifh-1)
        endif

c       The following errmax statement was replaced by the ensuing 4 
c       lines due to a compiler bug on some other platforms:
c        errmax = amin1(amax1(3.0*xavg_stderr*errpgro,errinit)
c     &                ,errpmax)

        errtmp = 3.0*xavg_stderr*errpgro
        errmax = max(errtmp,errinit)
        errtmp = errpmax
        errmax = min(errmax,errtmp)

      endif

      if ( verb .ge. 3 ) then
        print *,' '
        if (ifh > 1) then
          print '(a42,f8.2,a15,f8.2)'
     &         ,' At beg of fixcenter, stderr(ist,ifh-1) = '
     &         ,stderr(ist,ifh-1),'  xavg_stderr= ',xavg_stderr 
        else
          print '(a45,a18)'
     &         ,' At beg of fixcenter, stderr(ist,ifh-1) = N/A'
     &         ,'  xavg_stderr= N/A'
        endif
        print *,'At beg of fixcenter, errpgro = ',errpgro
        print *,'At beg of fixcenter, errinit = ',errinit
        print *,'At beg of fixcenter, errpmax = ',errpmax
        print *,'At beg of fixcenter, ifh= ',ifh,' errmax= ',errmax
      endif

      trkerr_avg = 0.0
      iclose = 0; itot4next = 0 
      clonsum = 0.0; clatsum = 0.0
      errdist = 0.0
      use4next = .FALSE.
      gt345_ct = 0
      lt15_ct  = 0
 
c     For each parm, check to see if the estimated center is within
c     distance errmax of the guess center.  If it's within errmax,
c     then use that parm for locating the center.  If it's NOT
c     within errmax, but IS within errpmax, then we still use this
c     in calculating the standard deviation of the parameters for
c     helping to determine the errmax for the next forecast hour.

c OLD NOTE: For calculating the std dev to be used for the next
c OLD forecast hour, do NOT use vmag 850, vmag 700 or vmag sfc, since
c OLD those parms are always guaranteed to be within a short range of 
c OLD the guess, due to the nature of the algorithm (see subroutine
c OLD get_uv_center for further details on that).

      do ip=1,maxtp

        if (ip == 4 .or. ip == 6) then   ! Parms 4 & 6 not defined.
          calcparm(ip,ist) = .FALSE.   
          cycle  
        endif
        if (calcparm(ip,ist)) then
          call calcdist (geslon,geslat,clon(ist,ifh,ip)
     &                    ,clat(ist,ifh,ip),dist,degrees)
          errdist(ip) = dist
          if (dist <= errpmax) then
            use4next(ip) = .TRUE.
            trkerr_avg = trkerr_avg + dist
            itot4next = itot4next + 1
          endif
          if (dist <= errmax) then
            iclose = iclose + 1
            if (clon(ist,ifh,ip) > 345.) then
              gt345_ct = gt345_ct + 1
            endif
            if (clon(ist,ifh,ip) < 15.) then
              lt15_ct  = lt15_ct + 1
            endif
            clonsum = clonsum + clon(ist,ifh,ip)
            clatsum = clatsum + clat(ist,ifh,ip)
          else 
            calcparm(ip,ist) = .FALSE.
          endif
        endif

      enddo

      if (iclose > 0) then
        if (gt345_ct > 0 .and. lt15_ct > 0) then
          ! We have some parms left of the GM and some to the right,
          ! so we will add (360*lt15_ct) to the sum of the lons (clonsum)
          clon_fguess = (clonsum + (360.*float(lt15_ct)))/ iclose
        else
          clon_fguess = clonsum / float(iclose)
        endif
        if (clon_fguess >= 360.0) then
          clon_fguess = clon_fguess - 360.
        endif
        clat_fguess = clatsum / float(iclose)
      endif

c     Print out a table listing of the locations of the  fixes for 
c     the individual parameters.

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'--------------------------------------------------'
        write (6,95) 'Individual fixes follow..., fhr= ',ifhours(ifh)
     &       ,ifclockmins(ifh),'  ',storm(ist)%tcv_storm_id,' '
     &       ,storm(ist)%tcv_storm_name
        write (6,97) gstorm(ist)%gv_gen_date,gstorm(ist)%gv_gen_fhr
     &       ,gstorm(ist)%gv_gen_lat
     &       ,gstorm(ist)%gv_gen_latns,gstorm(ist)%gv_gen_lon
     &       ,gstorm(ist)%gv_gen_lonew,gstorm(ist)%gv_gen_type
        print *,'Model name = ',atcfname
        print *,'Values of -99.99 indicate that a fix was unable to be'
        print *,'made for that paramater.  Parameters 4 & 6 are not'
        print *,'used.  Vorticity data values are scaled by 1e5.'
        print *,'Circulation data values are scaled by 1e-6.'
        print *,'errdist is the distance that the position estimate is'
        print *,'from the guess position for this time.  MSLP value '
        print *,'here may differ from that in the atcfunix file since '
        print *,'the one here is that derived from the area-averaged '
        print *,'barnes analysis, while that in the atcfunix file is '
        print *,'from a specific gridpoint.'
        write (6,21) geslon,360.-geslon,geslat
        write (6,*)  ' '
        write (6,23) 
        write (6,25)
      endif

      if (geslat > 0.0) then
        charmaxmin(1)  = '  Max   '
        charmaxmin(2)  = '  Max   '
        charmaxmin(3)  = '  Max   '
        charmaxmin(5)  = '  Max   '
        charmaxmin(10) = '  Max   '
        charmaxmin(11) = '  Max   '
      else 
        charmaxmin(1)  = '  Min   '
        charmaxmin(2)  = '  Min   '
        charmaxmin(3)  = '  Min   '
        charmaxmin(5)  = '  Min   '
        charmaxmin(10) = '  Min   '
        charmaxmin(11) = '  Min   '
      endif

      do ip=1,maxtp
        if (ip == 1 .or. ip == 2 .or. ip == 11) then 
          ! This IF block allows vorticity values to be 
          ! written out and scaled up by 1e5 ...
          if (clon(ist,ifh,ip) < 0.001 .and. 
     &        clon(ist,ifh,ip) > -0.001) then

            if ( verb .ge. 3 ) then
              write (6,27) ip,charparm(ip),charmaxmin(ip),0.0
     &             ,0.0,clat(ist,ifh,ip),xvalues(ip)*1e5
     &             ,calcparm(ip,ist),errdist(ip)
            endif

          else

            if ( verb .ge. 3 ) then
              write (6,27) ip,charparm(ip),charmaxmin(ip)
     &             ,clon(ist,ifh,ip),360.-clon(ist,ifh,ip)
     &             ,clat(ist,ifh,ip),xvalues(ip)*1e5
     &             ,calcparm(ip,ist),errdist(ip)
            endif

          endif

        elseif (ip == 3 .or. ip == 5 .or. ip == 10) then
          ! This IF block allows circulation values to be
          ! written out and scaled down by 1e-6 ...

          if (clon(ist,ifh,ip) < 0.001 .and.
     &        clon(ist,ifh,ip) > -0.001) then

            if ( verb .ge. 3 ) then
              write (6,27) ip,charparm(ip),charmaxmin(ip),0.0
     &             ,0.0,clat(ist,ifh,ip),xvalues(ip)*1e-6
     &             ,calcparm(ip,ist),errdist(ip)
            endif

          else

            if ( verb .ge. 3 ) then
              write (6,27) ip,charparm(ip),charmaxmin(ip)
     &             ,clon(ist,ifh,ip),360.-clon(ist,ifh,ip)
     &             ,clat(ist,ifh,ip),xvalues(ip)*1e-6
     &             ,calcparm(ip,ist),errdist(ip)
            endif

          endif

        else
          if (clon(ist,ifh,ip) < 0.001 .and.
     &        clon(ist,ifh,ip) > -0.001) then

            if ( verb .ge. 3 ) then
              write (6,27) ip,charparm(ip),charmaxmin(ip),0.0
     &             ,0.0,clat(ist,ifh,ip),xvalues(ip)
     &             ,calcparm(ip,ist),errdist(ip)
            endif

          else

            if ( verb .ge. 3 ) then
              write (6,27) ip,charparm(ip),charmaxmin(ip)
     &             ,clon(ist,ifh,ip),360.-clon(ist,ifh,ip)
     &             ,clat(ist,ifh,ip),xvalues(ip)
     &             ,calcparm(ip,ist),errdist(ip)
            endif

          endif
        endif
      enddo

 21   format (' Guess location for this time: ',f7.2,'E  (',f6.2,'W)'
     &       ,2x,f7.2)
 23   format (' parm#    parm    Max/Min   Lon_fix(E)  Lon_fix(W)'
     &       ,'   Lat_fix   Max/Min_value   calcparm   errdist(km)')
 25   format (' -----    ----    -------   ----------  ----------'
     &       ,'   -------   -------------   --------   ----------')
 27   format (2x,i2,4x,a8,2x,a8,3x,f7.2,5x,f7.2,4x,f7.2,7x,f9.2
     &       ,6x,L2,7x,f7.2)
 95   format (1x,a33,1x,i4,':',i2.2,a2,a4,a1,a9)
 97   format (' Gen ID (if available): ',i10.10,'_F',i3.3,'_',i3.3,a1
     &       ,'_',i4.4,a1,'_',a3)


c     If number of parameter centers close enough (iclose) > 0, then
c     calculate the center by taking an average of all the parameter
c     center positions that are within distance errmax from the guess
c     position (geslon,geslat).  Get a first-guess mean position, and
c     then re-calculate the position estimate by giving more weight
c     to those positions that are closer to the first-guess mean
c     position.

      dist_from_mean = 0.0

      if (iclose > 0) then

c       Get distances from first-guess mean position....

        do ip=1,maxtp
          if (calcparm(ip,ist)) then
            call calcdist (clon_fguess,clat_fguess,clon(ist,ifh,ip)
     &                    ,clat(ist,ifh,ip),dist,degrees)
            dist_from_mean(ip) = dist
          endif
        enddo
           
c       Get the mean distance of each parameter estimate from 
c       the first-guess mean position

        call avgcalc (dist_from_mean,maxtp,calcparm(1,ist)
     &               ,xmn_dist_from_mean,iaret)

        if (iaret == 0) then

          call stdevcalc (dist_from_mean,maxtp,calcparm(1,ist)
     &                   ,xmn_dist_from_mean,stderr_close,isret)

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'After stdevcalc, xmn_dist_from_mean= '
     &           ,xmn_dist_from_mean,' stderr_close= '
     &           ,stderr_close,' isret= ',isret
          endif

        endif
        if (iaret /= 0 .or. isret /= 0) then
          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR IN FIXCENTER -- Error occurred in either'
            print *,'!!! avgcalc or stdevcalc.  Storm number = ',ist
            print *,'!!! RCC from avgcalc = ',iaret
            print *,'!!! RCC from stdevcalc = ',isret
            print *,'!!! Center fix will NOT be made, and processing'
            print *,'!!! for this storm is ending.  The probable cause'
            print *,'!!! is that no calcparms were valid for this storm'
            print *,'!!! at this forecast hour.'
          endif

          fixlon(ist,ifh) = -999.0
          fixlat(ist,ifh) = -999.0
          ifret = 95
          return
        endif

        if (calcparm(1,ist) .or. calcparm(2,ist) .or. calcparm(7,ist)
     &      .or. calcparm(8,ist) .or. calcparm(9,ist) 
     &      .or. calcparm(11,ist) .or. calcparm(3,ist)
     &      .or. calcparm(10,ist) .or. calcparm(5,ist)
     &      .or. calcparm(12,ist) .or. calcparm(13,ist)
     &      .or. calcparm(14,ist)) then
          continue
        else

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! In fixcenter, STOPPING PROCESSING for this'
            print *,'!!! storm.  The reason is that none of the  fix'
            print *,'!!! locations for parms z850, z700, zeta 850,'
            print *,'!!! zeta 700, MSLP, wcirc_850, wcirc_700, '
            print *,'!!! wcirc_sfc, sfc zeta or the various levels '
            print *,'!!! of thicknesses were within a '
            print *,'!!! reasonable distance of the guess location.'
            print *,'!!! ist= ',ist,' ifh= ',ifh
            write (6,102) ifhours(ifh),ifclockmins(ifh)
 102        format (1x,'!!! Forecast hour: ',i4,':',i2.2)
          endif

          fixlon(ist,ifh) = -999.0
          fixlat(ist,ifh) = -999.0
          ifret = 95
          return
        endif

c       Now re-calculate the mean position by giving more weight 
c       to those position estimates that are closer to the first
c       guess mean position.  Note that if stderr_close < 5.0, we
c       force it to be 5.0; we do this to avoid getting very 
c       large numbers for devia values, which could make the 
c       weights (wtpos) equal to 0.  This occurred during testing
c       when only 2 parameters were valid, and so, of course, the
c       standard deviation from the mean of those 2 parameters 
c       was close to 0, which gave devia values around 6000, and
c       then wtpos values of 0, leading to a divide by 0 crash
c       later on in subroutine  wtavrg.

        kprm=0

        if (stderr_close > 0.0) then
          if (stderr_close < 5.0) then

            if ( verb .ge. 3 ) then
              print *,' '
              print *,'NOTE: Since stderr_close had a value less than'
              print *,'5, stderr_close has been forced to be equal'
              print *,'to 5 in order to avoid dividing by zero later'
              print *,'on in subroutine  wtavrg.'
            endif

            stderr_close = 5.0
          endif
          do ip=1,maxtp
            if (calcparm(ip,ist)) then
              kprm = kprm + 1
              devia(kprm) = dist_from_mean(ip) / stderr_close
              wtpos(kprm) = exp(-devia(kprm)/3.)
              temp_clon(kprm) = clon(ist,ifh,ip)
              temp_clat(kprm) = clat(ist,ifh,ip)

              if ( verb .ge. 3 ) then
                write (6,113) ip,kprm,dist_from_mean(ip),devia(kprm)
     &               ,wtpos(kprm),temp_clon(kprm)
     &               ,360.-temp_clon(kprm),temp_clat(kprm)
              endif

            endif
          enddo
  113     format (1x,'ip= ',i2,' kprm= ',i2,' dist_from_mean= ',f7.3
     &           ,' devia= ',f7.3,' wtpos= ',f8.5,2x,3(2x,f7.2))
        else
c     
c         This next if statement is for the case in which only 1
c         parameter is valid, for which the stderr_close will = 0
c         (obviously), but as long as we have 1 valid parameter,
c         continue processing, and set the weight for that parm = 1.
c         The else portion is for the case in which stderr_close
c         = 0 with NO parms being close.
c
          if (iclose == 1) then
            do ip=1,maxtp
              if (calcparm(ip,ist)) then
                kprm = kprm + 1
                wtpos(kprm) = 1
                temp_clon(kprm) = clon(ist,ifh,ip)
                temp_clat(kprm) = clat(ist,ifh,ip)
              endif
            enddo
          else
            
            if ( verb .ge. 1 ) then
              print *,' '
              print *,'!!! ERROR IN FIXCENTER, stderr_close not > 0'
              print *,'!!! stderr_close = ',stderr_close
              print *,'!!! The probable cause is that no calcparms were'
              print *,'!!! valid for this storm at this forecast hour.'
            endif

            fixlon(ist,ifh) = -999.0
            fixlat(ist,ifh) = -999.0
            ifret = 95
            return
          endif
        endif
c
        if (kprm > 0) then
          call wtavrg_lon (temp_clon,wtpos,kprm,fixlon(ist,ifh),iwtret1)
          call wtavrg (temp_clat,wtpos,kprm,fixlat(ist,ifh),iwtret2)
          if (iwtret1 == 0 .and. iwtret2 == 0) then
            if (verb .ge. 3) then
              print *,' '
              write (6,173) storm(ist)%tcv_storm_id,ifhours(ifh)
     &             ,ifclockmins(ifh),fixlon(ist,ifh)
     &             ,360.-fixlon(ist,ifh),fixlat(ist,ifh)
  173         format ('At end of fixcenter:  ',a4,'  fhr= ',i4,':',i2.2
     &              ,'   Fix position=  ',f7.2,'E  (',f6.2,'W)',2x,f7.2)
              print *,' '
            endif
          else
            if ( verb .ge. 1 ) then
              print *,' '
              print *,'!!! ERROR IN FIXCENTER in call to wtavrg.'
              print *,'!!! Return Codes from wtavrg calls follow: '
              print *,'!!!   RCC from wtavrg for long fix: ',iwtret1
              print *,'!!!   RCC from wtavrg for lat  fix: ',iwtret2
              print *,'!!! This means a divide by zero would have '
              print *,'!!! been attempted, which means that the '
              print *,'!!! weights in wtpos are not > 0.  Check in'
              print *,'!!! subroutine  fixcenter where devia values'
              print *,'!!! are calculated to see if something is '
              print *,'!!! wrong there.  Values of wtpos array follow:'
              print *,'!!! ',wtpos
              print *,'!!! ist= ',ist,' ifh= ',ifh,' iclose= ',iclose
              print *,'!!! errmax= ',errmax,' kprm= ',kprm
              print *,' '
            endif
            fixlon(ist,ifh) = -999.0
            fixlat(ist,ifh) = -999.0
            ifret = 95
            return
          endif
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR IN FIXCENTER, kprm NOT > 0'
            print *,'!!! This means that, for whatever reason, the '
            print *,'!!! calcparm logical flag was set to .FALSE. for'
            print *,'!!! all of the parameters.  Thus, a center'
            print *,'!!! position could not be obtained for this storm'
            print *,'!!! ist= ',ist,' ifh= ',ifh,' iclose= ',iclose
            print *,'!!! errmax= ',errmax,' kprm= ',kprm
          endif

          fixlon(ist,ifh) = -999.0
          fixlat(ist,ifh) = -999.0
          ifret = 95
          return
        endif

      else

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'!!! NOTE: IN FIXCENTER, No storms are within errmax '
          print *,'!!! OR the calcparm logical flag was set to .FALSE. '
          print *,'!!! all of the parameters.  Thus, a center'
          print *,'!!! position could not be obtained for this storm'
          print *,'!!! ist= ',ist,' ifh= ',ifh,' iclose= ',iclose
          print *,'!!! errmax= ',errmax
        endif

        fixlon(ist,ifh) = -999.0
        fixlat(ist,ifh) = -999.0
        ifret = 95
        return
      endif 
 
c     Now calculate the average error of all the parms that are within
c     a radius errpmax (defined in error_parms, ~600km), and the std
c     dev of those errors.  This standard deviation will be used in
c     calculating the maximum allowable error for the next forecast 
c     time.
 
      if (itot4next > 0 .and. ifret /= 95) then
        trkerr_avg = trkerr_avg / float(itot4next)
        call stdevcalc (errdist,maxtp,use4next,trkerr_avg
     &                 ,stderr(ist,ifh),isret)
        if (isret /= 0) then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in FIXCENTER calculating std deviation '
            print *,'!!! for use in next forecast hours errmax.'
            print *,'!!! ist= ',ist,' ifh= ',ifh,' itot4next= '
     &             ,itot4next
          endif

          ifret = 95
        endif
      endif
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine avgcalc (xdat,kmax,valid,xavg,iaret)
c
c     ABSTRACT: This subroutine just calculates a straight average of
c     the parameters in the input array (xdat).  The logical array 
c     (valid) indicates whether or not to include a particular array
c     member or not in the calculation.
 
      USE verbose_output

      real      xdat(kmax)
      logical(1) valid(kmax)
c
      iaret = 0
c
      xsum = 0.0
      ict = 0
      do i=1,kmax
        if (valid(i)) then
          xsum = xsum + xdat(i)
          ict = ict + 1
        endif
      enddo 
c
      if (ict > 0) then
        xavg = xsum / float(ict)
      else

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in avgcalc, ict NOT > 0'
        endif

        xavg = xdat(1)
        iaret = 95
      endif
c 
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine wtavrg (xdat,wt,kmax,xwtavg,iwtret)
c
c     ABSTRACT: This subroutine calculates a weighted average of the 
c     parameters in the input array (xdat) using the input weights
c     in the input array (wt).  It is used to calculate the center lat
c     and lon fix positions.
c
      USE verbose_output

      real     xdat(kmax),wt(kmax)
c
      iwtret = 0
c
      xwtavg = 0.0
      wtot = 0.0
      do i=1,kmax
        xwtavg = xwtavg + xdat(i)*wt(i)
        wtot = wtot + wt(i)
      enddo
c
      if (wtot > 0.0) then
        xwtavg = xwtavg / wtot
      else

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in wtavrg, wtot NOT > 0'
        endif

        iwtret = 95
      endif
c
      return
      end

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine wtavrg_lon (xlon,wt,kmax,xwtavg,iwtret)
c
c     ABSTRACT: This subroutine calculates a weighted average of the
c     parameters in the input array (xlon) using the input weights
c     in the input array (wt).  This subroutine is specifically used
c     to find the center lon fix positions.  It contains code to 
c     account for wrapping around the Greenwich Meridian.
c

      USE verbose_output

      real     xlon(kmax),wt(kmax)
      integer  gt345_ct,lt15_ct
c
      iwtret = 0
      gt345_ct = 0
      lt15_ct  = 0

c     First check to see if we have lons that are both to the left 
c     and the right of the greenwich meridian

      do i = 1,kmax
        if (xlon(i) > 345.) then
          gt345_ct = gt345_ct + 1
        endif
        if (xlon(i) < 15.) then
          lt15_ct = lt15_ct + 1
        endif
      enddo

      if (gt345_ct > 0 .and. lt15_ct > 0) then
        ! We have some lons that are in the 300's (west of the GM), and
        ! some that are in the 0's (east of the GM).  We need to 
        ! standardize these if we want to get a meaningful average.
        do i = 1,kmax
          if (xlon(i) < 15.) then
            xlon(i) = xlon(i) + 360.0
          endif
        enddo
      endif

      xwtavg = 0.0
      wtot = 0.0
      do i=1,kmax
        xwtavg = xwtavg + xlon(i)*wt(i)
        wtot = wtot + wt(i)
      enddo
c
      if (wtot > 0.0) then
        xwtavg = xwtavg / wtot
      else

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in wtavrg_lon, wtot NOT > 0'
        endif

        iwtret = 95
      endif

      if (xwtavg >= 360.0) then
        xwtavg = xwtavg - 360.0
      endif
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine stdevcalc (xdat,kmax,valid,xavg,stdx,isret)

      USE verbose_output

      real      xdat(kmax)
      logical(1) valid(kmax)

      isret = 0

      stdx = 0.0
      ict = 0
      do i=1,kmax
        if (valid(i)) then
          stdx = stdx + (xdat(i) - xavg)**2
          ict = ict + 1
        endif
      enddo
 
      if (ict > 0) then
        stdx = sqrt(stdx/float(ict))
        if (stdx == 0.0) then
c         This can happen if you have just 2 points; The mean position
c         will be exactly in the middle of the 2 points and so the
c         standard deviation around that mean point will be 0.  And
c         since the calling routine will quit if the returned standard
c         deviation is 0, we must force it to be 1 so the program
c         continues running.  Theoretically, it could also happen with
c         3 or more points, but the likelihood of the distances working
c         out to exactly equidistant for 3 points is not that good.
          stdx = 1.0
        endif
      else

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in stdevcalc, ict NOT > 0'
        endif

        isret = 95
      endif
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_wind_circulation (uvgeslon,uvgeslat,imax,jmax
     &                     ,dx,dy
     &                     ,ist,level,valid_pt,cflag
     &                     ,ctlon,ctlat,fxval,trkrinfo
     &                     ,cmodel_type,maxmin,igwcret)
c
c     ABSTRACT: This subroutine calculates the center fix position for
c     the wind circulation near the storm center.  This center fix is 
c     done differently than for the other parms.  With this fix,
c     we limit the area that is searched.  This subroutine is not
c     called until center fixes have been made for the 5 other parms
c     (z850, z700, zeta850, zeta700, mslp).  Once those  fixes have been
c     made, a modified first guess is made of the average of the 
c     original guess position for this lead time and the 5 other parm 
c     fixes that have already been made for this lead time.  That 
c     modified guess position is passed into this subroutine as uvgeslon
c     and uvgeslat, and that's where the searching for the wind 
c     circulation is centered.
c
c     This subroutine works by converting the winds to Vt and Vr at 
c     each grid point evaluated, relative to each candidate center point
c     that is being evaluated at the time in the loop.  We then compute
c     the circulation at each of 24 azimuths surrounding the storm 
c     center, where circulation = Vt * (length of a 1/24 arc, in meters)  
c     This process is repeated for 7 successive radii and the results 
c     are summed up over all radii, approximating a solid disk 
c     circulation.  The point at which the circulation is maximized 
c     (NHEM) or minimized (SHEM) is the center of circulation.
c
c     grid_maxlat northernmost latitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_minlat southernmost latitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_maxlon easternmost longitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_minlon westernmost longitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     cmodel_type character, 'global' or 'regional'
c

      USE radii; USE grid_bounds; USE tracked_parms; USE trig_vals
      USE level_parms; USE trkrparms
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo

      integer date_time(8)
      character (len=10) big_ben(3)

      character(*)  cmodel_type,maxmin
      integer, parameter :: numdist=7,numazim=24
      integer imax,jmax,ist,level,igwcret,icvpret,idist,iazim
      real rdist(numdist),vr(numazim,numdist),vt(numazim,numdist)
      real vt_mean(numdist),circul_band(numdist)
      real grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
      real rads,ri,uvgeslon,uvgeslat,dx,dy,ctlon,ctlat,fxval
      real temp_grid_minlon,temp_guesslon,rlatt,rlont,bear
      real targlon,targlat,xintrp_u,xintrp_v,vt_azim_sum,degrees
      real circ_diff,circ_diff_sum,hemisphere,wind_mag_ctr,dist
      real xmin_circ_diff_mean,xmax_circ_diff_mean,tlon,tlat
      real dell,fmax,fmin,grid_buffer,circ_diff_mean
      real circumference,arclength
      real circul_disk,xmax_circul_disk,xmin_circul_disk
      integer ibiret1,ibiret2,igvtret,azimuth_ct,igiret,npts
      integer igibret
      integer circ_diff_ct,ir,nhalf,bskip1,bskip2,iskip,nlev
      integer ilonfix,jlatfix,ibeg,iend,jbeg,jend,i,j,k,iix,jix
      logical(1) cflag, valid_pt(imax,jmax)

c----------------
c

      print *,' '
      print *,'top of get_wind_circulation, '
      print *,' glatmax= ',glatmax
      print *,' glatmin= ',glatmin
      print *,' glonmax= ',glonmax
      print *,' glonmin= ',glonmin
      print *,' trkrinfo%gridtype= ',trkrinfo%gridtype
      print *,' cmodel_type= ',cmodel_type
      print *,' maxmin= ',maxmin
      print *,' imax= ',imax,'  jmax= ',jmax
      print *,' uvgeslon= ',uvgeslon,'  uvgeslat= ',uvgeslat
      print *,' dx= ',dx,' dy= ',dy,' ist= ',ist
      print *,' cflag= ',cflag
      print *,' ctlon= ',ctlon,' ctlat= ',ctlat
      print *,' fxval= ',fxval
      print *,' igwcret= ',igwcret

      igwcret = 0

      grid_maxlat = glatmax
      grid_minlat = glatmin
      grid_maxlon = glonmax
      grid_minlon = glonmin

      rads = rads_wind_circ
      ri = ri_wind_circ

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'At beg of get_wind_circulation, rads= ',rads
     &       ,' ri= ',ri,' dx= ',dx,' dy= ',dy
      endif

      dell = (dx+dy)/2.
      npts = rads/(dtk*dell)
      fmax  = -1.0e+15; fmin  =  1.0e+15
      ctlon = 0.0; ctlat = 0.0

c     Distances checked and the radial intervals are a function of 
c     the grid resolution....

      if (dell > 0.50) then
        rdist(1) =  50.
        rdist(2) =  85.
        rdist(3) = 120.
        rdist(4) = 155.
        rdist(5) = 190.
        rdist(6) = 225.
        rdist(7) = 260.
      else
        rdist(1) =  35.
        rdist(2) =  65.
        rdist(3) =  95.
        rdist(4) = 125.
        rdist(5) = 155.
        rdist(6) = 185.
        rdist(7) = 215.
      endif

      select case (level)
        case (850);  nlev = nlev850  ! check module level_parms for
        case (700);  nlev = nlev700  ! the values of these....
        case (500);  nlev = nlev500
        case (1020); nlev = levsfc
      end select

      print *,' in get_wind_circulation, nlev= ',nlev

      if (uvgeslat >= 0.0) then
        hemisphere = 1.0
      else
        hemisphere = -1.0
      endif

      call get_ij_bounds (npts,0,ri,imax,jmax,dx,dy
     &             ,grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
     &             ,uvgeslon,uvgeslat
     &             ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend
     &             ,igibret)

      if (grid_minlon > 330. .and. grid_maxlon < 30.) then
        ! Our grid is straddling over the GM.  This can happen either
        ! with a global grid or with a regional grid.  How can it happen
        ! for a global grid?  Well, for the case in which this routine
        ! is called from subroutine  get_uv_center, where a smaller
        ! subgrid of data is passed in, and that smaller subgrid may
        ! straddle the GM.  Anyway, we need a workaround.
        ! This workaround will put the minimum longitude
        ! in terms of a negative number, e.g., as opposed to being say,
        ! 354, it will be -6.  You can then leave the grid_maxlon as is.
        temp_grid_minlon = grid_minlon - 360.
        if (uvgeslon > 330.) then
          ! If our grid is straddling the GM and we have adjusted the
          ! grid_minlon to be a negative number, then we also need to
          ! check on the guesslon and adjust it if it is also to west
          ! of the GM.
          temp_guesslon = uvgeslon - 360.
        else
          temp_guesslon = uvgeslon
        endif
      else
        temp_grid_minlon = grid_minlon
        temp_guesslon = uvgeslon
      endif

      if (cmodel_type == 'regional') then
        grid_buffer = 0.30
      else
        grid_buffer = 0.0
      endif

c     For the  wind circulation analysis, we will want to speed things 
c     up for finer resolution grids.  We can do this by skipping some 
c     of the points in the  wind circulation analysis.

      if (dell > 0.20) then
        bskip1 = 1
        bskip2 = 1
      else if (dell > 0.10 .and. dell <= 0.20) then
        bskip1 = 3
        bskip2 = 2
      else if (dell > 0.05 .and. dell <= 0.10) then
        bskip1 = 5
        bskip2 = 3
      else if (dell > 0.03 .and. dell <= 0.05) then
        bskip1 = 8
        bskip2 = 3
      else if (dell <= 0.03) then
        bskip1 = 10
        bskip2 = 4
      endif

c      bskip1 = 1
c      bskip2 = 1

      jix = 0

c      xmin_circ_diff_mean =  9999.0
c      xmax_circ_diff_mean = -9999.0

      xmin_circul_disk =  9999.0
      xmax_circul_disk = -9999.0

      if (verb .ge. 3) then
        print *,' '
        print *,'In get_wind_circulation, prior to first loop, '
        print *,'   npts= ',npts,' dell= ',dell,' rads= ',rads
        print *,' '
      endif

      jloop1: do j=-npts,npts,bskip1

        jix = jix + 1
        rlatt = uvgeslat + dell*float(j)

        iix = 0

        iloop1: do i=-npts,npts,bskip1

          iix = iix + 1
          rlont = temp_guesslon + dell*float(i)

c         If any points in the search grid would extend beyond the grid
c         boundaries, then check and see if this is global grid.  If it
c         is, and the extension occurred in the i-direction, then adjust
c         the longitude to allow for grid wrapping.  If it is a regional
c         grid, then just cycle the iloop.  In previous versions of the
c         tracker, we would exit with an error message, but doing it
c         this way allows us to continue tracking some systems that may
c         be close to the grid boundary.  Also, remember to factor in
c         the grid_buffer discussed in the doc block above for this
c         subroutine.

          if (rlont >= (grid_maxlon + dx - grid_buffer)) then
            if (trkrinfo%gridtype == 'global') then
              rlont = rlont - 360.  ! We just GM-wrapped for the full,
                                    ! regular, global grid
            else
              cycle iloop1
            endif
          endif

          if (rlont < (temp_grid_minlon + grid_buffer)) then
            if (trkrinfo%gridtype == 'global') then
              rlont = rlont + 360.  ! We just GM-wrapped for the full,
                                    ! regular, global grid
            else
              cycle iloop1
            endif
          endif

          if (rlatt > (grid_maxlat - grid_buffer) .or.
     &        rlatt < (grid_minlat + grid_buffer)) then
            cycle iloop1
          endif

c         Make sure that the point being investigated here as a
c         potential center has valid data at that point.  That is, for
c         some hires regional grids that have been rotated/converted
c         from a non-latlon grid to a latlon grid, there can be
c         locations within the (i,j) space that do not have valid data
c         at them. It makes no sense to consider a point such as this
c         as a potential center.
c         There is another simpler case here that we are watching out
c         for.  This is simply the case, again for model data where we
c         only have the innermost nest.  Depending on what we choose
c         for the variable "rads" above, with the way that "npts" is
c         defined for these iloops and jloops that we're in, we may be
c         searching over points that are simply well off the grid.
c         Therefore, it is critical to run through this
c         check_valid_point subroutine to make sure that we're not
c         going to inadvertantly be performing an analysis at one of
c         these "off-grid" points.  So.... if the return code from
c         check_valid_point comes back non-zero, simply cycle iloop
c         and go to the next point.

          call check_valid_point (imax,jmax,dx,dy,u(1,1,nlev),maxmin
     &        ,valid_pt,rlont,rlatt,grid_maxlat,grid_minlat,grid_maxlon
     &        ,temp_grid_minlon,trkrinfo,icvpret)

          if (icvpret /= 0) then
            if ( verb .ge. 1 ) then
              print *,'!!! NOT A VALID PT from call in '
              print *,'!!! get_wind_circulation:  icvpret= ',icvpret
            endif
            cycle iloop1
          endif

          call calcdist(rlont,rlatt,temp_guesslon,uvgeslat,dist,degrees)
          if (dist .gt. rads) cycle iloop1

c         Now go through each radius, starting from inner and working
c         to outer, and at each one, go around through all of the 24 
c         discrete azimuths, starting at 7.5 and adding 15 degrees 
c         clockwise each time, all the way up through 352.5.

          vt_mean = 0.0
          vt = 0.0
          vr = 0.0

          circul_band = 0.0
          circul_disk = 0.0

          radiusloop1: do idist = 1,numdist

            azimuth_ct = 0
            vt_azim_sum = 0.0

            ! Compute the length of a 1/numazim arc at this radius, and
            ! be sure to multiply by 1000 to convert from km to m for
            ! use in computing the circulation....

            circumference = 2 * pi * rdist(idist) * 1000.0
            arclength = circumference / float(numazim)

            azimloop1: do iazim = 1,numazim

              bear = ((iazim-1) * 15.) + 7.5

              call distbear (rlatt,rlont,rdist(idist)
     &                      ,bear,targlat,targlon)

ctmwc              if ( verb .ge. 3 ) then
ctmwc                print *,' '
ctmwc                print '(5(a11,f7.2))','  ctr lat= ',rlatt
ctmwc     &               ,'  ctr lon= ',rlont
ctmwc     &               ,'   rdist=  ',rdist(idist),'  targlat= ',targlat
ctmwc     &               ,'  targlon= ',targlon
ctmwc                print '(19x,a10,f7.2,35x,a9,f7.2)',' ctr lon= '
ctmwc     &               ,360.-rlont
ctmwc     &               ,'targlon= ',360.-targlon
ctmwc              endif

              ! These calls to bilin_int_uneven pass a variable "level"
              ! that contains the vertical level to pull the wind data
              ! from, either 850, 700 or surface (which will be 
              ! indicated by a value/code of 1020).
          
              call bilin_int_uneven (targlat,targlon
     &            ,dx,dy,imax,jmax,trkrinfo,level,'u',xintrp_u,ibiret1)

              call bilin_int_uneven (targlat,targlon
     &            ,dx,dy,imax,jmax,trkrinfo,level,'v',xintrp_v,ibiret2)

              if (ibiret1 == 0 .and. ibiret2 == 0) then
                call getvrvt (rlont,rlatt,targlon,targlat
     &                       ,xintrp_u,xintrp_v,vr(iazim,idist)
     &                       ,vt(iazim,idist),igvtret)
                azimuth_ct = azimuth_ct + 1
                circul_band(idist) = circul_band(idist)
     &                             + (vt(iazim,idist) * arclength)
c                vt_azim_sum = vt_azim_sum + vt(iazim,idist)
              else if (ibiret1 == 85 .or. ibiret2 == 85) then
                vr(iazim,idist) = -999.0
                vt(iazim,idist) = -999.0
              else
                igwcret = 95
                return
              endif

            enddo azimloop1

            if (azimuth_ct > 0) then
              ! Add the value for the circulation in this radial 
              ! band (circul_band(idist)) to the "solid disk" 
              ! circulation total.  Also, 
              ! Compute azimuthally-averaged Vt at this distance
              circul_disk = circul_disk + circul_band(idist)
              vt_mean(idist) = vt_azim_sum / float(azimuth_ct)
            else
c              vt_mean(idist) = -999.0
              print *,' '
            endif  

          enddo radiusloop1

          if (uvgeslat > 0.0) then
            if (circul_disk > xmax_circul_disk) then
              xmax_circul_disk = circul_disk
              ctlon = rlont
              ctlat = rlatt
            endif
          else
            if (circul_disk < xmin_circul_disk) then
              xmin_circul_disk = circul_disk
              ctlon = rlont
              ctlat = rlatt
            endif
          endif

CC-->      This section was commented out in Feb 2018 due to finding a
cc         bug/flaw in the whole "circulation difference" concept, and
cc         it has now been replaced throughout this subroutine with 
cc         more robust circulation computation logic.
cc
cc         Now get the wind magnitude at the candidate center of 
cc         circulation (i.e., the one that we just used for 
cc         computing all of the Vr and Vt in the previous azimloop1
cc         and radiusloop1).
c    
c          call bilin_int_uneven (rlatt,rlont
c     &        ,dx,dy,imax,jmax,trkrinfo,level,'u',xintrp_u,ibiret1)
c          call bilin_int_uneven (rlatt,rlont
c     &        ,dx,dy,imax,jmax,trkrinfo,level,'v',xintrp_v,ibiret2)
c          if (ibiret1 == 0 .and. ibiret2 == 0) then
c            wind_mag_ctr = sqrt (xintrp_u**2 + xintrp_v**2)
c          else
c            if ( verb .ge. 3 ) then
c              print *,' '
c              print *,'!!! NOTE: bilint_uneven failed for center'
c              print *,'!!! wind mag in get_wind_circulation.'
c              print *,'!!! rlont= ',rlont,' rlatt= ',rlatt
c              print *,'!!!  '
c            endif
c          endif
c
cc          print *,' '
cc          print *,'1st run,  wind_mag_ctr= ',wind_mag_ctr
c
c          circ_diff_ct  = 0
c          circ_diff_sum = 0.0
c          do ir = 1,numdist
cc              print *,'1st run, ir= ',ir,'  vtmean(ir)= ',vt_mean(ir)
c            if (vt_mean(ir) > -998.0) then
c              circ_diff = vt_mean(ir) - (hemisphere * wind_mag_ctr)
c              circ_diff_ct  = circ_diff_ct + 1
c              circ_diff_sum = circ_diff_sum + circ_diff
c            endif
c          enddo
c
c          print *,'1st run,  circ_diff_ct= ',circ_diff_ct
c
c          if (circ_diff_ct > 0) then
c
c            circ_diff_mean = circ_diff_sum / float(circ_diff_ct)
c
cc            print *,'1st run,  circ_diff_sum= ',circ_diff_sum
cc     &             ,'  circ_diff_mean= ',circ_diff_mean
c
c            if (uvgeslat > 0) then
c              if (circ_diff_mean > xmax_circ_diff_mean) then
c                xmax_circ_diff_mean = circ_diff_mean
c                ctlon = rlont
c                ctlat = rlatt
c              endif
c            else
c              if (circ_diff_mean < xmin_circ_diff_mean) then
c                xmin_circ_diff_mean = circ_diff_mean
c                ctlon = rlont
c                ctlat = rlatt
c              endif
c            endif
c          endif
c
cc          print *,'1st run,  xmax_circ_diff_mean= '
cc     &           ,xmax_circ_diff_mean
c
c          if (uvgeslat > 0) then
c            if (circ_diff_mean > xmax_circ_diff_mean) then
c              xmax_circ_diff_mean = circ_diff_mean
c              ctlon = rlont
c              ctlat = rlatt
c            endif
c          else
c            if (circ_diff_mean < xmin_circ_diff_mean) then
c              xmin_circ_diff_mean = circ_diff_mean
c              ctlon = rlont
c              ctlat = rlatt
c            endif
c          endif

        enddo iloop1

      enddo jloop1

      if (uvgeslat >= 0.0) then
        write (6,61) 360.-ctlon,ctlat,xmax_circul_disk
      else
        write (6,63) 360.-ctlon,ctlat,xmin_circul_disk
      endif

  61  format (' After first run, Wind Circulation (NHEM) ctlon= ',f8.3
     &       ,'W  ctlat= ',f8.3,'  xmax_circul_disk = ',f15.1)
  63  format (' After first run, Wind Circulation (SHEM) ctlon= ',f8.3
     &       ,'W  ctlat= ',f8.3,'  xmin_circul_disk = ',f15.1)
 
c     If nhalf is specified as 0, then don't go through any more 
c     iterations of this routine, just exit with the value that we 
c     already got the first time through the loop, above.

      if (dell > 0.50) then
        nhalf = 4
      else if (dell > 0.20 .and. dell <= 0.50) then
        nhalf = 3
      else if (dell > 0.10 .and. dell <= 0.20) then
        nhalf = 2
      else if (dell > 0.05 .and. dell <= 0.10) then
        nhalf = 1
      else if (dell <= 0.05) then
c        nhalf = 0
        nhalf = 1
c        if ( verb .ge. 3 ) then        
c          print *,' '
c          print *,'In get_wind_circulation, dell is < 0.05 deg, so '
c          print *,'nhalf is set to 0 and only the first iteration of'
c          print *,'the search loop is done.'
c          print *,'  dell= ',dell,'  nhalf= ',nhalf
c        endif
      endif

      if (nhalf < 1) then
        if (uvgeslat > 0.0) then
          fxval = xmax_circul_disk
        else
          fxval = xmin_circul_disk
        endif
        return
      endif

c     If on our first pass through, we were dealing with a regional grid
c     that straddled the GM, then it becomes (for now) too much of a
c     coding hassle to deal with in the rest of this routine (i.e., in
c     all the nhalf iterations), so we will just go with the first run
c     through for the center fix and exit the routine.

      if (grid_minlon > 330. .and. grid_maxlon < 30.) then
        if (uvgeslat > 0.0) then
          fxval = xmax_circul_disk
        else
          fxval = xmin_circul_disk
        endif
        return
      endif          
          
c     ---------------------------------------------------------------
c     ---------------------------------------------------------------
c     Halve the grid spacing to refine the location and value of the
c     max/min value, but restrict the area of the new search grid.

c      npts = npts/2
      npts = max(npts,1)

c     -------------------------------------------------------------
c     First, recalculate the i and j beginning and ending points to
c     be used in the  barnes analysis subroutine.  Only do this once
c     for this grid-refinement (even though the grid is redefined 
c     nhalf times in this subroutine), but make sure to have the
c     possible search grid be big enough to allow the possibility of
c     the grid shifting way right or way left each time through the
c     loop (get_ij_bounds takes care of this).  Cut the value of 
c     rads in half (only do this once) so that any points beyond 
c     rads/2 are not considered as potential centers.

      rads = 0.5 * rads

      call get_ij_bounds (npts,nhalf,ri,imax,jmax,dx,dy
     &              ,grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
     &              ,ctlon,ctlat,trkrinfo
     &              ,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igibret)

      if (igibret /= 0) then
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in get_wind_circulation from call to '
          print *,'!!! get_ij_bounds just before nhalf loop.  '
          print *,'!!! Stopping processing for storm number ',ist
        endif
        igwcret = 92
        return
      endif

c     --------------------------------------------------------------
c     Now do the actual searching for the max/min value

      kloop: do k = 1,nhalf

        call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                     ,date_time)
        if ( verb .ge. 3 ) then
          write (6,32) k,date_time(5),date_time(6),date_time(7)
 32       format (1x,'TIMING: get_wind_circ kloop, k= ',i2,'   '
     &         ,i2.2,':',i2.2,':',i2.2)
        endif

        dell = 0.5*dell
        tlon = ctlon
        tlat = ctlat
c        xmin_circ_diff_mean =  9999.0
c        xmax_circ_diff_mean = -9999.0
        xmin_circul_disk =  9999.0
        xmax_circul_disk = -9999.0
        
        iskip = bskip2

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'get_wind_circ nhalf loop, k= ',k
          write (6,161) tlon,360.-tlon,tlat
          print *,'ilonfix= ',ilonfix,' jlatfix= ',jlatfix
     &         ,' npts= ',npts
          print *,'ibeg= ',ibeg,' jbeg= ',jbeg,' imax= ',imax
          print *,'iend= ',iend,' jend= ',jend,' jmax= ',jmax
          print *,'nhalf= ',nhalf,' iskip= ',iskip,' rads= ',rads
        endif

        if (verb .ge. 3) then
          print *,' '
          print *,'In get_wind_circulation, prior to loop k= ',k
          print *,'   npts= ',npts,' dell= ',dell,' rads= ',rads
          print *,' '
        endif

        jloop2: do j=-npts,npts,iskip

          rlatt = tlat + dell*float(j)

          iloop2: do i=-npts,npts,iskip

            rlont = tlon + dell*float(i)

            if (rlont >= (grid_maxlon + dx - grid_buffer)) then
              if (trkrinfo%gridtype == 'global') then
                rlont = rlont - 360.
              else
                cycle iloop2
              endif
            endif

            if (rlont < (grid_minlon + grid_buffer)) then
              if (trkrinfo%gridtype == 'global') then
                rlont = rlont + 360.
              else
                cycle iloop2
              endif
            endif

            if (rlatt > (grid_maxlat - grid_buffer) .or.
     &          rlatt < (grid_minlat + grid_buffer) .or.
     &          rlont >= (grid_maxlon + dx - grid_buffer) .or.
     &          rlont < (grid_minlon + grid_buffer)) then
              cycle iloop2
            endif

c           Again, check and make sure that the lat/lon point in
c           question here has valid data (see the explanation further
c           up in this subroutine inside iloop).

            call check_valid_point (imax,jmax,dx,dy,u(1,1,nlev),maxmin
     &          ,valid_pt,rlont,rlatt,grid_maxlat,grid_minlat
     &          ,grid_maxlon,grid_minlon,trkrinfo,icvpret)

            if (icvpret /= 0) then
              cycle iloop2
            endif

            call calcdist(rlont,rlatt,temp_guesslon,uvgeslat,dist
     &                   ,degrees)
            if (dist .gt. rads) cycle iloop2

c           Now go through each radius, starting from inner and working
c           to outer, and at each one, go around through all of the 24
c           discrete azimuths, starting at 7.5 and adding 15 degrees
c           clockwise each time, all the way up through 352.5.

            vt_mean = 0.0
            vt = 0.0
            vr = 0.0

            circul_band = 0.0
            circul_disk = 0.0

            radiusloop2: do idist = 1,numdist

              azimuth_ct = 0
              vt_azim_sum = 0.0

              ! Compute the length of a 1/numazim arc at this radius, and
              ! be sure to multiply by 1000 to convert from km to m for
              ! use in computing the circulation....

              circumference = 2 * pi * rdist(idist) * 1000.0
              arclength = circumference / float(numazim)

              azimloop2: do iazim = 1,numazim

                bear = ((iazim-1) * 15.) + 7.5

                call distbear (rlatt,rlont,rdist(idist)
     &                        ,bear,targlat,targlon)

ctmwc                if ( verb .ge. 3 ) then
ctmwc                  print *,' '
ctmwc                  print '(5(a11,f7.2))','  ctr lat= ',rlatt
ctmwc     &                 ,'  ctr lon= ',rlont
ctmwc     &                 ,'   rdist=  ',rdist(idist),'  targlat= ',targlat
ctmwc     &                 ,'  targlon= ',targlon
ctmwc                  print '(19x,a10,f7.2,35x,a9,f7.2)',' ctr lon= '
ctmwc     &                 ,360.-rlont
ctmwc     &                 ,'targlon= ',360.-targlon
ctmwc                endif

                call bilin_int_uneven (targlat,targlon
     &            ,dx,dy,imax,jmax,trkrinfo,level,'u',xintrp_u,ibiret1)
  
                call bilin_int_uneven (targlat,targlon
     &            ,dx,dy,imax,jmax,trkrinfo,level,'v',xintrp_v,ibiret2)

                if (ibiret1 == 0 .and. ibiret2 == 0) then
                  call getvrvt (rlont,rlatt,targlon,targlat
     &                         ,xintrp_u,xintrp_v,vr(iazim,idist)
     &                         ,vt(iazim,idist),igvtret)
                  azimuth_ct = azimuth_ct + 1
                  circul_band(idist) = circul_band(idist)
     &                               + (vt(iazim,idist) * arclength)
c                  vt_azim_sum = vt_azim_sum + vt(iazim,idist)
                else if (ibiret1 == 85 .or. ibiret2 == 85) then
                  vr(iazim,idist) = -999.0
                  vt(iazim,idist) = -999.0
                else
                  igwcret = 95
                  return
                endif
 
              enddo azimloop2

              if (azimuth_ct > 0) then
                ! Add the value for the circulation in this radial
                ! band (circul_band(idist)) to the "solid disk"
                ! circulation total.  Also,
                ! Compute azimuthally-averaged Vt at this distance
                circul_disk = circul_disk + circul_band(idist)
                vt_mean(idist) = vt_azim_sum / float(azimuth_ct)
              else
c                vt_mean(idist) = -999.0
                print *,' '
              endif

            enddo radiusloop2

            if (uvgeslat > 0.0) then
              if (circul_disk > xmax_circul_disk) then
                xmax_circul_disk = circul_disk
                ctlon = rlont
                ctlat = rlatt
              endif
            else
              if (circul_disk < xmin_circul_disk) then
                xmin_circul_disk = circul_disk
                ctlon = rlont
                ctlat = rlatt
              endif
            endif

CC-->      This section was commented out in Feb 2018 due to finding a
cc         bug/flaw in the whole "circulation difference" concept, and
cc         it has now been replaced throughout this subroutine with 
cc         more robust circulation computation logic.
cc
cc           Now get the wind magnitude at the candidate center of
cc           circulation (i.e., the one that we just used for
cc           computing all of the Vr and Vt in the previous azimloop2
cc           and radiusloop2).
c
c            call bilin_int_uneven (rlatt,rlont
c     &          ,dx,dy,imax,jmax,trkrinfo,level,'u',xintrp_u,ibiret1)
c            call bilin_int_uneven (rlatt,rlont
c     &          ,dx,dy,imax,jmax,trkrinfo,level,'v',xintrp_v,ibiret2)
c            if (ibiret1 == 0 .and. ibiret2 == 0) then
c              wind_mag_ctr = sqrt (xintrp_u**2 + xintrp_v**2)
c            else
c              if ( verb .ge. 3 ) then
c                print *,' '
c                print *,'!!! NOTE: bilint_uneven failed for center'
c                print *,'!!! wind mag in get_wind_circulation.'
c                print *,'!!! rlont= ',rlont,' rlatt= ',rlatt
c                print *,'!!! '
c              endif
c            endif
c
cc            print *,'kloop k= ',k,'  wind_mag_ctr= ',wind_mag_ctr
c
c            circ_diff_ct  = 0
c            circ_diff_sum = 0.0
c            do ir = 1,numdist
cc              print *,'kloop k= ',k,'  vtmean(ir)= ',vt_mean(ir)
c              if (vt_mean(ir) > -998.0) then
c                circ_diff = vt_mean(ir) - (hemisphere * wind_mag_ctr)
c                circ_diff_ct  = circ_diff_ct + 1
c                circ_diff_sum = circ_diff_sum + circ_diff
c              endif
c            enddo
c
cc            print *,'kloop k= ',k,'  circ_diff_ct= ',circ_diff_ct
c
c            if (circ_diff_ct > 0) then
c
c              circ_diff_mean = circ_diff_sum / float(circ_diff_ct)
c
cc              print *,'kloop k=',k,'  circ_diff_sum= ',circ_diff_sum
cc     &               ,'  circ_diff_mean= ',circ_diff_mean
c
c              if (uvgeslat > 0.0) then
c                if (circ_diff_mean > xmax_circ_diff_mean) then
c                  xmax_circ_diff_mean = circ_diff_mean
c                  ctlon = rlont
c                  ctlat = rlatt
c                endif
c              else
c                if (circ_diff_mean < xmin_circ_diff_mean) then
c                  xmin_circ_diff_mean = circ_diff_mean
c                  ctlon = rlont
c                  ctlat = rlatt
c                endif
c              endif
c            endif
c
cc            print *,'kloop k= ',k,'  xmax_circ_diff_mean= '
cc     &             ,xmax_circ_diff_mean

          enddo iloop2

        enddo jloop2

        if ( verb .ge. 3 ) then
          if (uvgeslat >= 0.0) then
            print *,'---> xmax_circul_disk= ',xmax_circul_disk
            write (6,71) k,360.-ctlon,ctlat,xmax_circul_disk
          else
            print *,'---> xmin_circul_disk= ',xmin_circul_disk
            write (6,73) k,360.-ctlon,ctlat,xmin_circul_disk
          endif
        endif

      enddo kloop

  71  format (' nhalf get_wind_circ, k= ',i2,' ctlon= ',f8.3,'W '
     &       ,'  ctlat= ',f8.3,' Wind Circulation (NHEM: Max) = '
     &       ,f15.1)
  73  format (' nhalf get_wind_circ, k= ',i2,' ctlon= ',f8.3,'W '
     &       ,'  ctlat= ',f8.3,' Wind Circulation (SHEM: Min) = '
     &       ,f15.1)
 161  format (' guesslon= ',f8.3,'E  (',f8.3,'W)   guesslat= ',f8.3)

      if (uvgeslat > 0.0) then
        fxval = xmax_circul_disk
      else
        fxval = xmin_circul_disk
      endif
c
      return
      end

c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_uv_center (uvgeslon,uvgeslat,imax,jmax,dx,dy
     &                     ,ist,level,valid_pt,cflag
     &                     ,ctlon,ctlat,xval,trkrinfo,igucret)
c
c     ABSTRACT: This subroutine calculates the center fix position for
c     the minimum in the wind speed near the storm center.  This center
c     fix is done differently than for the other parms.  With this fix,
c     we severely limit the area that is searched, because we do not 
c     want to confuse a wind minimum out on the periphery of a storm 
c     with the center wind minimum.  Therefore, this subroutine is not
c     called until center fixes have been made for the 5 other parms
c     (z850, z700, zeta850, zeta700, mslp).  Once those  fixes have been
c     made, a modified first guess is made of the average of the guess
c     position for this time and the 5 other parm fixes.  That modified
c     guess position is passed into this subroutine as uvgeslon and 
c     uvgeslat, and that's where the searching for the wind minimum 
c     is done.  To get the wind minimum, the u and v data are first 
c     interpolated down to a fine grid (see details below for exact
c     figures), and then a single-pass barnes analysis is done on that
c     fine grid.  The reason that we first interpolate the data (which
c     is different from how we do the other parms) is that if we just 
c     use the original grid resolution, we may not be able to 
c     accurately pick out a minimum in the wind field at the center.
c
      USE radii; USE grid_bounds; USE tracked_parms; USE trig_vals
      USE level_parms; USE trkrparms
      USE verbose_output

      type (trackstuff) trkrinfo

      real, allocatable ::  uold(:,:),vold(:,:),unew(:,:),vnew(:,:)
      real, allocatable ::  rlonold(:),rlatold(:),rlonnew(:),rlatnew(:)
      real, allocatable ::  vmag(:,:)
      real :: dx,dy
      real  :: grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
      character*1 ::   gotlat
      logical(1)        cflag, valid_pt(imax,jmax)
      logical(1), allocatable :: lbi(:,:)
c
      gotlat = 'n'
c
c     -----------------------------------------------------------------
c     INTERPOLATE INPUT GRID TO SMALLER GRID
c     -----------------------------------------------------------------
c
c     Get beginning and ending j points (on the input grid) for a 
c     smaller array that surrounds the storm.  It is this smaller array
c     that we will interpolate to a finer grid.
c
c     Calculate number of pts to either side of this j to search
c
      npts = ceiling(rads_vmag/(dtk*((dx+dy)/2.)))
c
      call get_ij_bounds (npts,0,ritrk_vmag,imax,jmax,dx,dy
     &             ,glatmax,glatmin,glonmax,glonmin,uvgeslon,uvgeslat
     &             ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if ( verb .ge. 3 ) then  
        print *,' '
        print *,' After get_ij D, ibeg jbeg = ',ibeg,jbeg
        print *,' After get_ij D, iend jend = ',iend,jend
      endif

      if (igiret /= 0) then

        if ( verb .ge. 1 ) then  
          print *,' '
          print *,'!!! ERROR in get_uv_center from call to '
          print *,'!!! get_ij_bounds, stopping processing for '
          print *,'!!! storm number ',ist
        endif

        igucret = 92
        return
      endif

      if (ibeg < 1) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 3 ) then  
            print *,' '
            print *,'!!! NOTE: In get_uv_center, the ibeg returned from'
            print *,'!!! get_ij_bounds is < 1, but our gridtype is '
            print *,'!!! global, so we are going to leave it as is and '
            print *,'!!! account for the grid wrapping.'
            print *,' '
          endif

        else

          if ( verb .ge. 3 ) then  
            print *,' '
            print *,'!!! NOTE: In get_uv_center, the ibeg returned from'
            print *,'!!! get_ij_bounds is < 1, and our gridtype is NOT'
            print *,'!!! global, so we are going to redefine ibeg to 1.'
            print *,' '
          endif

          ibeg = 1
        endif
      endif

      if (jbeg < 1) jbeg = 1

      if (ibeg > imax .or. jbeg > jmax .or. jbeg < 1 .or.
     &    iend < 1 .or. jend < 1) then

        if ( verb .ge. 1 ) then  
          print *,' '
          print *,'ERROR in get_uv_center calculating ibeg, iend, jbeg'
          print *,'or jend.  ibeg= ',ibeg,' iend= ',iend,' jbeg= ',jbeg
          print *,'jend= ',jend
          print *,'uv center will not be calculated for this time.'
        endif

        igrret = 99
        return
      endif

      if (iend > imax) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 3 ) then  
            print *,' '
            print *,'!!! NOTE: In get_uv_center, the iend returned from'
            print *,'!!! get_ij_bounds is > imax, but our gridtype is '
            print *,'!!! global, so we are going to leave it as is and'
            print *,'!!! account for the grid wrapping.'
            print *,' '
          endif

        else

          if ( verb .ge. 3 ) then  
            print *,' '
            print *,'!!! NOTE: In get_uv_center, the iend returned from'
            print *,'!!! get_ij_bounds is > imax, and our gridtype is'
            print *,'!!! NOT global, so we will redefine iend to imax.'
            print *,' '
          endif

          iend = imax
        endif
      endif

      if (jend > jmax) jend = jmax

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'In get_uv_center, ibeg= ',ibeg,' iend= ',iend
        print *,'                  jbeg= ',jbeg,' jend= ',jend
        print *,'  ilonfix= ',ilonfix,' jlatfix= ',jlatfix
      endif
c
      select case (level)
        case (850);  nlev = nlev850  ! check module level_parms for
        case (700);  nlev = nlev700  ! the values of these....
        case (500);  nlev = nlev500
        case (1020); nlev = levsfc
      end select

c     This next if statement determines how many times to interpolate
c     the input grid to a smaller grid.  Here are the grid sizes for 
c     some of the typical grids that will be used:
c
c      Original grid size     # of interps        Final grid size
c     --------------------    ------------     ---------------------
c     1.00 deg (111.19 km)        3             0.125 deg (13.9 km)
c     1.25 deg (138.99 km)        3             0.156 deg (17.4 km)
c     2.50 deg (277.99 km)        4             0.156 deg (17.4 km)

      if ((dx+dy)/2. > 1.2) then
        numinterp = 4
      else if ((dx+dy)/2. > 0.50 .and. (dx+dy)/2. <= 1.2) then
        numinterp = 3
      else if ((dx+dy)/2. > 0.25 .and. (dx+dy)/2. <= 0.50) then
        numinterp = 2
      else if ((dx+dy)/2. > 0.10 .and. (dx+dy)/2. <= 0.25) then
        numinterp = 1
      else if ((dx+dy)/2. <= 0.10) then
        numinterp = 0
      endif
  
      dell = (dx+dy)/2.
      imxold = iend - ibeg + 1
      jmxold = jend - jbeg + 1

c     --------------------------------------------------------------
c     Before interpolating, make sure that all the original
c     points have valid data.  If they don't then exit the
c     subroutine.  NOTE: This is NOT checking to see if ALL the pts
c     on the complete & full input grid have valid data; it only
c     checks those points that are within the box returned from
c     get_ij_bounds.

      do i=ibeg,iend

        if (i > imax) then
          if (trkrinfo%gridtype == 'global') then
            ip = i - imax   ! If wrapping past GM
          else

            if ( verb .ge. 1 ) then  
              print *,' '
              print *,'!!! ERROR: In get_uv_center, the '
              print *,'!!!    user-requested eastern search boundary'
              print *,'!!!    is beyond the eastern bounds of '
              print *,'!!!    this regional grid.  '
              print *,'!!!    PROCESSING WILL STOP.  '
              print *,'!!!    Subroutine location A....'
              print *,'!!!         '
              print *,'!!!   imax of regional grid    = ',imax
              print *,'!!!   User-requested eastern i = ',i
              print *,' '
            endif

            stop 94
          endif
        else
          ip = i
        endif

        if (i < 1) then
          if (trkrinfo%gridtype == 'global') then
            ip = i + imax   ! If wrapping past GM
          else

            if ( verb .ge. 1 ) then  
              print *,' '
              print *,'!!! ERROR: i < 1 in subroutine  get_uv_center'
              print *,'!!! for a non-global grid.  STOPPING....'
              print *,'!!! i= ',i
              print *,' '
            endif

            stop 97
          endif
        endif

        do j=jbeg,jend
          if (.not. valid_pt(ip,j)) goto 975
        enddo

      enddo

c     ------------------------------------
c     Now begin the interpolation process

      allocate (uold(imxold,jmxold),stat=iuo)
      allocate (vold(imxold,jmxold),stat=ivo)
      allocate (rlonold(imxold),stat=iloo)
      allocate (rlatold(jmxold),stat=ilao)
      if (iuo /= 0 .or. ivo /= 0 .or. iloo /= 0 .or. ilao /= 0) goto 970
 
      do intnum = 1,numinterp

        if (intnum == 1) then

          do i=ibeg,iend

            ik = i

            if (i < 1) then
              if (trkrinfo%gridtype == 'global') then
                ik = i + imax  !GM wrapping
              else

                if ( verb .ge. 1 ) then  
                  print *,'!!! ERROR in get_uv_center, i < 1'
                  print *,'!!! for a non-global grid at AA.'
                  print *,'!!! i = ',i
                endif

                igucret = 92
                return
              endif
            endif

            if (i > imax) then 
              if (trkrinfo%gridtype == 'global') then
                ik = i - imax  !GM wrapping
              else

                if ( verb .ge. 1 ) then  
                  print *,'!!! ERROR in get_uv_center, i > imax'
                  print *,'!!! for a non-global grid at AA.'
                  print *,'!!! i = ',i,' imax= ',imax
                endif

                igucret = 92
                return
              endif
            endif

            rlonold(i-ibeg+1) = glon(ik)
            do j=jbeg,jend
              uold(i-ibeg+1,j-jbeg+1) = u(ik,j,nlev)
              vold(i-ibeg+1,j-jbeg+1) = v(ik,j,nlev)
              if (gotlat == 'n') then
                rlatold(j-jbeg+1) = glat(j)
              endif
            enddo
            gotlat = 'y'    ! Only need to fill rlatold once
          enddo

        else

          deallocate (uold); deallocate (vold)
          deallocate (rlonold); deallocate (rlatold)
          allocate (uold(imxnew,jmxnew),stat=iuo)
          allocate (vold(imxnew,jmxnew),stat=ivo)
          allocate (rlonold(imxnew),stat=iloo)
          allocate (rlatold(jmxnew),stat=ilao)
          if (iuo /= 0 .or. ivo /= 0 .or.
     &        iloo /= 0 .or. ilao /= 0) goto 970

          gotlat = 'n'
          do i=1,imxnew
            rlonold(i) = rlonnew(i)
            do j=1,jmxnew
              uold(i,j) = unew(i,j)
              vold(i,j) = vnew(i,j)
              if (gotlat == 'n') then
                rlatold(j) = rlatnew(j)
              endif
            enddo
            gotlat = 'y'
          enddo

          imxold = imxnew
          jmxold = jmxnew
          deallocate (unew); deallocate (vnew)
          deallocate (rlonnew); deallocate (rlatnew)

        endif
 
        dell = 0.5 * dell
        imxnew = 2 * imxold - 1
        jmxnew = 2 * jmxold - 1

        allocate (unew(imxnew,jmxnew),stat=iuo)
        allocate (vnew(imxnew,jmxnew),stat=ivo)
        allocate (rlonnew(imxnew),stat=iloo)
        allocate (rlatnew(jmxnew),stat=ilao)
        if (iuo /= 0 .or. ivo /= 0 .or. 
     &      iloo /= 0 .or. ilao /= 0) goto 971

        call bilin_int_even (imxold,jmxold,uold
     &                      ,imxnew,jmxnew,unew,ibiret)
        call bilin_int_even (imxold,jmxold,vold
     &                      ,imxnew,jmxnew,vnew,ibiret)
c        call lin_int (imxold,imxnew,rlonold,rlonnew,iliret)
        call lin_int_lon (imxold,imxnew,rlonold,rlonnew,iliret)
        call lin_int     (jmxold,jmxnew,rlatold,rlatnew,iliret)
 
        chk_lonspc_old = rlonold(imxold) - rlonold(imxold - 1)
        chk_latspc_old = rlatold(jmxold) - rlatold(jmxold - 1)
        chk_lonspc_new = rlonnew(imxnew) - rlonnew(imxnew - 1)
        chk_latspc_new = rlatnew(jmxnew) - rlatnew(jmxnew - 1)

        grid_maxlat = rlatnew(1)
        grid_minlat = rlatnew(jmxnew)
        grid_minlon = rlonnew(1)
        grid_maxlon = rlonnew(imxnew)
        
        if ( verb .ge. 3 ) then  
          print *,' '
          print *,'In get_uv_center, intnum= ',intnum
          print *,'imxold= ',imxold,' imxnew= ',imxnew
          print *,'jmxold= ',jmxold,' jmxnew= ',jmxnew
          print *,'Grid boundaries of modified uv grid: '
          print *,'grid_maxlat= ',grid_maxlat,' grid_minlat= '
     &           ,grid_minlat
          print *,'grid_maxlon= ',grid_maxlon,' grid_minlon= '
     &           ,grid_minlon
        endif
 
      enddo
 
c     ------------------

      deallocate (uold); deallocate (vold)
      deallocate (rlonold); deallocate(rlatold)

      if (numinterp == 0) then

        ! No interpolations were done for this fine mesh grid, but we
        ! need to fill some of these arrays and define variables for
        ! subsequent subroutine calls just below here that require
        ! the variables imxnew, jmxnew, and the arrays unew and vnew.

        if (iend > imax) then
          if (trkrinfo%gridtype == 'global') then
            continue
          else

            if ( verb .ge. 1 ) then  
              print *,' '
              print *,'ERROR in get_uv_center:  Should not have gotten'
              print *,'to this point in get_uv_center for a regional '
              print *,'grid; iend should not > imax here !!!'
            endif

            igucret = 99
            return
          endif
        endif

        if (ibeg < 1) then
          if (trkrinfo%gridtype == 'global') then
            continue
          else

            if ( verb .ge. 1 ) then  
              print *,' '
              print *,'ERROR in get_uv_center:  Should not have gotten'
              print *,'to this point in get_uv_center for a regional'
              print *,'grid; ibeg should not < 1 here !!!'
            endif

            igucret = 99
            return
          endif
        endif

        imxnew = iend - ibeg + 1
        jmxnew = jend - jbeg + 1
        allocate (unew(imxnew,jmxnew),stat=iuo)
        allocate (vnew(imxnew,jmxnew),stat=ivo)
        allocate (rlonnew(imxnew),stat=iloo)
        allocate (rlatnew(jmxnew),stat=ilao)
        if (iuo /= 0 .or. ivo /= 0 .or.
     &      iloo /= 0 .or. ilao /= 0) goto 971
        gotlat = 'n'

        do i=ibeg,iend

          ip = i

          if (i > imax) then
            ! This HAS to be a global, wrapping grid, or else the if
            ! statement a few lines up would have caught this already.
            ip = i - imax   ! Wrapping past GM
          endif

          if (i < 1) then
            ! This HAS to be a global, wrapping grid, or else the if
            ! statement a few lines up would have caught this already.
            ip = i + imax   ! Wrapping past GM
          endif

          rlonnew(i-ibeg+1) = glon(ip)
          do j=jbeg,jend
            unew(i-ibeg+1,j-jbeg+1) = u(i,j,nlev)
            vnew(i-ibeg+1,j-jbeg+1) = v(i,j,nlev)
            if (gotlat == 'n') then
              rlatnew(j-jbeg+1) = glat(j)
            endif
          enddo
          gotlat = 'y'    ! Only need to fill rlatnew once
        enddo

      endif

      grid_maxlat = rlatnew(1)
      grid_minlat = rlatnew(jmxnew)
      grid_minlon = rlonnew(1)
      grid_maxlon = rlonnew(imxnew)

      if ( verb .ge. 3 ) then  
        print *,'Grid boundaries of modified uv grid in get_uv_center:'
        print *,'grid_maxlat= ',grid_maxlat,' grid_minlat= ',grid_minlat
        print *,'grid_maxlon= ',grid_maxlon,' grid_minlon= ',grid_minlon
      endif

      allocate (vmag(imxnew,jmxnew),stat=ivm)
      allocate (lbi(imxnew,jmxnew),stat=ilb)
      if (ivm /= 0 .or. ilb /= 0) goto 972
      call calc_vmag (unew,vnew,imxnew,jmxnew,vmag,icvret)
      deallocate (unew); deallocate (vnew)
 
      lbi = .TRUE.

      if ( verb .ge. 3 ) then  
        print *,' '
        print *,'Before call to find_maxmin, imxnew= ',imxnew
     &       ,'jmxnew= ',jmxnew,' ist= ',ist
        write (6,171) dell,uvgeslon,360.-uvgeslon,uvgeslat
 171    format (' dell= ',f7.3,' uvgeslon= ',f8.3,'E  (',f8.3,'W)'
     &       ,'  uvgeslat= ',f8.3)
      endif

c     Note that in the next call, I pass the 'global' argument to 
c     find_maxmin.  This defines what type of grid it is, so that the
c     proper grid_buffer can be chosen.  This grid_buffer is designed
c     to avoid having a center be chosen too close to the grid 
c     boundary.  However, in the case of vmag here, we are only using
c     a small subgrid, and we want to make sure we use *all* points
c     in that subgrid for searching, and that will occur if we set that
c     calling argument to 'global' as opposed to 'regional'.

      call find_maxmin (imxnew,jmxnew,dell,dell,'vmag'
     &   ,vmag,'min',ist,uvgeslon,uvgeslat,rlonnew,rlatnew,lbi
     &   ,trkrinfo,cflag,ctlon,ctlat,xval,grid_maxlat,grid_minlat
     &   ,grid_maxlon,grid_minlon,'global',ifmret)
      deallocate (vmag); deallocate (lbi)
      deallocate (rlonnew); deallocate (rlatnew)
c
      if (ifmret == 0) then
        goto 995
      else
        igucret = ifmret

        if ( verb .ge. 1 ) then  
          print *,' '
          print *,'!!! ERROR in get_uv_center in call to find_maxmin'
          print *,'!!! storm num = ',ist,' igucret = ',igucret
        endif

        goto 998
      endif
c
 970  continue
        
      if ( verb .ge. 1 ) then  
        print *,' '
        print *,'!!! ERROR ALLOCATING either uold, vold,'
        print *,'!!! rlonold or rlatold in get_uv_center'
        print *,'!!! Storm number = ',ist
        print *,'!!! intnum= ',intnum
        print *,'!!! imxnew= ',imxnew,' jmxnew= ',jmxnew
        print *,'!!! imxold= ',imxold,' jmxold= ',jmxold
        print *,'!!! iuo= ',iuo,' ivo= ',ivo
        print *,'!!! iloo= ',iloo,' ilao= ',ilao
      endif

      igucret = 97
      goto 998

 971  continue

      if ( verb .ge. 1 ) then  
        print *,' '
        print *,'!!! ERROR ALLOCATING either unew, vnew,'
        print *,'!!! rlonnew or rlatnew in get_uv_center'
        print *,'!!! Storm number = ',ist
        print *,'!!! intnum= ',intnum
        print *,'!!! imxnew= ',imxnew,' jmxnew= ',jmxnew
        print *,'!!! imxold= ',imxold,' jmxold= ',jmxold
        print *,'!!! iuo= ',iuo,' ivo= ',ivo
        print *,'!!! iloo= ',iloo,' ilao= ',ilao
      endif

      igucret = 97
      goto 998

 972  continue
      
      if ( verb .ge. 1 ) then  
        print *,' '
        print *,'!!! ERROR ALLOCATING either vmag or lbi in '
        print *,'!!! subroutine  get_uv_center'
        print *,'!!! Storm number = ',ist
        print *,'!!! imxnew= ',imxnew,' jmxnew= ',jmxnew
        print *,'!!! ivm= ',ivm,' ilb= ',ilb
      endif

      igucret = 97
      goto 998

 975  continue
      
      if ( verb .ge. 1 ) then  
        print *,' '
        print *,'!!! Inside  get_uv_center, at least one of the points'
        print *,'!!! is not a valid data point.  This point may be '
        print *,'!!! outside the valid data bounds of a regional grid'
        print *,'!!! i= ',i,' j= ',j
        print *,'!!! Storm number = ',ist
      endif

      igucret = 98
      goto 998
c
  995 continue
      igucret = 0 
c
  998 continue
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_uv_guess (guesslon,guesslat,clon,clat
     &                       ,calcparm,ist,ifh,maxstorm
     &                       ,uvgeslon,uvgeslat,igugret)
c
c     ABSTRACT: The purpose of this subroutine is to get a modified 
c               first guess lat/lon position before searching for the 
c               minimum in the wind field.  The reason for doing this is
c               to better refine the guess and avoid picking up a wind
c               wind minimum far away from the center.  So, use the 
c               first guess position (and give it strong weighting), and
c               then also use the  fix positions for the current time
c               (give the vorticity centers stronger weighting as well),
c               and then take the average of these positions.
c
c     INPUT:
c     guesslon  guess longitude for this forecast time 
c     guesslat  guess latitude for this forecast time 
c     clon      array with center longitude  fixes for the various parms
c     clat      array with center latitude  fixes for the various parms
c     calcparm  logical; tells whether or not a parm has a valid fix
c                   at this forecast hour
c     ist       index for current storm
c     ifh       index for current forecast hour
c     maxstorm  max # of storms that can be handled
c
c     OUTPUT:
c     uvgeslon  contains modified guess longitude position at which to
c                   look for the wind minimum
c     uvgeslat  contains modified guess latitude position at which to
c                   look for the wind minimum
c     igugret   return code for this subroutine (0=normal)
c----
c
      USE set_max_parms; USE level_parms; USE error_parms
      USE verbose_output

      logical(1) calcparm(maxtp,maxstorm)
      real      clon(maxstorm,maxtime,maxtp)
      real      clat(maxstorm,maxtime,maxtp)
      real      uvgeslon, uvgeslat
      real      guesslon,guesslat,degrees
      integer   gt345_ct,lt15_ct

      sumlon = 0.0
      sumlat = 0.0
      ict = 0
      gt345_ct = 0
      lt15_ct  = 0

c     NOTE: We need to be careful in this routine when averaging
c     the longitudes together, in case we cross the greenwich 
c     meridian, because then we may be averaging 345+ lons with 
c     lons that are less than 15, giving incorrect results.
c     Therefore, check for this, and if it occurs, add 360 onto
c     any of the <15 lons (add it twice for those lons being 
c     counted twice (guesslon and the vorticity centers)).

c     Weight the uv guess position by counting the storm's guess 
c     position twice.  

      sumlon = sumlon + 2.*guesslon
      sumlat = sumlat + 2.*guesslat
      ict = ict + 2

      if (guesslon > 345.) then
        gt345_ct = gt345_ct + 1 
      endif
      if (guesslon < 15.) then
        lt15_ct  = lt15_ct + 2   ! Yes, 2 is correct....
      endif

      do ip = 1,maxtp
        if ((ip > 2 .and. ip < 7) .or. ip == 10) then
          cycle   ! because 3-6 are for 850 & 700 u & v and 10 is 
                  ! for surface wind magnitude.
        else
          if (calcparm(ip,ist)) then
            call calcdist (guesslon,guesslat,clon(ist,ifh,ip)
     &                    ,clat(ist,ifh,ip),dist,degrees)
 
            if (dist < uverrmax) then
c
c             Give the vorticity centers 2x weighting as well
c 
              if (ip == 1 .or. ip == 2 .or. ip == 11) then
                sumlon = sumlon + 2.*clon(ist,ifh,ip)
                sumlat = sumlat + 2.*clat(ist,ifh,ip)
                ict = ict + 2
                if (clon(ist,ifh,ip) > 345.) then
                  gt345_ct = gt345_ct + 1       
                endif                           
                if (clon(ist,ifh,ip) < 15.) then
                  lt15_ct  = lt15_ct + 2  ! Yes, 2 is correct...
                endif
              else
                sumlon = sumlon + clon(ist,ifh,ip)
                sumlat = sumlat + clat(ist,ifh,ip)
                ict = ict + 1
                if (clon(ist,ifh,ip) > 345.) then
                  gt345_ct = gt345_ct + 1       
                endif                           
                if (clon(ist,ifh,ip) < 15.) then
                  lt15_ct  = lt15_ct + 1  ! Only 1 for non-zeta parms
                endif
              endif

            endif

          endif
        endif
      enddo
c 
      if (ict > 0) then
        if (gt345_ct > 0 .and. lt15_ct > 0) then
          ! We have some parms left of the GM and some to the right,
          ! so we will add (360*lt15_ct) to the sum of the lons (sumlon)
          uvgeslon = (sumlon + (360.*float(lt15_ct)))/ ict
        else
          uvgeslon = sumlon / ict
        endif
        if (uvgeslon >= 360.0) then
          uvgeslon = uvgeslon - 360.
        endif
        uvgeslat = sumlat / ict
        igugret = 0
      else

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in get_uv_guess, ict not > 0, ict= ',ict
          print *,'!!! vmag center will not be calculated for this'
          print *,'!!! storm -- at least not at this level'
          print *,'!!! Storm number = ',ist
        endif

        igugret = 91
      endif
c
      return
      end      
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine calc_vmag (xu,xv,imx,jmx,wspeed,icvret)
c
c     ABSTRACT: This subroutine calculates the magnitude of the wind
c     speed for an array of points, given real u and real v arrays.
c
      real    xu(imx,jmx),xv(imx,jmx),wspeed(imx,jmx)
c
      do i=1,imx
        do j=1,jmx
          wspeed(i,j) = sqrt( xu(i,j)*xu(i,j) + xv(i,j)*xv(i,j) )
        enddo
      enddo
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine bilin_int_even (imxold,jmxold,xold
     &                          ,imxnew,jmxnew,xnew,ibiret)
c
c     ABSTRACT: This subroutine does a bilinear interpolation on a 
c     grid of evenly spaced data.  Do NOT attempt to use this subroutine
c     with data that are not evenly spaced or you will get unpredictable
c     results.
c
      real      xold(imxold,jmxold), xnew(imxnew,jmxnew)
c
c
c  ---------------------------------------------------------------------
c         Latitude ---->          |
c                                 |
c  L   O  e  O  e  O  e  O  e  O  | O: original point from input array
c  o                              | 
c  n   e  1  2  1  2  1  2  1  e  | 1: interpolated, primary inter. pt
c  g                              |
c  i   O  2  O  2  O  2  O  2  O  | e: interpolated edge point
c  t                              |
c  u   e  1  2  1  2  1  2  1  e  | 2: interpolated, secondary inter. pt
c  d                              |
c  e   O  2  O  2  O  2  O  2  O  | Interpolations are done in the order
c                                 | as indicated above; First, the input
c  |   e  1  2  1  2  1  2  1  e  | 'O' pts are placed onto the new, 
c  |                              | larger grid. From that, the '1' pts
c  |   O  2  O  2  O  2  O  2  O  | can be interpolated.  Next, the edge
c  |                              | (e) pts are interpolated using an
c  v   e  1  2  1  2  1  2  1  e  | interpolation of two 'O' pts and one
c                                 | '1' pt.  Finally, the '2' pts are
c      O  e  O  e  O  e  O  e  O  | done using the 2 surrounding '0' and
c                                 | '1' pts.  Bilinear interpolation is
c                                 | made incredibly easier by the fact
c                                 | that the grid is evenly spaced.
c  ---------------------------------------------------------------------
c     NOTE: Remember that the arrays that are read in are indexed as
c     (lon,lat), so that in the diagram above, pt (1,1) is at the upper
c     left and pt (imax,jmax) is at the lower right, and each column is
c     a new latitude and each row is a new longitude.
c
c     -----------------------------------------------------------------
c     Put original (O) values from input array into new, expanded array
c     -----------------------------------------------------------------
c
      do i=1,imxold
        do j=1,jmxold
          xnew(2*i-1,2*j-1) = xold(i,j) 
        enddo
      enddo
c
c     ----------------------------------------------
c     Interpolate to get primary interior (1) points
c     ----------------------------------------------
c
      do i=1,imxold-1
        do j=1,jmxold-1
          xnew(2*i,2*j) = 0.25 * (xnew(2*i-1,2*j-1) + xnew(2*i+1,2*j-1)
     &                        +  xnew(2*i+1,2*j+1) + xnew(2*i-1,2*j+1))
        enddo
      enddo
c
c     ---------------------------
c     Interpolate edge (e) points
c     ---------------------------
c
c     ... Northernmost 'e' points ...
c
      j=1
      do i=1,imxold-1
        xnew(2*i,j) = 0.3333 * (xnew(2*i-1,j) + xnew(2*i+1,j) 
     &                                        + xnew(2*i,2))
      enddo
c
c     ... Southernmost 'e' points ...
c
      j = 2*jmxold - 1
      do i=1,imxold-1
        xnew(2*i,j) = 0.3333 * (xnew(2*i-1,j) + xnew(2*i+1,j)
     &                                        + xnew(2*i,j-1))
      enddo
c
c     ... Westernmost 'e' points ...
c
      i=1
      do j=1,jmxold-1
        xnew(i,2*j) = 0.3333 * (xnew(i,2*j-1) + xnew(i,2*j+1)
     &                                        + xnew(2,2*j))
      enddo
c
c     ... Easternmost 'e' points ...
c
      i = 2*imxold - 1
      do j=1,jmxold-1
        xnew(i,2*j) = 0.3333 * (xnew(i,2*j-1) + xnew(i,2*j+1)
     &                                        + xnew(i-1,2*j))
      enddo
c
c     ------------------------------------------------
c     Interpolate to get secondary interior (2) points
c     ------------------------------------------------
c
      do j=2,2*jmxold-2
        istep = mod(j+1,2)
        do i=istep+2,2*imxold-2,2
          xnew(i,j) = 0.25 * (xnew(i-1,j) + xnew(i,j-1) + xnew(i+1,j)
     &                     +  xnew(i,j+1))
        enddo
      enddo
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine lin_int (ioldmax,inewmax,xold,xnew,iliret)
c
c     ABSTRACT: This subroutine linearly interpolates evenly spaced
c               data from one grid to another.
c 
      real      xold(ioldmax), xnew(inewmax)
c
c     First just copy points from old grid onto new, larger grid
c
      do i=1,ioldmax
        xnew(2*i-1) = xold(i)
      enddo
c
c     Now interpolate to get the in-between points
c
      do i=1,ioldmax-1
        xnew(2*i) = 0.5 * (xnew(2*i-1) + xnew(2*i+1))
      enddo
c
      return
      end

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine lin_int_lon (ioldmax,inewmax,xold,xnew,iliret)
c
c     ABSTRACT: This subroutine linearly interpolates evenly spaced
c               data from one grid to another.  This particular 
c               routine is specifically used for interpolating 
c               longitudes, and it factors in the possibility of 
c               interpolating across the greenwich meridian.
c
      real      xold(ioldmax), xnew(inewmax)
c
c     First just copy points from old grid onto new, larger grid
c
      do i=1,ioldmax
        xnew(2*i-1) = xold(i)
      enddo
c
c     Now interpolate to get the in-between points, and make the
c     necessary adjustment when interpolating a longitude between,
c     for example, 359.5 and 0.0.
c
      do i=1,ioldmax-1
        if (xnew(2*i-1) > 350. .and. xnew(2*i+1) < 10.) then
          xnew(2*i) = 0.5 * (xnew(2*i-1) + (360. + xnew(2*i+1)))
        else
          xnew(2*i) = 0.5 * (xnew(2*i-1) + xnew(2*i+1))
        endif
      enddo
c
      return
      end

c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_zeta_values (fixlon,fixlat,imax,jmax,dx,dy
     &                     ,trkrinfo,imeanzeta,igridzeta,readflag
     &                     ,valid_pt,ist,ifh,maxstorm,inp,igzvret)
c
c     ABSTRACT: This subroutine finds the maximum and mean zeta values
c     at 850 & 700 mb, near a storm center.  It is called from 
c     subroutine  tracker, and its purpose is to report these values 
c     that will then be written out to a special, modified version of 
c     the atcfunix file.

      USE tracked_parms; USE radii; USE trig_vals; USE set_max_parms
      USE trkrparms; USE level_parms; USE grid_bounds; USE inparms
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo
      type (datecard) inp

      logical(1) readflag(14),valid_pt(imax,jmax),compflag
      character  cmaxmin*3,cvort_maxmin*3
      real     fixlon(maxstorm,maxtime),fixlat(maxstorm,maxtime)
      real     gridpoint_maxmin,xmeanzeta,dx,dy,re,ri,parmlon,parmlat
      integer  igridzeta(nlevgrzeta),imeanzeta(nlevgrzeta)
      integer  n,ix1,ix2,ilev,npts,imax,jmax,igzvret,ilonfix,jlatfix
      integer  idum,jdum,ibeg,jbeg,iend,jend,igiret,icount,iuret
      integer  ifilret,ist,ifh,ifmret,maxstorm

c     First, call  get_ij_bounds in order to get the (i,j) coordinates
c     of the (fixlon,fixlat) position that we need to search around.
c     These (i,j) coordinates are returned as ilonfix and jlatfix.

      npts = imax * jmax

      call get_ij_bounds (npts,0,ridlm,imax,jmax
     &     ,dx,dy,glatmax,glatmin,glonmax,glonmin
     &     ,fixlon(ist,ifh),fixlat(ist,ifh),trkrinfo
     &     ,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if (ilonfix > imax) then
        if (trkrinfo%gridtype == 'global') then
          ilonfix = ilonfix - imax   ! If wrapping past GM
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: In get_zeta_values, the '
            print *,'!!!    user-requested eastern boundary'
            print *,'!!!    is beyond the eastern bounds of '
            print *,'!!!    this regional grid.  '
            print *,'!!!         '
            print *,'!!!   imax of regional grid    = ',imax
            print *,'!!!   eastern ilonfix = ',ilonfix
            print *,'!!!         '
            print *,' '
          endif
          
          igzvret = 99
          return
        endif   
      endif

      if (ilonfix < 1) then
        if (trkrinfo%gridtype == 'global') then
          ilonfix = ilonfix + imax
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: ilonfix < 1 in subroutine'
            print *,'!!! get_zeta_values for a non-global grid.'
            print *,'!!! ilonfix= ',ilonfix
            print *,'!!!         '
            print *,' '
          endif

          igzvret = 99
          return
        endif   
      endif

      if ( verb .ge. 3 ) then
        write (6,*) ' '
        write (6,601) 
        write (6,603) 
        write (6,605) 
        write (6,607) 
        write (6,609) 
        write (6,*) ' '
        write (6,613) ist,ifh
        write (6,615) fixlon(ist,ifh),360.-fixlon(ist,ifh)
     &               ,fixlat(ist,ifh)
        write (6,617) ilonfix,jlatfix
      endif

 601  format(1x,'#---------------------------------------------------#')
 603  format(1x,'# Entering loop to determine the mean and gridpoint #')
 605  format(1x,'# max zeta values at 850 and 700 mb for the purpose #')
 607  format(1x,'# of reporting them on the modified atcfunix file.  #')
 609  format(1x,'#---------------------------------------------------#')
 613  format(1x,'--- In get_zeta_values, ist= ',i3,'  ifh= ',i3)
 615  format(1x,'    Fix location for this time: ',f7.2,'E  (',f6.2,'W)'
     &     ,2x,f7.2)
 617  format(1x,'    ilonfix= ',i4,'  jlatfix= ',i4)
        
      report_zeta_loop: do n=1,2

        gridpoint_maxmin = -99.0
        xmeanzeta = -99.0
        compflag  = .true.

        select case (n)
          case (1); ilev=850  ! For 850 mb
          case (2); ilev=700  ! For 700 mb
        end select

        if (zeta(ilonfix,jlatfix,n) > -9990.0) then

          ! -------------------------------------------
          ! We have valid zeta data for this level, so
          ! we first call  barnes now to get the mean zeta
          ! surrounding our found center position.
          ! -------------------------------------------

          if (fixlat(ist,ifh) > 0.0) then
            cvort_maxmin = 'max'
          else
            cvort_maxmin = 'min'
          endif

          call find_maxmin (imax,jmax,dx,dy,'zeta'
     &       ,zeta(1,1,n),cvort_maxmin,ist,fixlon(ist,ifh)
     &       ,fixlat(ist,ifh),glon,glat,valid_pt,trkrinfo
     &       ,compflag,parmlon,parmlat,xmeanzeta
     &       ,glatmax,glatmin,glonmax,glonmin,inp%modtyp,ifmret)
          if (ifmret == 0) then   ! Out of regional grid bounds
            imeanzeta(n) = int ((xmeanzeta * 1e6) + 0.5)
          else
            imeanzeta(n) = -99
            igridzeta(n) = -99

            if ( verb .ge. 3 ) then
              write (6,*) ' '
              write (6,519) 
              write (6,520) 
              write (6,521) 
            endif

 519        format (1x,' The call to find_maxmin in get_zeta_values')
 520        format (1x,' returned a nonzero return code.  The search')
 521        format (1x,' for zeta values will not be done.')
            exit report_zeta_loop  ! If out of grid bounds at 850, 
                                   ! then will also be out at 700...
          endif 
        else
            imeanzeta(n) = -99
            igridzeta(n) = -99
            exit report_zeta_loop
        endif

        if ( verb .ge. 3 ) then
          write (6,621) n,ilev,xmeanzeta,imeanzeta(n)
 621      format (1x,'+++ RPT_MEAN_ZETA: n= ',i2,' lev= ',i4
     &         ,' xmeanzeta= ',f9.6,'  imeanzeta (*1e6)= ',i8)
          write (6,*) '  --- mean zeta raw = ',xmeanzeta
        endif
     
        ! -----------------------------------------------
        ! Call fix_latlon_to_ij to get the nearest actual
        ! raw (grid) zeta data value, not the mean value.
        ! -----------------------------------------------
     
        call fix_latlon_to_ij (imax,jmax,dx,dy
     &     ,zeta(1,1,n),cvort_maxmin,valid_pt,fixlon(ist,ifh)
     &     ,fixlat(ist,ifh),xmeanzeta,idum,jdum
     &     ,gridpoint_maxmin,'tracker'
     &     ,glatmax,glatmin,glonmax,glonmin
     &     ,trkrinfo,ifilret)
        if (ifilret == 0) then
          igridzeta(n) = int ((gridpoint_maxmin * 1e6) + 0.5)
        else
          igridzeta(n) = -99
        endif

        if ( verb .ge. 3 ) then
          write (6,623) n,ilev,gridpoint_maxmin,igridzeta(n),ifilret
 623      format (1x,'+++ RPT_GRID_ZETA: n= ',i2,' lev= ',i4
     &         ,' grid zeta= ',f9.6,'  igrid zeta (*1e6)= ',i8
     &         ,' ifilret= ',i3)
          write (6,*) '  --- grid zeta raw= ',gridpoint_maxmin
        endif
    
      enddo report_zeta_loop

      if ( verb .ge. 3 ) then
        write (6,*) ' '
        write (6,631) 
        write (6,633)
        write (6,635)
        write (6,*) ' '
      endif
        
 631  format(1x,'#---------------------------------------------------#')
 633  format(1x,'# End of loop to get 850 & 700 zeta for atcf file.  #')
 635  format(1x,'#---------------------------------------------------#')

      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine find_maxmin (imax,jmax,dx,dy,cparm,fxy,maxmin,ist
     &             ,guesslon,guesslat,rlonv,rlatv,valid_pt,trkrinfo
     &             ,compflag,ctlon,ctlat,xval,grid_maxlat,grid_minlat
     &             ,grid_maxlon,grid_minlon,cmodel_type,ifmret)
c
c     This routine  finds the location (clon,clat) of and value of the
c     the max or min of fxy in the vicinity of slon,slat.  The value of
c     the input flag maxmin determines whether to look for a max or a
c     min value.  The max/min is determined by finding the point which 
c     gives the max/min value of a single point barnes analysis of fxy 
c     with e-folding radius re (km) and influence radius ri (km). The 
c     initial search is restricted to a radius rads around the point 
c     (slon,slat) on a grid with lon,lat spacing dx and dy. The location
c     is refined by reducing the spacing of the search grid by a factor
c     of two, nhalf times.
c
c     INPUT:
c     imax     Num pts in i direction on input grid
c     jmax     Num pts in j direction on input grid
c     dx       Grid spacing in i-direction on input grid
c     dy       Grid spacing in j-direction on input grid
c     cparm    Char string indicating what parm is being passed in
c     fxy      Real array of data values
c     maxmin   Char string indicating whether to search for a max or min
c     ist      Number of the storm being processed
c     guesslon Guess longitude of the storm
c     guesslat Guess latitude of the storm
c     rlonv    Array containing longitude values of input grid points
c     rlatv    Array containing latitude values of input grid points
c     valid_pt Logical bitmap masking non-valid grid points.  This is a
c              concern for the regional models, which are interpolated 
c              from Lam-Conf or NPS grids onto lat/lon grids, leaving 
c              grid points around the edges which have no valid data.
c     trkrinfo derived type detailing user-specified grid info
c     grid_maxlat northernmost latitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_minlat southernmost latitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_maxlon easternmost longitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_minlon westernmost longitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     cmodel_type character, 'global' or 'regional'
c
c     INPUT/OUTPUT:
c     compflag Logical; continue processing this storm or not (would be
c              set to FALSE if, for example, the guess position is 
c              outside the domain of a regional grid)
c
c     OUTPUT:
c     ctlon    Center longitude of storm found for this parameter
c     ctlat    Center latitude of storm found for this parameter
c     xval     Max or Min value found at the (ctlon,ctlat)
c     ifmret   Return code from this subroutine
c
c     UPDATE DEC 2009: For the HFIP HRH testing, it was found that 
c     due to the very limited domain size of some of the models, the 
c     barnes scheme was allowing points close to the grid boundaries
c     to erroneously be selected as the center point.  We add in a 
c     buffer (grid_buffer) here to prevent this from occurring.

      USE radii; USE grid_bounds; USE set_max_parms; USE level_parms
      USE trig_vals; USE trkrparms
      USE verbose_output

      implicit none
c
      type (trackstuff) trkrinfo

      character(*)  maxmin,cparm,cmodel_type
      logical(1)    compflag, valid_pt(imax,jmax)
      real    fxy(imax,jmax),rlonv(imax),rlatv(jmax)
      real    ctlon,ctlat,degrees,dx,dy,guesslon,guesslat,xval
      real    rads,re,ri,dell,fmax,fmin,rlatt,rlont,dist,ftemp,ritmp
      real    vmag_latmax,vmag_latmin,vmag_lonmax,vmag_lonmin,retmp
      real    tlon,tlat,grid_buffer,temp_grid_minlon,temp_guesslon
      real    grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
      integer imax,jmax,ist,bskip1,bskip2,iskip,ifmret,npts,maxvgrid
      integer ibeg,iend,jbeg,jend,ilonfix,jlatfix,igiret,icount,iret
      integer ibct,ibarnes_loopct,i,j,k,iix,jix,jvlatfix,ivlonfix
      integer nhalf,icvpret
      integer date_time(8)
      character (len=10) big_ben(3)
c
      ifmret = 0
      nhalf = 5
c
c     -----------------------------------------------------------
c     Set initial parms for use in find_maxmin.
c     Different radii used for V magnitude than for other parms, 
c     see discussion in module radii for more details.
c
      if (cparm == 'vmag') then

c       NOTE: The maxvgrid variable determines what size grid to send 
c             to subroutine  barnes. e.g., maxvgrid = 8 means send an 
c             8x8 grid; maxvgrid = 12 means send a 12x12 grid.  For 
c             ultra-fine mesh grids (finer than 0.04 deg, or 1/25 deg),
c             we expand to 12 in order to sample a few more points
c             around each grid point.

        if ((dx+dy)/2. > 0.04) then
          maxvgrid = 8
        else
          maxvgrid = 12
        endif

        rads = rads_vmag; re = retrk_vmag; ri = ritrk_vmag
        re = (float(maxvgrid)/4) * ((dx+dy)/2. * dtk) ! Basically, this
c               sets re equal to half the distance from the gridpoint
c               in question to the farthest point that will be
c               sampled when the (maxvgrid x maxvgrid) grid is passed
c               on to subroutine  barnes.  Thus, just ignore the 
c               parameter retrk_vmag, and use this instead.
      else if ((dx+dy)/2. < 1.26 .and. (dx+dy)/2. >= 0.40) then
        rads = rads_most; re = retrk_most; ri = ritrk_most
      else if ((dx+dy)/2. < 0.40 .and. (dx+dy)/2. >= 0.10) then
        rads = rads_fine; re = retrk_most; ri = ritrk_most
      else if ((dx+dy)/2. < 0.10) then
        rads = rads_hres; re = retrk_hres; ri = ritrk_most
      else
        rads = rads_coarse; re = retrk_coarse; ri = ritrk_coarse
      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'At beg of find_maxmin, rads= ',rads,' re= ',re 
     &       ,' ri= ',ri,' cparm= ',cparm,' dx= ',dx,' dy= ',dy
      endif

      dell = (dx+dy)/2.
      npts = rads/(dtk*dell)
      fmax  = -1.0e+12; fmin  =  1.0e+12
      ctlon = 0.0; ctlat = 0.0

      if (npts == 0) npts = 1

c     For the  barnes analysis, we will want to speed things up for
c     finer resolution grids.  We can do this by skipping some of 
c     the points in the  barnes analysis.

      if (dell > 0.20) then
        bskip1 = 2
        bskip2 = 1
      else if (dell > 0.10 .and. dell <= 0.20) then
        bskip1 = 4
        bskip2 = 2
      else if (dell > 0.05 .and. dell <= 0.10) then
        bskip1 = 6
        bskip2 = 3
      else if (dell > 0.03 .and. dell <= 0.05) then
        bskip1 = 10
        bskip2 = 5
      else if (dell <= 0.03) then
        bskip1 = 15
        bskip2 = 5
      endif

      if (cparm == 'vmag') then
        bskip1 = 1
        bskip2 = 1
      endif

c     If input parm is vmag, we've already done the minimizing by 
c     interpolating to the fine mesh grid, so we'll simply send the 
c     bounds that were input to this subroutine to barnes
c     as boundaries for the array to search.  For all other parms, 
c     however, no minimizing has been done yet, so we need to call 
c     get_ij_bounds to set the boundaries for a much smaller grid that
c     surrounds the storm (as opposed to having subroutine  barnes 
c     search the entire global grid).

      if (cparm == 'vmag') then

        if ( verb .ge. 3 ) then
          print *,'In find_maxmin, jmax= ',jmax,' imax= ',imax
        endif

        ibeg=1; jbeg=1; iend=imax; jend=jmax
        vmag_latmax = rlatv(1)    ! N-most lat of vmag subgrid
        vmag_latmin = rlatv(jmax) ! S-most lat of vmag subgrid
        vmag_lonmin = rlonv(1)    ! W-most lon of vmag subgrid
        vmag_lonmax = rlonv(imax) ! E-most lon of vmag subgrid

        if ( verb .ge. 3 ) then
          write (6,44) vmag_latmax,vmag_lonmin,360.-vmag_lonmin
     &                ,imax,jmax
          write (6,46) vmag_latmin,vmag_lonmax,360.-vmag_lonmax
        endif

 44     format (' vmag_latmax= ',f8.3,' vmag_lonmin= ',f8.3
     &         ,'E  (',f8.3,'W)  imax= ',i4,' jmax= ',i4)
 46     format (' vmag_latmin= ',f8.3,' vmag_lonmax= ',f8.3
     &         ,'E  (',f8.3,'W)')

        if (vmag_lonmin > 330. .and. vmag_lonmax < 30.) then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! WARNING: For a case of find_maxmin, our vmag'
            print *,'!!! subgrid is straddling the GM.  The code should'
            print *,'!!! be able to handle this, but if strange errors'
            print *,'!!! are occurring, check into the code either here'
            print *,'!!! in find_maxmin or get_uv_ctr.'
            print *,' '
          endif
        endif

        npts = ceiling(rads/(dtk*dell))

      else

        call get_ij_bounds (npts,0,ri,imax,jmax,dx,dy
     &             ,grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
     &             ,guesslon,guesslat
     &             ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

        if (igiret /= 0) then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in find_maxmin from call to '
            print *,'!!! get_ij_bounds, stopping processing for'
            print *,'!!! storm number ',ist
          endif

          ifmret = 92
          return
        endif

      endif

c
c     ---------------------------------------------------------------
c
      if ( verb .ge. 3 ) then
        print *,' '
        write (6,39) guesslon,360.-guesslon,guesslat
 39     format (' guesslon= ',f8.3,'E  (',f8.3,'W)   guesslat= ',f8.3)
        if (cparm == 'vmag') then
          print *,'ilonfix= (unused) jlatfix= (unused)'
     &       ,' npts= ',npts
          print *,'ilonfix and jlatfix are meaningless for computing'
          print *,'vmag, so ignore the large values you see for them.'
        else 
          print *,'ilonfix= ',ilonfix,' jlatfix= ',jlatfix
     &       ,' npts= ',npts
        endif
        print *,'ibeg= ',ibeg,' jbeg= ',jbeg,' imax= ',imax
        print *,'iend= ',iend,' jend= ',jend,' jmax= ',jmax
      endif
        
      call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &     ,date_time)

      if ( verb .ge. 3 ) then
        write (6,31) date_time(5),date_time(6),date_time(7)
 31     format (1x,'TIMING: find_maxmin 1  ',i2.2,':',i2.2,':',i2.2)
      endif

      ibct=0
      ibarnes_loopct = 0

      if (grid_minlon > 330. .and. grid_maxlon < 30.) then
        ! Our grid is straddling over the GM.  This can happen either
        ! with a global grid or with a regional grid.  How can it happen
        ! for a global grid?  Well, for the case in which this routine
        ! is called from subroutine  get_uv_center, where a smaller
        ! subgrid of data is passed in, and that smaller subgrid may
        ! straddle the GM.  Anyway, we need a workaround.
        ! This workaround will put the minimum longitude
        ! in terms of a negative number, e.g., as opposed to being say,
        ! 354, it will be -6.  You can then leave the grid_maxlon as is.
        temp_grid_minlon = grid_minlon - 360.
        if (guesslon > 330.) then
          ! If our grid is straddling the GM and we have adjusted the
          ! grid_minlon to be a negative number, then we also need to
          ! check on the guesslon and adjust it if it is also to west
          ! of the GM.
          temp_guesslon = guesslon - 360.
        else
          temp_guesslon = guesslon
        endif
      else
        temp_grid_minlon = grid_minlon
        temp_guesslon = guesslon
      endif

      jix = 0

      if (cmodel_type == 'regional') then
        grid_buffer = 0.30
      else
        grid_buffer = 0.0
      endif

      jloop: do j=-npts,npts,bskip1

        jix = jix + 1
        rlatt = guesslat + dell*float(j)

        iix = 0

c        vlat(jix) = rlatt

        iloop: do i=-npts,npts,bskip1

          iix = iix + 1
          rlont = temp_guesslon + dell*float(i)

c          if (cparm == 'vmag') then
c            print *,' '
c            print '(a16,i6,a4,i6,2(a8,f8.3),a12,f8.3)'
c     &            ,'in find_max, i= ',i
c     &            ,' j= ',j,' rlatt= ',rlatt,' rlont= ',rlont
c     &            ,' 360-rlont= ',360.-rlont
c          endif

c         If any points in the search grid would extend beyond the grid
c         boundaries, then check and see if this is global grid.  If it
c         is, and the extension occurred in the i-direction, then adjust
c         the longitude to allow for grid wrapping.  If it is a regional
c         grid, then just cycle the iloop.  In previous versions of the
c         tracker, we would exit with an error message, but doing it
c         this way allows us to continue tracking some systems that may
c         be close to the grid boundary.  Also, remember to factor in
c         the grid_buffer discussed in the doc block above for this 
c         subroutine.

          if (rlont >= (grid_maxlon + dx - grid_buffer)) then
            if (trkrinfo%gridtype == 'global') then
              if (cparm == 'vmag') then
                cycle iloop  ! We are off the small vmag subgrid
              else
                rlont = rlont - 360.  ! We just GM-wrapped for the full,
                                      ! regular, global grid
              endif
            else
              cycle iloop
            endif
          endif

          if (rlont < (temp_grid_minlon + grid_buffer)) then
            if (trkrinfo%gridtype == 'global') then
              if (cparm == 'vmag') then
                cycle iloop  ! We are off the small vmag subgrid
              else
                rlont = rlont + 360.  ! We just GM-wrapped for the full,
                                      ! regular, global grid
              endif
            else
              cycle iloop
            endif
          endif

          if (rlatt > (grid_maxlat - grid_buffer) .or. 
     &        rlatt < (grid_minlat + grid_buffer)) then
            cycle iloop
          endif

c         Make sure that the point being investigated here as a
c         potential center has valid data at that point.  That is, for
c         some hires regional grids that have been rotated/converted
c         from a non-latlon grid to a latlon grid, there can be
c         locations within the (i,j) space that do not have valid data
c         at them. It makes no sense to consider a point such as this
c         as a potential center.
c         There is another simpler case here that we are watching out
c         for.  This is simply the case, again for model data where we
c         only have the innermost nest.  Depending on what we choose
c         for the variable "rads" above, with the way that "npts" is
c         defined for these iloops and jloops that we're in, we may be
c         searching over points that are simply well off the grid.
c         Therefore, it is critical to run through this
c         check_valid_point subroutine to make sure that we're not
c         going to inadvertantly be performing an analysis at one of
c         these "off-grid" points.  So.... if the return code from
c         check_valid_point comes back non-zero, simply cycle iloop
c         and go to the next point.

          call check_valid_point (imax,jmax,dx,dy,fxy,maxmin,valid_pt
     &        ,rlont,rlatt,grid_maxlat,grid_minlat,grid_maxlon
     &        ,temp_grid_minlon,trkrinfo,icvpret)

          if (icvpret /= 0) then
            if ( verb .ge. 1 ) then
              print *,'!!! NOT A VALID PT:  icvpret= ',icvpret
            endif

            cycle iloop
          endif

          call calcdist(rlont,rlatt,temp_guesslon,guesslat,dist,degrees)
          if (dist .gt. rads) cycle iloop

          if (cparm == 'vmag') then

c           This next bit of code gets the ij coordinates for an 8x8 
c           box around the current point under consideration. These ij
c           coordinates are sent to barnes so that barnes only loops 
c           64 times, as opposed to nearly 10,000 if the whole 97x97
c           array were sent.  So, fix rlatt to the grid point just 
c           northward of rlatt and fix rlont to the grid point just 
c           eastward of rlont.  Note that this makes for a modified 
c           barnes analysis in that we're  sort of specifying ahead of
c           time exactly which grid points will be included and we'll
c           be excluding some points that would be near the periphery
c           of each (rlont,rlatt)'s range, but as long as we're consis-
c           tent and do it this way for each point, it's well worth the
c           trade-off in cpu time.  Parameter maxvgrid determines what 
c           size array to send to barnes (maxvgrid=8 means 8x8)

            jvlatfix = int((vmag_latmax - rlatt)/dy + 1.)
            ivlonfix = int((rlont - temp_grid_minlon)/dx + 2.)
c            ivlonfix = int((rlont - vmag_lonmin)/dx + 2.)

            ibeg = ivlonfix - (maxvgrid/2)
            iend = ivlonfix + (maxvgrid/2 - 1)
            jbeg = jvlatfix - (maxvgrid/2 - 1)
            jend = jvlatfix + (maxvgrid/2)

            if (ibeg < 1 .or. jbeg < 1 .or.
     &          iend > imax .or. jend > jmax) then

              ! DO NOT quit if we find a boundary outside the grid 
              ! bounds.  Rather, just set the J violating bound(s) to
              ! the min or max limit, and for I bounds, allow the 
              ! program to continue down to subsequent code below,
              ! provided it's a global grid.

c             print *,'!!! '
c             print *,'!!! Before vmag adjustments, boundaries are: '
c             print *,'!!! rlont= ',rlont,' rlatt= ',rlatt,' dx= ',dx
c             print *,'!!! temp_grid_minlon= ',temp_grid_minlon
c             print *,'!!! vmag_latmax= ',vmag_latmax
c             print *,'!!! ivlonfix = ',ivlonfix,' jvlatfix = ',jvlatfix
c             print *,'!!! ibeg= ',ibeg,' iend= ',iend,' imax= ',imax
c             print *,'!!! jbeg= ',jbeg,' jend= ',jend,' jmax= ',jmax

              if (ibeg < 1) then
                if (trkrinfo%gridtype == 'global') then
                  continue   ! If wrapping past GM, there is code below
                             ! in this find_maxmin routine that can
                             ! modify the indices appropriately.  So...
                             ! do nothing here.
                else

                  if ( verb .ge. 1 ) then
                    print *,' '
                    print *,'!!! ERROR: In find_maxmin, the '
                    print *,'!!!    user-requested western boundary'
                    print *,'!!!    is beyond the western bounds of '
                    print *,'!!!    the vmag subgrid for this regional '
                    print *,'!!!    grid.  '
                    print *,'!!!         '
                    print *,'!!!   imax of regional grid    = ',imax
                    print *,'!!!   ivlonfix = ',ivlonfix,' ibeg= ',ibeg
                    print *,'!!!         '
                    print *,'!!! Vmag will not be computed for'
                    print *,'!!! this time.'
                    print *,' '
                  endif

                  ifmret = 99
                  return
                endif
              endif

              if (iend > imax) then
                if (trkrinfo%gridtype == 'global') then
                  continue   ! If wrapping past GM, there is code below
                             ! in this find_maxmin routine that can
                             ! modify the indices appropriately.  So...
                             ! do nothing here.
                else

                  if ( verb .ge. 1 ) then
                    print *,' '
                    print *,'!!! ERROR: In find_maxmin, the '
                    print *,'!!!    user-requested eastern boundary'
                    print *,'!!!    is beyond the eastern bounds of '
                    print *,'!!!    the vmag subgrid for this regional '
                    print *,'!!!    grid.  '
                    print *,'!!!         '
                    print *,'!!!   imax of regional grid    = ',imax
                    print *,'!!!   ivlonfix = ',ivlonfix,' iend= ',iend
                    print *,'!!!         '
                    print *,'!!! Vmag will not be computed for '
                    print *,'!!! this time.'
                    print *,' '
                  endif

                  ifmret = 99
                  return
                endif
              endif

              if (jbeg < 1) jbeg = 1
              if (jend > jmax) jend = jmax

              if ( verb .ge. 3 ) then
                print *,'!!! '
                print *,'!!! *AFTER* vmag adjustments, boundaries are: '
                print *,'!!! ibeg= ',ibeg,' iend= ',iend,' imax= ',imax
                print *,'!!! jbeg= ',jbeg,' jend= ',jend,' jmax= ',jmax
              endif

            endif

          endif

          if (cparm == 'vmag') then
            ri = re * 3
c            print '(a36,f10.4,a6,f10.4)'
c     &           ,'  + before call to vmag barnes, re= ',re,'  ri= ',ri
          endif

          ibct = ibct + 1
          call barnes(rlont,rlatt,rlonv,rlatv,imax,jmax,ibeg,jbeg
     &     ,iend,jend,fxy,valid_pt,bskip1,re,ri,ftemp,icount,'tracker'
     &     ,trkrinfo,iret)

          ibarnes_loopct = ibarnes_loopct + icount

          if (iret /= 0) then

            if ( verb .ge. 1 ) then
              print *,' '
              print *,'!!! Non-zero RCC from barnes...'
              print *,'!!! Exiting find_maxmin'
            endif

            compflag = .FALSE.
            ifmret = iret
            return
          endif

          if (maxmin == 'max') then
            if (ftemp > fmax) then
              fmax = ftemp
              ctlon = rlont
              ctlat = rlatt
            endif
          else
            if (ftemp < fmin) then
              fmin = ftemp
              ctlon = rlont
              ctlat = rlatt
            endif
          endif

        enddo iloop
      enddo jloop
 
      if ( verb .ge. 3 ) then
        print *,' '
        print *,'After 1st findmax loop, # calls to barnes = ',ibct
        print *,'Total # of barnes loop iterations = ',ibarnes_loopct
      endif

c
 55     format ('i= ',i3,' j= ',i3,'  rln= ',f7.3,'  rlt= ',f7.3
     &       ,'  barnval= ',f11.5)
 56     format ('k= ',i3,' i= ',i3,' j= ',i3,'  rln= ',f7.3,'  rlt= '
     &       ,f7.3,'  barnval= ',f11.5)

      if (ctlon < 0.) then
        ! We have grid-wrapped to find the ctlon, which was found to be
        ! < 0, so for reporting purposes and for the start of the next
        ! loop, set ctlon to positive degress east.
        ctlon = ctlon + 360.
      endif

      if (cparm == 'zeta') then

        if ( verb .ge. 3 ) then
          print *,'!!! Zeta check, fmax= ',fmax,' fmin= ',fmin
          write (6,61) 360.-ctlon,ctlat,fmax*100000.,fmin*100000.
        endif

      else

        if ( verb .ge. 3 ) then
          write (6,63) 360.-ctlon,ctlat,fmax,fmin
        endif

      endif
  61  format (' After first run, ctlon= ',f8.3,'W  ctlat= ',f8.3
     &       ,' fmax (x10e5) = ',e16.3,' fmin (x10e5) = ',e16.3)
  63  format (' After first run, ctlon= ',f8.3,'W  ctlat= ',f8.3
     &       ,' fmax = ',e16.3,' fmin = ',e16.3)
 111  format (i2,'  rlont= ',f7.2,'W   rlatt= ',f7.2,'  zeta= ',f13.8)

c     Through interpolation, the grid for vmag has already been
c     minimized considerably, we don't need to go through the 2nd part
c     of this subroutine, which halves the grid spacing.

      if (nhalf < 1 .or. cparm == 'vmag') then
        if (maxmin == 'max') then
          xval = fmax
        else
          xval = fmin
        endif
        return
      endif

c     If on our first pass through, we were dealing with a regional grid
c     that straddled the GM, then it becomes (for now) too much of a
c     coding hassle to deal with in the rest of this routine (i.e., in
c     all the nhalf iterations), so we will just go with the first run
c     through for the center fix and exit the routine.

      if (grid_minlon > 330. .and. grid_maxlon < 30.) then
        if (maxmin == 'max') then
          xval = fmax
        else
          xval = fmin
        endif
        return
      endif

c     -------------------------------------------------------------
c     If the grid spacing is
c     fine enough (I've chosen 0.2-deg as a min threshold), there is
c     no need to halve the grid more than 3 times, as halving a 
c     0.2-deg grid 3 times gives a resolution of 0.025-deg (2.7 km),
c     or a max error in the position estimate of 2.7/2 = 1.35 km.

      if ((dx+dy)/2. <= 0.2) then
        if ((dx+dy)/2. <= 0.05) then
          nhalf = 1
        else
          nhalf = 2
        endif
      endif

c     ---------------------------------------------------------------
c     ---------------------------------------------------------------
c     Halve the grid spacing to refine the location and value of the
c     max/min value, but restrict the area of the new search grid.

ctpm   npts = 3
      npts = npts/2
      npts = max(npts,1)

c     -------------------------------------------------------------
c     First, recalculate the i and j beginning and ending points to
c     be used in the  barnes analysis subroutine.  Only
c     do this once for this grid-refinement (even though the grid is
c     redefined 3 times in this subroutine), but make sure to have the
c     possible search grid be big enough to allow the possibility of
c     the grid shifting way right or way left each time through the
c     loop (get_ij_bounds takes care of this).

      call get_ij_bounds (npts,nhalf,ri,imax,jmax,dx,dy
     &              ,grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
     &              ,ctlon,ctlat,trkrinfo
     &              ,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)

      if (igiret /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in find_maxmin from call to get_ij_bounds'
          print *,'!!! just before nhalf loop.  Stopping processing'
          print *,'!!! for storm number ',ist
        endif

        ifmret = 92
        return
      endif

c     --------------------------------------------------------------
c     Now do the actual searching for the max/min value 

      
      if ( verb .ge. 3 ) then
        print *,' '
      endif

      if ((dx+dy)/2. <= 1.25 .and. ri >= 300 .and. re >= 150) then
        retmp = re
        ritmp = ri
        re = re * 0.5
        ri = ri * 0.5

        if ( verb .ge. 3 ) then
          print *,'After first pass through barnes, re has been reduced'
          print *,'from ',retmp,' to ',re,', and ri has been reduced '
          print *,'from ',ritmp,' to ',ri
        endif

      else

        if ( verb .ge. 3 ) then
          print *,'After first pass through barnes, re and ri have NOT '
          print *,'been changed.  re = ',re,' ri = ',ri
        endif

      endif

      ibct=0
      ibarnes_loopct = 0
      do k=1,nhalf

        call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                     ,date_time)
        if ( verb .ge. 3 ) then
          write (6,32) k,date_time(5),date_time(6),date_time(7)
 32       format (1x,'TIMING: find_maxmin kloop, k= ',i2,'   ',i2.2,':'
     &         ,i2.2,':',i2.2)
        endif

        dell = 0.5*dell
        tlon = ctlon
        tlat = ctlat
        fmax = -1.0e+15; fmin = 1.0e+15

        iskip = bskip2

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'find_maxmin nhalf loop, cparm= ',cparm,' k= ',k
          write (6,161) tlon,360.-tlon,tlat
          print *,'ilonfix= ',ilonfix,' jlatfix= ',jlatfix
     &         ,' npts= ',npts
          print *,'ibeg= ',ibeg,' jbeg= ',jbeg,' imax= ',imax
          print *,'iend= ',iend,' jend= ',jend,' jmax= ',jmax
          print *,'nhalf= ',nhalf,' iskip= ',iskip
        endif

        jloop2: do j=-npts,npts,iskip

          rlatt = tlat + dell*float(j)

          iloop2: do i=-npts,npts,iskip

            rlont = tlon + dell*float(i)

            if (rlont >= (grid_maxlon + dx - grid_buffer)) then
              if (trkrinfo%gridtype == 'global') then
                rlont = rlont - 360.
              else
                cycle iloop2
              endif
            endif

            if (rlont < (grid_minlon + grid_buffer)) then
              if (trkrinfo%gridtype == 'global') then
                rlont = rlont + 360.
              else
                cycle iloop2
              endif
            endif

            if (rlatt > (grid_maxlat - grid_buffer) .or. 
     &          rlatt < (grid_minlat + grid_buffer) .or.
     &          rlont >= (grid_maxlon + dx - grid_buffer) .or. 
     &          rlont < (grid_minlon + grid_buffer)) then
              cycle iloop2
            endif

c           Again, check and make sure that the lat/lon point in
c           question here has valid data (see the explanation further
c           up in this subroutine inside iloop).

            call check_valid_point (imax,jmax,dx,dy,fxy,maxmin,valid_pt
     &          ,rlont,rlatt,grid_maxlat,grid_minlat,grid_maxlon
     &          ,grid_minlon,trkrinfo,icvpret)

            if (icvpret /= 0) then
              cycle iloop2
            endif

            ibct = ibct + 1
            call barnes(rlont,rlatt,rlonv,rlatv,imax,jmax,ibeg,jbeg
     &        ,iend,jend,fxy,valid_pt,iskip,re,ri,ftemp,icount,'tracker'
     &        ,trkrinfo,iret)

            ibarnes_loopct = ibarnes_loopct + icount

            if (iret /= 0) then

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! Non-zero RCC from barnes, k= ',k
                print *,'!!! Exiting find_maxmin'
              endif

              compflag = .FALSE.
              ifmret = iret
              return
            endif

            if (maxmin == 'max') then
              if (ftemp > fmax) then
                fmax = ftemp
                ctlon = rlont
                ctlat = rlatt
              endif
            else
              if (ftemp < fmin) then
                fmin = ftemp
                ctlon = rlont
                ctlat = rlatt
              endif
            endif

          enddo iloop2
        enddo jloop2

      if ( verb .ge. 3 ) then
        if (cparm == 'zeta') then
          write (6,71) k,360.-ctlon,ctlat,fmax*100000.,fmin*100000.
        else
          write (6,73) k,360.-ctlon,ctlat,fmax,fmin
        endif
      endif

      enddo

  71  format (' nhalf findmax, k= ',i2,' ctlon= ',f8.3,'W  ctlat= '
     &       ,f8.3,' fmax (x10e5) = ',e16.3,' fmin (x10e5) = ',e16.3)
  73  format (' nhalf findmax, k= ',i2,' ctlon= ',f8.3,'W  ctlat= '
     &       ,f8.3,' fmax = ',e16.3,' fmin = ',e16.3)

 161  format (' guesslon= ',f8.3,'E  (',f8.3,'W)   guesslat= ',f8.3)
 
      if ( verb .ge. 3 ) then
        print *,' '
        print *,'ppp after 2nd findmax loop, # calls to barnes =  '
     &         ,ibct
        print *,'ppp Total # of barnes loop iterations = '
     &         ,ibarnes_loopct
      endif
 
      if (maxmin == 'max') then
        xval = fmax
      else
        xval = fmin
      endif
c
      return
      end
c
c----------------------------------------------------------------------
c
c----------------------------------------------------------------------
      subroutine barnes(flon,flat,rlon,rlat,iimax,jjmax,iibeg,jjbeg
     &        ,iiend,jjend,fxy,defined_pt,bskip,re,ri,favg,icount,ctype
     &        ,trkrinfo,iret)
c
c     ABSTRACT: This routine performs a single-pass barnes anaylsis
c     of fxy at the point (flon,flat). The e-folding radius (km)
c     and influence radius (km) are re and ri, respectively.
c
c     NOTE:  The input grid that is searched in this subroutine is most
c     likely NOT the model's full, original grid.  Instead, a smaller
c     subgrid of the original grid is searched.  The upper left and 
c     lower right grid point indices are passed into this subroutine 
c     (iibeg, jjbeg, iiend, jjend) for this subgrid.  These indices are
c     determined in the subroutine  get_ij_bounds, and the purpose of 
c     doing it this way is to limit the number of points for which the
c     subroutine has to calculate distances (for a global 1 deg grid,
c     the number of loop iterations is reduced from 65160 to somewhere
c     around 600).
c
c     NOTE: This subroutine will immediately exit with a non-zero
c     return code if it tries to access a grid point that does not have
c     valid data.  This would happen in the case of a regional grid, if
c     you try to access a point near the edge of the grid (remember that
c     because of the interpolation for the regional grids, there will be
c     areas around the edges that have no valid data).
c
c     INPUT:
c     flon    Lon value for center point about which barnes anl is done
c     flat    Lat value for center point about which barnes anl is done
c     rlon    Array of lon values for each grid point
c     rlat    Array of lat values for each grid point
c     iimax   Max number of pts in x-direction on input grid
c     jjmax   Max number of pts in y-direction on input grid
c     iibeg   i index for grid point to start barnes anlysis (upp left)
c     jjbeg   j index for grid point to start barnes anlysis (upp left)
c     iiend   i index for last grid point in barnes anlysis (low right)
c     jjend   j index for last grid point in barnes anlysis (low right)
c     fxy     Real array of data on which to perform barnes analysis
c     defined_pt Logical; bitmap array used for regional grids
c     bskip   integer to indicate number of grid points to skip during
c             a barnes loop, in order to speed processing
c     re      input e-folding radius for barnes analysis
c     ri      input influence radius for searching for min/max
c     ctype   character that lets subroutine know if this is a search
c             for the next position for the purposes of tc vitals or
c             for general tracking.  In the case of vitals, in
c             this barnes subroutine we are more lax and allow the
c             routine to keep searching even if we are close to the
c             grid boundary.  In a general tracking search, if we hit
c             the grid boundary even just once, we exit.
c     trkrinfo derived type detailing user-specified grid info
c
c     OUTPUT:
c     favg    Average value about the point (flon,flat)
c     iret    Return code from this subroutine
c
      USE trkrparms
      USE verbose_output

      type (trackstuff) trkrinfo

      real      fxy(iimax,jjmax), rlon(iimax), rlat(jjmax)
      real      degrees
      integer   bskip
      logical(1) defined_pt(iimax,jjmax)
      character(*) ctype

c     --------------------------

      res = re*re
      wts = 0.0
      favg = 0.0

      icount = 0

      do jix=jjbeg,jjend,bskip
        do iix=iibeg,iiend,bskip

          i = iix
          j = jix

          if (i < 1) then
            if (trkrinfo%gridtype == 'global') then
              i = iix + iimax
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i < 1 in subroutine  barnes for'
                print *,'!!! a non-global grid.  STOPPING....'
                print *,'!!! i= ',i
                print *,' '
              endif

              stop 97
            endif
          endif

          if (i > iimax) then
            if (trkrinfo%gridtype == 'global') then
              i = iix - iimax
            else

              if ( verb .ge. 1 ) then
                print *,' '
                print *,'!!! ERROR: i > imax in subroutine  barnes for'
                print *,'!!! a non-global grid.  STOPPING....'
                print *,'!!! i= ',i,' imax= ',iimax
                print *,' '
              endif

              stop 97
            endif
          endif

          icount = icount + 1

          call calcdist(flon,flat,rlon(i),rlat(j),dist,degrees)

          if (dist .gt. ri) cycle

          if (defined_pt(i,j)) then
            if (fxy(i,j) >-999.01 .and. fxy(i,j) <-998.99) then
              ! This is a patch.  Even though this (i,j) is a valid
              ! point, its zeta value has been set to -999 because a
              ! neighboring point in subroutine  rvcal was found
              ! to be out of the grid boundaries.
              cycle
            endif
            wt   = exp(-1.0*dist*dist/res)
            wts  = wts + wt
            favg = favg + wt*fxy(i,j)
          else
            if (ctype == 'vitals') then
              continue
            else
carw           print *,' '
carw           print *,'!!! UNDEFINED PT OUTSIDE OF GRID IN BARNES....'
carw           print *,'!!! i= ',i,' j= ',j
carw           print *,'!!! flon= ',flon,' flat= ',flat
carw           print *,'!!! rlon= ',rlon(i),' rlat= ',rlat(j)
carw           print *,'!!! re= ',re,' ri= ',ri
carw           print *,'!!! EXITING BARNES....'
carw           print *,' '
carw           iret = 95
carw           return
            endif
          endif
 
        enddo
      enddo
 
      if (wts > 1.0E-5) then
         favg = favg/wts
      else
         favg = 0.0
      endif
      iret = 0
c
      return
      end
c
c----------------------------------------------------------------------
c
c----------------------------------------------------------------------
      subroutine get_ij_bounds (npts,nhalf,ri,imax,jmax,dx,dy
     &          ,rglatmax,rglatmin,rglonmax,rglonmin,geslon,geslat
     &          ,trkrinfo,ilonfix,jlatfix,ibeg,jbeg,iend,jend,igiret)
c
c     -----------------------------------------------------------
c     ABSTRACT: This subroutine figures out, based on ri, dx and dy and
c     the guess latitude and longitude positions, the farthest reaching
c     grid points that are searchable by an analysis subroutine.  The
c     purpose is to return indices for a subgrid that is much smaller 
c     than the original, full grid.  This smaller subgrid can then be 
c     passed to a subsequent analysis or interpolation subroutine, and 
c     work can be done on this smaller array.  This can help save time, 
c     especially in the  barnes analysis subroutine, as work will only 
c     be done on, say, a 20 x 20 array (400 pts) instead of on a 
c     360 x 181 array (65160 pts).  It's crucial, however, to make sure 
c     that the ibeg, jbeg, iend and jend are extended far enough out to 
c     fully encompass any search that would be done.  Below is a 
c     diagram showing the different grids....
c
c Full Global or Regional Model Grid  (Grid F) ----------->
c     ----------------------------------------------------------------
c  |  |                            (ibeg,jbeg)                       |
c  |  | x = ij position that the        |      (Grid R)              |
c  |  |     geslat/geslon is fixed to.  ._______________.            |
c  |  |                                 |               |            |
c  |  | Even though only the points     |    (Grid B)   |            |
c  |  | within Grid B will be checked   |   . . . . k   |            |
c  v  | later on for a max/min (in the  |   . . . . .   |            |
c     | case of a subsequent call to    |   . . x . e   |            |
c     | find_maxmin), the  barnes anal- |   . . . . .   |            |
c     | ysis will include all pts sur-  |   . . . . .   |            |
c     | rounding these Grid B points    |               |            |
c     | that are within a radius of ri. ._______________.            |
c     | So in the case of pt. k, that ri                             |
c     | radius may extend all the way to the Grid R     |            |
c     | boundary, thus we need to include those    (iend,jend)       |
c     | points within our ibeg-jbeg-iend-jend bounds.                |
c     |                                                              |
c     ----------------------------------------------------------------
c
c     Remember that the grids we deal with start north and increase 
c     south, so the northernmost latitude on the input grid will have 
c     a j index of 1.
c
c     INPUT:
c     npts     Num pts from x to edge of max/min search grid (Grid B)
c              (i.e., You define the size of Grid B by the value of
c               npts that you pass into this subroutine).
c     nhalf    Number of times the grid spacing will be halved
c     ri       Radius of influence (for use in barnes analysis)
c     imax     Number of points in x-direction on original grid
c     jmax     Number of points in y-direction on original grid
c     dx       Input grid spacing in i-direction on original grid
c     dy       Input grid spacing in j-direction on original grid
c     rglatmax Value of northern-most latitude on original grid
c     rglatmin Value of southern-most latitude on original grid
c     rglonmax Value of eastern-most longitude on original grid
c     rglonmin Value of western-most longitude on original grid
c     geslat   Value of latitude of guess position of storm
c     geslon   Value of longitude of guess position of storm
c
c     OUTPUT:
c     ilonfix  i index on full, input grid that storm is fixed to
c     jlatfix  j index on full, input grid that storm is fixed to
c     ibeg     i index for top left of sub-array (Grid R) of input grid
c     iend     i index for bot right of sub-array (Grid R) of input grid
c     jbeg     j index for top left of sub-array (Grid R) of input grid
c     jend     j index for bot right of sub-array (Grid R) of input grid
c     igiret   Return code from this subroutine
c
      USE trig_vals; USE trkrparms
      USE verbose_output

      type (trackstuff) trkrinfo
      real tmpangle
c
      igiret = 0
c
c     --------------------------------------
c     GET BEGINNING AND ENDING J POINTS....
c
c     (1) Calculate number of searchable, max/min pts, that is, the pts 
c         from x to the edge of Grid B.
c     (2) Calculate number of pts beyond the last search point in Grid 
c         B, but are within the bounds of Grid R and thus can be 
c         included in the  barnes analysis.
c     (3) Add (1) and (2) to get the max number of pts to subtract/add
c         to x to get jbeg and jend.

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'Beginning of get_ij_bounds...'
        print *,'  geslat= ',geslat,' geslon= ',geslon
        print *,' '
      endif


c     If nhalf > 0: This occurs in the case of a call from fmax, when
c     the grid spacing is halved nhalf times.  In this case, we have to
c     do extra work to figure out the maximum possible grid point.  For
c     this case:
c       jhlatpts = # of grid pts to last possible search pt (from x to
c                  edge of Grid B in above diagram), plus a cushion.
c       jripts   = # of searchable grid points within radius ri of last
c                  possible search pt (num pts between edge of Grid B
c                  and edge of Grid R in above diagram), plus a cushion
c       jbmaxlatpts = # of pts (in j direction) from x to the edge of
c                     Grid R to include in this subgrid. 
c
c     If nhalf = 0: In this case, the grid spacing will not be reduced,
c     so the number of pts in j direction from x to the edge of Grid
c     B will be the input parameter npts, and just multiply it by 2,
c     and add 2 for a cushion to get jmaxlatpts.  Typically, this sub
c     is called from find_maxmin, and in that sub, the first time that
c     this sub is called, nhalf will = 0.  Then, after a first-shot
c     center is found, the grid spacing will be cut in order to rerun 
c     barnes on a smaller grid, and that's when nhalf will be sent 
c     here as 3.
c
      if (nhalf > 0) then
        rdeg = 0.0
        do i = 1,nhalf
          rdeg = rdeg + float(npts) * (1./(float(i)*2)) * (dx+dy)/2
        enddo
        jhlatpts = ceiling(rdeg/dy) + 1
        jripts   = ceiling((ri + 1.)/(dtk*dx)) + 1
        jbmaxlatpts = jhlatpts + jripts
      else
        jbmaxlatpts = npts * 2 + 2
      endif
c
c
c     Roughly fix geslat to the grid point just poleward of geslat.
c

      if ( verb .ge. 3 ) then
        print *,' '
        print *,' +++ Near top of get_ij_bounds, '
        print *,' +++ geslat= ',geslat,'  geslon= ',geslon
        print *,' +++ rglatmax= ',rglatmax,' rglatmin= ',rglatmin
        print *,' +++ rglonmax= ',rglonmax,' rglonmin= ',rglonmin
        print *,' +++ imax= ',imax,' jmax= ',jmax
        print *,' +++ dx= ',dx,' dy= ',dy,' nhalf= ',nhalf
        print *,' +++ npts= ',npts
        if(nhalf>0) then
           print *,' +++ jhlatpts= ',jhlatpts,' jripts= ',jripts
        else
           print *,' +++ nhalf<=0 so jhlatpts and jripts unused'
        endif
        print *,' +++ jbmaxlatpts= ',jbmaxlatpts
      endif

      if (geslat >= 0.0) then
        jlatfix = int((rglatmax - geslat)/dy + 1.)
      else
        jlatfix = ceiling((rglatmax - geslat)/dy + 1.)
      endif

      if ( verb .ge. 3 ) then
        print *,' +++ jlatfix= ',jlatfix
      endif

      jbeg = jlatfix - jbmaxlatpts
      jend = jlatfix + jbmaxlatpts
      if (jbeg > jmax ) then

        if ( verb .ge. 1 ) then
          print *,'!!! ERROR in get_ij_bounds, jbeg > jmax'
          print *,'!!! jbeg = ',jbeg,' jmax= ',jmax
        endif

        igiret = igiret + 1
        return
      endif
      if (jend < 1) then

        if ( verb .ge. 1 ) then
          print *,'!!! ERROR in get_ij_bounds, jend < 1, jend = ',jend
        endif

        igiret = igiret + 1
        return
      endif
      if (jbeg < 1) jbeg = 1
      if (jend > jmax) jend = jmax

      if ( verb .ge. 3 ) then
        print *,' +++ jbeg= ',jbeg,' jend= ',jend
      endif

      ! If using a global grid, avoid using the pole points, or else
      ! you'll get a cosfac = 0 and then a divide by zero!!!

      if (jend == jmax .and. rglatmin == -90.0) then
        jend = jmax - 2
      endif
      if (jbeg == 1    .and. rglatmax == 90.0) then
        jbeg = 3
      endif

c     -----------------------------------------
c     NOW GET BEGINNING AND ENDING I POINTS....
c
c     Using the map factor (cos lat), figure out, based on ri, the
c     max distance beyond the last search point in x-direction (in
c     degrees) that could be searched at this guess latitude (geslat)
c     (i.e., in the diagram above, the max num pts from pt. e eastward
c     to the edge of Grid R).  Calculate how many grid points that is,
c     add 2 to it for a cushion, & add the number of points (npts)
c     within the defined search grid (Grid B) to get ibmaxlonpts.
c
c     April, 2007: A min statement was put on the calculation to
c     derive dlon, since with that cosine in there, the values of
c     of dlon could get pretty ridiculous as you approach the poles.
c     Also, the cosine factor (cosfac) used to be computed at the
c     most poleward latitude possible given the jend here.  For
c     similar concerns with cosines near the poles, I've scrapped
c     this to instead compute the cosine factor at the input
c     guess latitude. - tpm

      cosfac = cos (geslat * dtr)
      tmpangle = cosfac * dtk
      dlon   = min((ri /tmpangle ),20.0)
c      dlon   = min((ri / (cosfac * dtk)),20.0)
c
      if (nhalf > 0) then
        ihlonpts    = ceiling(rdeg/dx) + 1
        ibmaxlonpts = ihlonpts + ceiling(dlon/dx) + 2
      else
        ibmaxlonpts = npts + ceiling(dlon/dx) + 2
      endif

      if ( verb .ge. 3 ) then
         if(nhalf>0) then
            print *,' +++ rdeg= ',rdeg,' ri= ',ri,' cosfac= ',cosfac
            print *,' +++ dtr= ',dtr,' dtk= ',dtk,' dlon= ',dlon
         else
            print*,' +++ nhalf<=0 so rdeg,ri,cosfac,dtr,dtk,dlon unused'
         endif
        print *,' +++ ibmaxlonpts= ',ibmaxlonpts,' dx= ',dx,' dy= ',dy
      endif

c     Roughly fix geslon to the grid point just EASTward of geslon.

      ilonfix = int((geslon - rglonmin)/dx + 2.)

      ibeg = ilonfix - ibmaxlonpts
      iend = ilonfix + ibmaxlonpts

      if ( verb .ge. 3 ) then
        print *,' +++ (orig) ilonfix= ',ilonfix
        print *,' +++ (orig) ibeg= ',ibeg,' iend= ',iend
        print *,' +++ '
      endif

      if (ibeg > imax) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 1 ) then
            print *,'+++ NOTE: in get_ij_bounds, ibeg > imax'
            print *,'+++ for a global grid; GM wrapping expected from'
            print *,'+++ calling routine.  ibeg = ',ibeg,' imax= ',imax
          endif

        else

          if ( verb .ge. 1 ) then
            print *,'!!! ERROR in get_ij_bounds, ibeg > imax'
            print *,'!!! for a non-global grid'
            print *,'!!! ibeg = ',ibeg,' imax= ',imax
          endif

          igiret = igiret + 1
          return
        endif
      endif
      if (iend > imax) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 3 ) then
            print *,'+++ NOTE: in get_ij_bounds, iend > imax'
            print *,'+++ for a global grid; GM wrapping expected from'
            print *,'+++ calling routine.  iend = ',iend,' imax= ',imax
          endif

        else
          ! For a regional grid, just set iend to be imax
          iend = imax
        endif
      endif
      if (ibeg < 1) then
        if (trkrinfo%gridtype == 'global') then
          
          if ( verb .ge. 3 ) then
            print *,'+++ NOTE: in get_ij_bounds, ibeg < 1'
            print *,'+++ for a global grid; GM wrapping expected from'
            print *,'+++ calling routine.  ibeg = ',ibeg,' imax= ',imax
          endif

        else
          ! For a regional grid, just set ibeg to be 1
          ibeg = 1
        endif
      endif
      if (iend < 1) then
        if (trkrinfo%gridtype == 'global') then

          if ( verb .ge. 3 ) then
            print *,'+++ NOTE: in get_ij_bounds, iend < 1'
            print *,'+++ for a global grid; GM wrapping expected from'
            print *,'+++ calling routine.  iend = ',iend,' imax= ',imax
          endif

        else

          if ( verb .ge. 3 ) then
            print *,'!!! ERROR in get_ij_bounds, iend < 1'
            print *,'!!! for a non-global grid'
            print *,'!!! iend = ',iend,' imax= ',imax
          endif

          igiret = igiret + 1
          return
        endif
      endif
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine check_bounds (guesslon,guesslat,ist,ifh,trkrinfo
     &                        ,icbret)
c
c     ABSTRACT:  This subroutine checks to make sure that the requested
c                storm is in fact within the model's grid boundaries;
c                this is only a concern for the regional models.
c
      USE def_vitals; USE grid_bounds; USE set_max_parms 
      USE trkrparms
      USE verbose_output 

      type (trackstuff) trkrinfo

      if (trkrinfo%gridtype == 'regional') then
        if (guesslon > glonmax .or. guesslon < glonmin .or.
     &       guesslat > glatmax .or. guesslat < glatmin) then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! IN check_bounds, Storm is outside of grid'
            print *,'!!! Storm ID =   ',storm(ist)%tcv_storm_id
            print *,'!!! Storm Name = ',storm(ist)%tcv_storm_name
            print *,'!!! ist= ',ist,' ifh= ',ifh
            print *,'!!! guess storm lon= ',guesslon
            print *,'!!! guess storm lat= ',guesslat
          endif

          icbret = 95
          goto 125
        else
          icbret = 0
        endif
      endif

      ! We have encountered problems with global grids where we 
      ! continue tracking almost the whole way to the pole.  While
      ! that's nice to do that, it creates problems for array 
      ! indices, especially in subroutine  getradii.  So we will cut
      ! our losses and eliminate tracking of storms within 
      ! 5 degrees of the pole for global grids.

      if ((trkrinfo%type == 'midlat' .or.
     &     trkrinfo%type == 'tcgen') .and.
     &     trkrinfo%gridtype == 'global')then
        if (guesslat > 85.0 .or. guesslat < -85.0) then

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! IN check_bounds, Storm is too close to the'
            print *,'!!! N or S Pole for global tracking.'
            print *,'!!! STOPPING TRACKING FOR THIS STORM DUE TO POLE'
            print *,'!!! Storm ID =   ',storm(ist)%tcv_storm_id
            print *,'!!! Storm Name = ',storm(ist)%tcv_storm_name
            print *,'!!! ist= ',ist,' ifh= ',ifh
            print *,'!!! guess storm lon= ',guesslon
            print *,'!!! guess storm lat= ',guesslat
          endif

          icbret = 95
        else
          icbret = 0
        endif
      endif

  125 continue
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine calcdist(rlonb,rlatb,rlonc,rlatc,xdist,degrees)
c
c     ABSTRACT: This subroutine computes the distance between two 
c               lat/lon points by using spherical coordinates to 
c               calculate the great circle distance between the points.
c                       Figure out the angle (a) between pt.B and pt.C,
c             N. Pole   then figure out how much of a % of a great 
c               x       circle distance that angle represents.
c              / \
c            b/   \     cos(a) = (cos b)(cos c) + (sin b)(sin c)(cos A)
c            /     \                                             
c        pt./<--A-->\c     NOTE: The latitude arguments passed to the
c        B /         \           subr are the actual lat vals, but in
c                     \          the calculation we use 90-lat.
c               a      \                                      
c                       \pt.  NOTE: You may get strange results if you:
c                         C    (1) use positive values for SH lats AND
c                              you try computing distances across the 
c                              equator, or (2) use lon values of 0 to
c                              -180 for WH lons AND you try computing
c                              distances across the 180E meridian.
c    
c     NOTE: In the diagram above, (a) is the angle between pt. B and
c     pt. C (with pt. x as the vertex), and (A) is the difference in
c     longitude (in degrees, absolute value) between pt. B and pt. C.
c
c     !!! NOTE !!! -- THE PARAMETER ecircum IS DEFINED (AS OF THE 
c     ORIGINAL WRITING OF THIS SYSTEM) IN KM, NOT M, SO BE AWARE THAT
c     THE DISTANCE RETURNED FROM THIS SUBROUTINE IS ALSO IN KM.
c
      USE trig_vals

      real degrees
c
      if (rlatb < 0.0 .or. rlatc < 0.0) then
        pole = -90.
      else
        pole = 90.
      endif
c
      distlatb = (pole - rlatb) * dtr
      distlatc = (pole - rlatc) * dtr
      difflon  = abs( (rlonb - rlonc)*dtr )
c
      cosanga = ( cos(distlatb) * cos(distlatc) + 
     &            sin(distlatb) * sin(distlatc) * cos(difflon))
 
c     This next check of cosanga is needed since I have had ACOS crash
c     when calculating the distance between 2 identical points (should
c     = 0), but the input for ACOS was just slightly over 1
c     (e.g., 1.00000000007), due to (I'm guessing) rounding errors.

      if (cosanga > 1.0) then
        cosanga = 1.0
      endif
cPENG added bug fixed on 04/28/2016--------------------------
      if (cosanga < -1.0) then
        cosanga = -1.0
      endif
cPENG added on 04/28/2016--------------------------

      degrees    = acos(cosanga) / dtr
      circ_fract = degrees / 360.
      xdist      = circ_fract * ecircum
c
c     NOTE: whether this subroutine returns the value of the distance
c           in km or m depends on the scale of the parameter ecircum. 
c           At the original writing of this subroutine (7/97), ecircum
c           was given in km.
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine subtract_cor (imax,jmax,dy,level)
c
c     ABSTRACT: This subroutine  subtracts out the coriolis parameter
c     from the vorticity values.  It is needed because at the original
c     writing of this system, all of the forecast centers who included
c     vorticity included only absolute vorticity.
c
      USE tracked_parms; USE trig_vals; USE grid_bounds

      implicit none

      integer :: i,j,imax,jmax,level
      real    :: dy,coriolis,rlat
c
      do j=1,jmax
        rlat = glatmax - ((j-1) * dy)
        coriolis = 2. * omega * sin(rlat*dtr) 
        do i=1,imax
          zeta(i,j,level) = zeta(i,j,level) - coriolis
        enddo
      enddo
c
      return
      end
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine get_grib_file_name (ifh,gfilename,ifilename)

c     ABSTRACT: This subroutine uses various input regarding the model
c     and forecast hour and generates the name of the input grib file
c     for this particular forecast hour.  Remember that the lead time
c     is in minutes and that 5 spaces must be reserved for the lead
c     time (e.g., f00360).  File name should be something that looks
c     like either, e.g., "gfdl.6thdeg.katrina12l.2005082818.f00720",
c     or "gfdl.6thdeg.2005082818.f00720" (the part in there with the
c     storm name & ID is optional).  The grib index file name should
c     be exactly the same as the grib data file itself, but with the
c     character string ".ix" added onto the end of the name.
c
c     NOTE: Array iftotalmins is brought in via module tracked_parms.
c
C     INPUT:
c     ifh      integer array index for current lead time
c
c     OUTPUT:
c     gfilename GRIB file name
c     ifilename GRIB index file name

      USE gfilename_info; USE tracked_parms; USE atcf
      USE verbose_output

      implicit none

      character(*) gfilename,ifilename
      character  cfmin*5,cymdh*10
      integer    ifh,nlen1,nlen2,nlen3,nlen4,nlen5

c     Convert integer minutes to 5-position character, with
c     leading zeroes, and convert 10-digit integer date into
c     10-position character.  Then trim the various input variables
c     and combine all into the file name.

      write (cfmin,'(i5.5)') iftotalmins(ifh)
      write (cymdh,'(i10.10)') atcfymdh

      nlen1     = len_trim(gmodname)
      gfilename = trim(gmodname(1:nlen1))

      nlen2     = len_trim(rundescr)

      gfilename = trim(gfilename(1:nlen1))//'.'//trim(rundescr(1:nlen2))

      nlen3     = len_trim(atcfdescr)
      nlen4     = len_trim(gfilename)

c     If an extension to the name with the ATCF or storm name descriptor
c     was included, then add it to the name now.  Otherwise, just add
c     the starting date and the lead time in minutes.

      if (nlen3 > 0) then
        gfilename = trim(gfilename(1:nlen4))//'.'
     &              //trim(atcfdescr(1:nlen3))//'.'//cymdh//'.f'//cfmin
      else
        gfilename = trim(gfilename(1:nlen4))//'.'//cymdh//'.f'//cfmin
      endif

c     Create the name for the grib index file, which is just the name of
c     the grib file, with "ix" added to the end of it.

      nlen5     = len_trim(gfilename)
      ifilename = trim(gfilename(1:nlen5))//'.ix'

      if ( verb .ge. 3 ) then
        write (6,*) ' '
        write (6,72) 'gfilename',gfilename
        write (6,72) 'ifilename',ifilename
      endif

   72 format (1x,'In get_grib_file_name, file name for ',a9
     &          ,' is ',a120)
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine getdata_grib (readflag,valid_pt,imax,jmax
     &               ,ifh,need_to_flip_lats,need_to_flip_lons,inp
     &               ,lugb,lugi,trkrinfo)
c
c     ABSTRACT: This subroutine reads the input GRIB file for the
c     tracked parameters.  It then calls subroutines to convert the
c     data from a 1-d array into a 2-d array if the read was successful.
c
c     There are up to 9 fields that are read in that will be used to
c     locate the storm position.  There are an additional 4 variables
c     (500 mb u- and v-components and 10 m u- and v- components) that
c     will not be used for tracking, but only for helping to estimate
c     the next first guess position (500 mb winds) and for estimating
c     the max near-surface wind speeds in the vicinity of the storm
c     (10 m winds).
c
c     Fields read in are listed here.  Numbers indicate positioning in
c     the readflag logical array:
c
c     1.   850 mb absolute vorticity
c     2.   700 mb absolute vorticity
c     3.   850 mb u-component
c     4.   850 mb v-component
c     5.   700 mb u-component
c     6.   700 mb v-component
c     7.   850 mb geopotential height
c     8.   700 mb geopotential height
c     9.   MSLP
c     10.  10-m u-component
c     11.  10-m v-component
c     12.  500 mb u-component
c     13.  500 mb v-component
c     14.  300-500 mb mean temperature (I jerry-rigged this by storing
c               the data as being at the 401 mb level.)
c     15.  500 mb geopotential height
c     16.  200 mb geopotential height
c     17.  Land-Sea mask -- This is for tcgen applications only, and 
c               even there, it's optional.
c
c     INPUT:
c     imax        integer number of pts in i-direction on grid
c     jmax        integer number of pts in j-direction on grid
c     ifh         integer index for forecast hour
c     need_to_flip_lats logical flag read in from getgridinfo that
c                 indicates if data needs flipped north to south
c     need_to_flip_lons logical flag read in from getgridinfo that
c                 indicates if data needs flipped east to west
c     inp         of a derived type, contains user-input info
c     lugb        integer unit number of input grib file
c     lugi        integer unit number of input grib index file
c     trkrinfo    derived type that contains info on the type of
c                 tracker run that we are performing.
c
c     OUTPUT:
c     readflag    logical array, indicates if a parm was read in
c     valid_pt    logical array, indicates for each (i,j) if there is
c                 valid data at the point (used for regional grids)

      USE tracked_parms; USE level_parms; USE inparms; USE phase
      USE verbose_output; USE params; USE grib_mod; USE trkrparms

      implicit none
c
      type (trackstuff) trkrinfo
      type (datecard) inp
      type (gribfield) :: gfld,prevfld,holdgfld
c
      integer, parameter :: jf=40000000
      integer, parameter :: nreadparms=17
      real, allocatable :: f(:)
      real :: dmin,dmax,firstval,lastval
      logical(1), allocatable :: lb(:)
      logical(1) valid_pt(imax,jmax),readflag(nreadparms)
      logical(1) ::  need_to_flip_lats,need_to_flip_lons
      logical(1) file_open
      logical :: unpack=.true.
      logical :: open_grb=.false.
      character*1 :: lbrdflag
      character*8 :: chparm(nreadparms)
      CHARACTER(len=8) :: pabbrev
      character (len=10) big_ben(3)
      integer   date_time(8)
      integer,dimension(200) :: jids,jpdt,jgdt
      integer :: listsec1(13), enable_timing
      integer, intent(in) :: imax,jmax
      integer   igparm(nreadparms),iglev(nreadparms)
      integer   iglevtyp(nreadparms)
      integer   ig2_parm_cat(nreadparms),ig2_parm_num(nreadparms)
      integer   ig2_lev_val(nreadparms),ig2_lev_typ(nreadparms)
cPENG  04/18/2018 for CMC Det. and CMC ensemble data
      integer   ig2_lev_11_cmc(nreadparms),ig2_lev_val_cmc(nreadparms)
      integer   ig2_lev_11_cmcd(nreadparms),ig2_lev_val_cmcd(nreadparms)

      integer   cpsig2_parm_cat(nlevs_cps),cpsig2_parm_num(nlevs_cps)
c      integer   cpsig2_lev_typ(nlevs_cps),cpsig2_lev_val(nlevs_cps)
cPENG-------
      integer   cpsig2_lev_10(nlevs_cps)
      integer   cpsig2_lev_11(nlevs_cps),cpsig2_lev_12(nlevs_cps)

      integer   ec_igparm(nreadparms),ec_iglev(nreadparms)
      integer   ec_iglevtyp(nreadparms)
      integer   cpsgparm(nlevs_cps),cpsglev(nlevs_cps)
      integer   cpsglevtyp(nlevs_cps)
      integer   ec_cpsgparm(nlevs_cps)
      integer   jpds(200),jgds(200),kpds(200),kgds(200)
      integer   igvret,ifa,ila,ip,ifh,i,j,k,kj,iret,kf,lugb,lugi
      integer   jskp,jdisc,np
      integer   jpdtn,jgdtn,npoints,icount,ipack,krec
      integer   pdt_4p0_vert_level,pdt_4p0_vtime
      integer :: listsec0(2)=(/0,2/)
      integer :: igds(5)=(/0,0,0,0,0/),previgds(5)
      integer :: idrstmpl(200)
      integer :: currlen=1000000
c
      lbrdflag = 'n'
      enable_timing=trkrinfo%enable_timing
c     The following data statements contain the parameters that will be
c     used to search the grib files.  The first 9 parameters will all be
c     used to locate the storm position.  The last 4 parameters (500 mb
c     u- and v-components and 10 m u- and v- components) will not be
c     used for tracking, but only for helping to estimate the next first
c     guess position (500 mb winds) and for estimating the max near-
c     surface wind speeds in the vicinity of the storm (10 m winds).
c
c     ** NOTE: iglevtyp(12 & 13) and iglev(12 & 13) are initialized to
c              0 just to satisfy the IBM xlf compiler, which barks about
c              there being too few initial values in the list when I
c              only had 11 values there -- even though the real
c              initialization for these variables is done just about
c              10 lines below.
c    
c     ** NOTE: The new ECMWF hi-res data uses the ECMWF GRIB parameter
c              ID table, which has different values than the NCEP
c              table.  Therefore, we needed to add the variables and
c              data values for ec_igparm, ec_iglevtyp and ec_iglev.
c
c     July 2007: Read statements added for GP height for cyclone
c     phase space (CPS) algorithm.

c      data igparm   /41,41,33,34,33,34,7,7,1,33,34,33,34,11,7,7,81/
      data igparm   /41,41,33,34,33,34,7,7,2,33,34,33,34,11,7,7,81/
      data iglevtyp /100,100,100,100,100,100,100,100,102,0,0,100,100
     &              ,100,100,100,1/
      data iglev    /850,700,850,850,700,700,850,700,0,0,0,500,500,401
     &              ,500,200,0/

      data cpsgparm     /13*7/
      data ec_cpsgparm  /13*156/
      data cpsglevtyp /13*100/
      data cpsglev    /900,850,800,750,700,650,600,550,500,450,400
     &                ,350,300/

      data ec_igparm   /999,999,131,132,131,132,156,156,151,165,166
     &                 ,131,132,130,156,156,999/
      data ec_iglevtyp /100,100,100,100,100,100,100,100,1,0,0,100,100
     &                 ,100,100,100,999/
      data ec_iglev    /850,700,850,850,700,700,850,700,0,0,0,500,500
     &                 ,401,500,200,999/

      data chparm   /'absv','absv','ugrid','vgrid','ugrid','vgrid'
     &              ,'gphgt','gphgt','mslp','ugrid','vgrid','ugrid'
     &              ,'vgrid','temp','gphgt','gphgt','lmask'/

      data ig2_parm_cat /2,2,2,2,2,2,3,3,3,2,2,2,2,0,3,3,2/
      data ig2_parm_num /10,10,2,3,2,3,5,5,1,2,3,2,3,0,5,5,8/
      data ig2_lev_typ  /100,100,100,100,100,100,100,100,101,103,103
     &                  ,100,100,100,100,100,-9999/
      data ig2_lev_val  /850,700,850,850,700,700,850,700,0,10,10,500,500
     &                  ,401,500,200,-9999/
cPENG  04/18/2018 for CMC Det. and CMC ensemble data
      data ig2_lev_11_cmc /-3,-4,-3,-3,-4,-4,-3,-4,0,0,0,-4,-4,0
     &                     ,-4,-4,0/
      data ig2_lev_val_cmc/85,7,85,85,7,7,85,7,0,10,10,5,5,40100
     &                     ,5,2,-9999/

      data ig2_lev_11_cmcd /-3,-4,-3,-3,-4,-4,-3,-4,0,0,0,-4,-4,0
     &                     ,-4,-4,0/
      data ig2_lev_val_cmcd /85,7,85,85,7,7,85,7,0,10,10,5,5,40100
     &                       ,5,2,-9999/

      data cpsig2_parm_cat /13*3/
      data cpsig2_parm_num /13*5/
c      data cpsig2_lev_typ  /13*100/
c      data cpsig2_lev_val  /900,850,800,750,700,650,600,550,500,450,400
c     &                     ,350,300/
cPENG----------------------------------
      data cpsig2_lev_10  /13*100/
      data cpsig2_lev_11  /13*0/
      data cpsig2_lev_12  /90000,85000,80000,75000,70000,65000
     &                     ,60000,55000,50000,45000,40000
     &                     ,35000,30000/      

c     Model numbers used: (1) AVN, (2) MRF, (3) UKMET, (4) ECMWF,
c                (5) NGM, (6) Early Eta, (7) NAVGEM, (8) GDAS,
c                (10) NCEP Ensemble, (11) ECMWF Ensemble,
c                (13) SREF Ensemble,
c                (14) NCEP Ensemble (from ensstat mean fields),
c                (15) CMC, (16) CMC Ensemble, (17) HWRF,
c                (18) HWRF Ensemble, (19) HWRF-DAS (HDAS),
c                (20) NCEP Ensemble RELOCATION
c                (21) UKMET hi-res (from NHC)
c                (23) FNMOC Ensemble
c                (24) HWRF Basin-scale

      if (trkrinfo%gribver == 2) then

c       For GRIB2, we will check to see if the MSLP being searched for
c       is the standard MSLP (MSLP parm ID = 1) or if it is the 
c       so-called "Eta" or "Membrane" MSLP reduction that is included 
c       in the output for some models (like GFS and GDAS).  Note that
c       for 10m winds, with GRIB2, so far with all of the GRIB2 model
c       data we've seen to this point, they all have the same IDs for 
c       10m winds for all models, so no need to break out by model 
c       like we do for GRIB v1 in the else portion of this if statement.
 
        ig2_parm_num(9) = trkrinfo%g2_mslp_parm_id ! 1 = standard MSLP
                             ! reduction, 192 = "Eta" or "Membrane" 
                             ! reduction used in GFS, GDAS and others.

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'Before GRIB2 read, MSLP ID = ig2_parm_num(9) = '
     &           ,ig2_parm_num(9)

        endif

      else

c       For GRIB1, do the same check as done just above in the IF part
c       of this IF statement, but note that we need to also check to 
c       see what the GRIB1 parm IDs are for the sfc wind level type 
c       and value.  Most models list the level type as 105 (which means
c       height above the ground) and then a level value of 10.  But 
c       ECMWF and UKMET use a level type of 1 (which means ground or 
c       water surface) and a level value of 0.

        igparm(9) = trkrinfo%g1_mslp_parm_id ! 102 = standard MSLP
                             ! reduction, 130 = "Eta" or "Membrane" 
                             ! reduction used in GFS, GDAS and others. 

        iglevtyp(10) = trkrinfo%g1_sfcwind_lev_typ ! 105 for most
        iglevtyp(11) = trkrinfo%g1_sfcwind_lev_typ ! 105 for most
        iglev(10)    = trkrinfo%g1_sfcwind_lev_val ! 10 for most
        iglev(11)    = trkrinfo%g1_sfcwind_lev_val ! 10 for most

        ec_iglevtyp(10) = trkrinfo%g1_sfcwind_lev_typ ! = 1 for ECMWF
        ec_iglevtyp(11) = trkrinfo%g1_sfcwind_lev_typ ! = 1 for ECMWF
        ec_iglev(10)    = trkrinfo%g1_sfcwind_lev_val ! = 0 for ECMWF
        ec_iglev(11)    = trkrinfo%g1_sfcwind_lev_val ! = 0 for ECMWF

        if ( verb .ge. 3 ) then
          print *,' ' 
          print *,'Before GRIB1 read, MSLP ID = igparm(9) = '
     &           ,igparm(9)
          print *,'Before GRIB1 read, non-ECMWF sfcwind lev type = '
     &           ,iglevtyp(10)
          print *,'Before GRIB1 read, non-ECMWF sfcwind lev value = '
     &           ,iglev(10)
          print *,'Before GRIB1 read, ECMWF sfcwind lev type = '
     &           ,ec_iglevtyp(10)
          print *,'Before GRIB1 read, ECMWF sfcwind lev value = '
     &           ,ec_iglev(10)
        endif

      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'NOTE: Program is now in subroutine  getdata.  A return'
        print *,'code (iret) not equal to zero indicates that '
        print *,'subroutine getgb was unable to find the requested '
        print *,'parameter.  This could be simply because the parm is '
        print *,'not included in the grib file (this is likely for '
        print *,'ECMWF data, as they limit what they send us), or it '
        print *,'could indicate a problem with the grib index file.'
      endif


      if (allocated(f)) deallocate(f)
      if (allocated(lb)) deallocate(lb)
      allocate (f(imax*jmax),stat=ifa)
      allocate (lb(imax*jmax),stat=ila)
      if (ifa /= 0 .or. ila /= 0) then
        print *,' '
        print *,'!!! ERROR in getdata allocating f or lb array.'
        print *,'!!! ifa = ',ifa,' ila= ',ila
        print *,'!!! STOPPING EXECUTION'
        STOP 91
      endif

      if (trkrinfo%gribver == 2) then

        ! Reading from a GRIB v2 file....

        grib2_standard_parm_read_loop: do ip = 1,nreadparms

          if (ip == 17) then
            if (trkrinfo%use_land_mask == 'y' .or.
     &          trkrinfo%use_land_mask == 'Y') then
              continue
            else
              if (verb .ge. 3) then
                print *,' '             
                print *,'The use_land_mask flag has not been set to  '
                print *,'y or Y, so we will not try to read it in... '
                print *,' '             
                cycle grib2_standard_parm_read_loop
              endif
            endif
          endif

          !
          ! ---  Initialize Variables ---
          !

          gfld%idsect => NULL()
          gfld%local => NULL()
          gfld%list_opt => NULL()
          gfld%igdtmpl => NULL()
          gfld%ipdtmpl => NULL()
          gfld%coord_list => NULL()
          gfld%idrtmpl => NULL()
          gfld%bmap => NULL()
          gfld%fld => NULL()

          if (ip == 17) then
            jdisc=1 ! hydrological products.  At this point, used only 
                    ! for the land-sea mask.
          else
            jdisc=0 ! meteorological products
          endif
          jids=-9999
          jpdtn=trkrinfo%g2_jpdtn ! 0 = analysis or forecast; 
                                  ! 1 = ens fcst
          jgdtn=0 ! lat/lon grid
          jgdt=-9999
          jpdt=-9999

          npoints=0
          icount=0
          jskp=0

c         Search for input parameter by production template 4.0.  This
c         tave program is used primarily for temperature, but still we
c         will leave that as a variable and not-hard wire it in case we
c         choose to average something else in the future.

          ! We are looking for Temperature or GP Height here.  This
          ! block of code, or even the smaller subset block of code that
          ! contains the JPDT(1) and JPDT(2) assignments, can of course
          ! be modified if this program is to be used for interpolating
          ! other variables....

          ! Set defaults for JPDT, then override in array
          ! assignments below...

          JPDT(1:15)=(/-9999,-9999,-9999,-9999,-9999,-9999,-9999,-9999
     &               ,-9999,-9999,-9999,-9999,-9999,-9999,-9999/)

          JPDT(1) = ig2_parm_cat(ip)
          JPDT(2) = ig2_parm_num(ip)

          if (inp%lt_units == 'minutes') then
            JPDT(8) = 0
            JPDT(9) = iftotalmins(ifh)
          else
            JPDT(8) = 1
            JPDT(9) = ifhours(ifh)
          endif

          JPDT(10) = ig2_lev_typ(ip)
cPENG  04/18/2018  CMC Det. and CMC ensemble data
          if (inp%model == 16 ) then
            JPDT(11) = ig2_lev_11_cmc(ip)
            JPDT(12) = ig2_lev_val_cmc(ip)
          elseif (inp%model == 15 ) then
            JPDT(11) = ig2_lev_11_cmcd(ip)
            JPDT(12) = ig2_lev_val_cmcd(ip)
          else
            JPDT(11) = 0
            if (JPDT(10) == 100) then   ! isobaric surface
              JPDT(12) = ig2_lev_val(ip) * 100  !  GRIB2 levels are in Pa
            else
              JPDT(12) = ig2_lev_val(ip) ! This is going to be either mslp
     &                                 ! or 10m winds.
            endif
          endif

          if ( verb_g2 .ge. 1 ) then
            print *,'before getgb2 call, value of unpack = ',unpack
          endif

          inquire (unit=lugb, opened=file_open)
          if (file_open) then
            if (verb .ge. 3) then
              print *,'TEST b4 getgb2 getdata, unit lugb= ',lugb
     &               ,' is OPEN'
            endif
          else
            if (verb .ge. 3) then
              print *,'TEST b4 getgb2 getdata, unit lugb= ',lugb
     &               ,' is CLOSED'
            endif
          endif

          inquire (unit=lugi, opened=file_open)
          if (file_open) then
            if (verb .ge. 3) then
              print *,'TEST b4 getgb2 getdata, unit lugi= ',lugi
     &               ,' is OPEN'
            endif
          else
            if (verb .ge. 3) then
              print *,'TEST b4 getgb2 getdata, unit lugi= ',lugi
     &               ,' is CLOSED'
            endif
          endif

          if(enable_timing/=0) then
             call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &            ,date_time)
             write (6,531) date_time(5),date_time(6),date_time(7)
 531        format (1x,'TIMING: before getgb2-1',i2.2,':',i2.2,':',i2.2)
          endif

          call getgb2(lugb,lugi,jskp,jdisc,jids,jpdtn,jpdt,jgdtn,jgdt
     &             ,unpack,krec,gfld,iret)

          if(enable_timing/=0) then
             call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &            ,date_time)
             write (6,532) date_time(5),date_time(6),date_time(7)
 532         format (1x,'TIMING: after getgb2-1',i2.2,':',i2.2,':',i2.2)
          endif

          if ( verb .ge. 3 ) then
            print *,'iret from getgb2 in getdata = ',iret
          endif

          if (verb_g2 .ge. 1) then
            print *,'after getgb2 call, value of unpacked = '
     &             ,gfld%unpacked
            print *,'after getgb2 call, gfld%ngrdpts = ',gfld%ngrdpts
            print *,'after getgb2 call, gfld%ibmap = ',gfld%ibmap
          endif

          if ( iret == 0) then

            if ( verb .ge. 3 ) then
              print *,'+++ Good Read: getgb2 found parm: ',chparm(ip)
              print *,'+++       at level = ',ig2_lev_val(ip)
              if (inp%lt_units == 'minutes') then
                print *,'+++       Forecast time = ',iftotalmins(ifh)
     &               ,' minutes'
              else
                print *,'+++       Forecast time = ',ifhours(ifh)
     &                 ,' hours'
              endif
            endif

c           Determine packing information from GRIB2 file
c           The default packing is 40  JPEG 2000

            ipack = 40

            if (verb_g2 .ge. 1) then
              print *,' gfld%idrtnum = ', gfld%idrtnum
            endif

            !   Set DRT info  ( packing info )
            if ( gfld%idrtnum.eq.0 ) then      ! Simple packing
              ipack = 0
            elseif ( gfld%idrtnum.eq.2 ) then  ! Complex packing
              ipack = 2
            elseif ( gfld%idrtnum.eq.3 ) then  ! Complex & spatial
     &                                         ! packing
              ipack = 31
            elseif ( gfld%idrtnum.eq.40.or.gfld%idrtnum.eq.15 ) then
              ! JPEG 2000 packing
              ipack = 40
            elseif ( gfld%idrtnum.eq.41 ) then  ! PNG packing
              ipack = 41
            endif

            if ( verb_g2 .ge. 1 ) then
              print *,'After check of idrtnum, ipack= ',ipack
              print *,'Number of gridpts= gfld%ngrdpts= ',gfld%ngrdpts
              print *,'Number of elements= gfld%igdtlen= ',gfld%igdtlen
              print *,'GDT num= gfld%igdtnum= ',gfld%igdtnum
            endif

            kf = gfld%ngrdpts  ! Number of gridpoints returned from read

            do np = 1,kf
              f(np)  = gfld%fld(np)
              if (gfld%ibmap == 0) then
                lb(np)  = gfld%bmap(np)
              else
                lb(np)  = .true.
              endif
            enddo

            readflag(ip) = .TRUE.
            call bitmapchk(kf,lb,f,dmin,dmax)

c           Convert logical bitmap to 2-d array (only need to do this
c           once since using same model for all variables).

            if (lbrdflag .eq. 'n') then
              call conv1d2d_logic (imax,jmax,lb,valid_pt
     &                                           ,need_to_flip_lats)
              lbrdflag = 'y'
            endif

            firstval=gfld%fld(1)
            lastval=gfld%fld(kf)

            if (verb_g2 .ge. 1) then
              print *,' '
              print *,' SECTION 0: discipl= ',gfld%discipline
     &               ,' gribver= ',gfld%version
              print *,' '
              print *,' SECTION 1: '

              do j = 1,gfld%idsectlen
                 print *,'     sect1, j= ',j,' gfld%idsect(j)= '
     &                  ,gfld%idsect(j)
              enddo

              if ( associated(gfld%local).AND.gfld%locallen.gt.0) then
                print *,' '
                print *,' SECTION 2: ',gfld%locallen,' bytes'
              else
                print *,' '
                print *,' SECTION 2 DOES NOT EXIST IN THIS RECORD'
              endif

              print *,' '
              print *,' SECTION 3: griddef= ',gfld%griddef
              print *,'            ngrdpts= ',gfld%ngrdpts
              print *,'            numoct_opt= ',gfld%numoct_opt
              print *,'            interp_opt= ',gfld%interp_opt
              print *,'            igdtnum= ',gfld%igdtnum
              print *,'            igdtlen= ',gfld%igdtlen

              print *,' '
              print '(a17,i3,a2)',' GRID TEMPLATE 3.',gfld%igdtnum,': '
              do j=1,gfld%igdtlen
                print *,'    j= ',j,' gfld%igdtmpl(j)= ',gfld%igdtmpl(j)
              enddo

c             Get parameter abbrev for record that was retrieved
              print *,' '
              print *,'     PDT num (gfld%ipdtnum) = ',gfld%ipdtnum
              print *,' '
              print '(a20,i3,a2)',' PRODUCT TEMPLATE 4.',gfld%ipdtnum
     &             ,': '
              do j=1,gfld%ipdtlen
                print *,'    sect 4  j= ',j,' gfld%ipdtmpl(j)= '
     &                 ,gfld%ipdtmpl(j)
              enddo
            endif
   
            pdt_4p0_vtime      = gfld%ipdtmpl(9)
            pdt_4p0_vert_level = gfld%ipdtmpl(12)

            pabbrev=param_get_abbrev(gfld%discipline,gfld%ipdtmpl(1)
     &                          ,gfld%ipdtmpl(2))

            if (verb .ge. 3) then
              print *,' '
              write (6,131)
 131          format (' rec#   param     level  byy  bmm  bdd  bhh  '
     &               ,'fhr      npts  firstval    lastval     minval   '
     &               ,'   maxval')
              print '(i5,3x,a8,2x,6i5,2x,i8,4g12.4)'
     &            ,krec,pabbrev,pdt_4p0_vert_level,gfld%idsect(6)
     &            ,gfld%idsect(7),gfld%idsect(8),gfld%idsect(9)
     &            ,pdt_4p0_vtime,gfld%ngrdpts,firstval,lastval,dmin,dmax
cPENG &            ,krec,pabbrev,pdt_4p0_vert_level/100,gfld%idsect(6)
            endif

            select case (chparm(ip))
              case ('absv')
                if (jpdt(12) == 85000 .or. jpdt(12) == 85) then
                  call conv1d2d_real (imax,jmax,f,zeta(1,1,1)
     &                                           ,need_to_flip_lats)
                else
                  call conv1d2d_real (imax,jmax,f,zeta(1,1,2)
     &                                           ,need_to_flip_lats)
                endif
              case ('ugrid')
                if (jpdt(12) == 85000 .or. jpdt(12) == 85) then
                  call conv1d2d_real (imax,jmax,f,u(1,1,1)
     &                                           ,need_to_flip_lats)
                else if (jpdt(12) == 70000 .or. jpdt(12) == 7) then
                  call conv1d2d_real (imax,jmax,f,u(1,1,2)
     &                                           ,need_to_flip_lats)
                else if (jpdt(12) == 50000 .or. jpdt(12) == 5) then
                  call conv1d2d_real (imax,jmax,f,u(1,1,3)
     &                                           ,need_to_flip_lats)
                else
                  ! Near-surface data
                  call conv1d2d_real (imax,jmax,f,u(1,1,4)
     &                                           ,need_to_flip_lats)
                endif
              case ('vgrid')
                if (jpdt(12) == 85000 .or. jpdt(12) == 85) then
                  call conv1d2d_real (imax,jmax,f,v(1,1,1)
     &                                           ,need_to_flip_lats)
                else if (jpdt(12) == 70000 .or. jpdt(12) == 7) then
                  call conv1d2d_real (imax,jmax,f,v(1,1,2)
     &                                           ,need_to_flip_lats)
                else if (jpdt(12) == 50000 .or. jpdt(12) == 5) then
                  call conv1d2d_real (imax,jmax,f,v(1,1,3)
     &                                           ,need_to_flip_lats)
                else
                  ! Near-surface data
                  call conv1d2d_real (imax,jmax,f,v(1,1,4)
     &                                           ,need_to_flip_lats)
                endif
              case ('gphgt')
                if (jpdt(12) == 85000 .or. jpdt(12) == 85) then
                  call conv1d2d_real (imax,jmax,f,hgt(1,1,1)
     &                                           ,need_to_flip_lats)
                else if (jpdt(12) == 70000 .or. jpdt(12) == 7) then
                  call conv1d2d_real (imax,jmax,f,hgt(1,1,2)
     &                                           ,need_to_flip_lats)
                else if (jpdt(12) == 50000 .or. jpdt(12) == 5) then
                  call conv1d2d_real (imax,jmax,f,hgt(1,1,3)
     &                                           ,need_to_flip_lats)
                else if (jpdt(12) == 20000 .or. jpdt(12) == 2) then
                  call conv1d2d_real (imax,jmax,f,hgt(1,1,4)
     &                                           ,need_to_flip_lats)
                endif
              case ('mslp')
                call conv1d2d_real (imax,jmax,f,slp
     &                                           ,need_to_flip_lats)
              case ('temp')
                call conv1d2d_real (imax,jmax,f,tmean
     &                                           ,need_to_flip_lats)
              case ('lmask')
                call conv1d2d_real (imax,jmax,f,lsmask
     &                                           ,need_to_flip_lats)
              case default

              if ( verb .ge. 1 ) then
                print *,'!!! ERROR: BAD CHPARM IN GETDATA = ',chparm(ip)
              endif

            end select

          else

            if ( verb .ge. 3 ) then
              print *,'!!! NOTE: getgb2 could not find parm: '
     &               ,chparm(ip)
              print *,'!!!       at level = ',ig2_lev_val(ip)
              if (inp%lt_units == 'minutes') then
                print *,'!!!       Forecast time = ',iftotalmins(ifh)
     &               ,' minutes'
              else
                print *,'!!!       Forecast time = ',ifhours(ifh)
     &                 ,' hours'
              endif
            endif

          endif

        enddo grib2_standard_parm_read_loop

c       *------------------------------------------------------------*
c        If we are attempting to determine the cyclone structure,
c        then read in data now that will allow us to do that.
c        This is the GRIB2 reading section.
c       *------------------------------------------------------------*

        if (phaseflag == 'y') then

          if (phasescheme == 'cps' .or. phasescheme == 'both') then

            ! Read in GP Height levels for cyclone phase space...

            grib2_cps_parm_lev_loop: do ip = 1,nlevs_cps

              !
              ! ---  Initialize Variables ---
              !
      
              gfld%idsect => NULL()
              gfld%local => NULL()
              gfld%list_opt => NULL()
              gfld%igdtmpl => NULL()
              gfld%ipdtmpl => NULL()
              gfld%coord_list => NULL()
              gfld%idrtmpl => NULL()
              gfld%bmap => NULL()
              gfld%fld => NULL()

              jdisc=0
              jids=-9999
              jpdtn=trkrinfo%g2_jpdtn ! 0 = analysis or forecast; 
                                      ! 1 = ens fcst
              jgdtn=0
              jgdt=-9999
              jpdt=-9999

              npoints=0
              icount=0
              jskp=0

              jpds = -1
              jgds = -1
              j=0

              ! Set defaults for JPDT, then override in array
              ! assignments below...

              JPDT(1:15)=(/-9999,-9999,-9999,-9999,-9999,-9999,-9999
     &           ,-9999,-9999,-9999,-9999,-9999,-9999,-9999,-9999/)

              JPDT(1) = cpsig2_parm_cat(ip)
              JPDT(2) = cpsig2_parm_num(ip)

              if (inp%lt_units == 'minutes') then
                JPDT(8) = 0
                JPDT(9) = iftotalmins(ifh)
              else
                JPDT(8) = 1
                JPDT(9) = ifhours(ifh)
              endif

c              JPDT(10) = cpsig2_lev_typ(ip)
              JPDT(10) = cpsig2_lev_10(ip)
cPENG--------------------------------------------
      if (inp%model == 1 .or. inp%model == 10 .or. inp%model == 7
     &  .or. inp%model == 22 .or. inp%model == 16
     &  .or. inp%model == 15 .or. inp%model == 8) then
              JPDT(11) = cpsig2_lev_11(ip)
              JPDT(12) = cpsig2_lev_12(ip)
      endif              

c              if (JPDT(10) == 100) then   ! isobaric surface
c                JPDT(12) = cpsig2_lev_val(ip) * 100  ! GRIB2 levels 
c                                                     ! are in Pa
c              else
c                if (verb .ge. 3) then
c                  print *,' '
c                  print *,'ERROR in getdata: JPDT(10) array value'
c                  print *,'should only be 100 in this CPS section'
c                  print *,'for GRIB2 data.'
c                endif
c              endif

              if(enable_timing/=0) then
                 call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                ,date_time)
                 write (6,731) date_time(5),date_time(6),date_time(7)
 731             format (1x,'TIMING: before getgb2-2',i2.2,':',i2.2,':'
     &                ,i2.2)
              endif
              call getgb2(lugb,lugi,jskp,jdisc,jids,jpdtn,jpdt,jgdtn
     &                   ,jgdt,unpack,krec,gfld,iret)
              if(enable_timing/=0) then
                 call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                ,date_time)
                 write (6,732) date_time(5),date_time(6),date_time(7)
 732             format (1x,'TIMING: after getgb2-2',i2.2,':',i2.2,':'
     &                ,i2.2)
              endif

              if ( verb .ge. 3 ) then
                print *,'iret from getgb2 (PHASE) in getdata = ',iret
              endif

              if (verb_g2 .ge. 1) then
                print *,'after getgb2 call(PHASE),'
     &                 ,' value of unpacked = ',gfld%unpacked
                print *,'after getgb2 (PHASE) call, gfld%ngrdpts = '
     &                 ,gfld%ngrdpts
                print *,'after getgb2 (PHASE) call, gfld%ibmap = '
     &                 ,gfld%ibmap
              endif

              if (verb .ge. 3) then
                print *,' '
                if (inp%lt_units == 'minutes') then
                  print *,'After getgb2 (PHASE) call, j= ',j
     &                 ,' ifmins= ',iftotalmins(ifh),' parm # (ip) = '
     &                 ,ip,' iret= ',iret
                else
                  print *,'After getgb2 (PHASE) call, j= ',j
     &                 ,' ifhours= ',ifhours(ifh),' parm # (ip) = '
     &                 ,ip,' iret= ',iret
                endif
              endif

              if (iret == 0) then

c               Determine packing information from GRIB2 file.
c               The default packing is 40  JPEG 2000

                ipack = 40

                if (verb_g2 .ge. 1) then
                  print *,' gfld%idrtnum = ', gfld%idrtnum
                endif

                !   Set DRT info  ( packing info )
                if ( gfld%idrtnum.eq.0 ) then      ! Simple packing
                  ipack = 0
                elseif ( gfld%idrtnum.eq.2 ) then  ! Complex packing
                  ipack = 2
                elseif ( gfld%idrtnum.eq.3 ) then  ! Complex & spatial
     &                                             ! packing
                  ipack = 31
                elseif ( gfld%idrtnum.eq.40.or.gfld%idrtnum.eq.15 ) 
     &          then
                  ! JPEG 2000 packing
                  ipack = 40
                elseif ( gfld%idrtnum.eq.41 ) then  ! PNG packing
                  ipack = 41
                endif

                if ( verb_g2 .ge. 1 ) then
                  print *,'After check of idrtnum, ipack= ',ipack
                  print *,'Number of gridpts= gfld%ngrdpts= '
     &                   ,gfld%ngrdpts
                  print *,'Number of elements= gfld%igdtlen= '
     &                   ,gfld%igdtlen
                  print *,'GDT num= gfld%igdtnum= ',gfld%igdtnum
                endif 

                kf = gfld%ngrdpts  ! Number of gridpoints returned 
                                 ! from read

                do np = 1,kf
                  f(np)  = gfld%fld(np)
                  if (gfld%ibmap == 0) then
                    lb(np)  = gfld%bmap(np)
                  else
                    lb(np)  = .true.
                  endif
                enddo

                call bitmapchk(kf,lb,f,dmin,dmax)

c               Convert logical bitmap to 2-d array (only need to do 
c               this once since using same model for all variables).

                if (lbrdflag .eq. 'n') then
                  call conv1d2d_logic (imax,jmax,lb,valid_pt
     &                                           ,need_to_flip_lats)
                  lbrdflag = 'y'
                endif

                firstval=gfld%fld(1)
                lastval=gfld%fld(kf)

                if (verb_g2 .ge. 1) then
                  print *,' '
                  print *,' SECTION 0: discipl= ',gfld%discipline
     &                   ,' gribver= ',gfld%version
                  print *,' '
                  print *,' SECTION 1: '

                  do j = 1,gfld%idsectlen
                    print *,'     sect1, j= ',j,' gfld%idsect(j)= '
     &                     ,gfld%idsect(j)
                  enddo

                  if ( associated(gfld%local).AND.gfld%locallen.gt.0)
     &            then
                    print *,' '
                    print *,' SECTION 2: ',gfld%locallen,' bytes'
                  else
                    print *,' '
                    print *,' SECTION 2 DOES NOT EXIST IN THIS RECORD'
                  endif

                  print *,' '
                  print *,' SECTION 3: griddef= ',gfld%griddef
                  print *,'            ngrdpts= ',gfld%ngrdpts
                  print *,'            numoct_opt= ',gfld%numoct_opt
                  print *,'            interp_opt= ',gfld%interp_opt
                  print *,'            igdtnum= ',gfld%igdtnum
                  print *,'            igdtlen= ',gfld%igdtlen

                  print *,' '
                  print '(a17,i3,a2)',' GRID TEMPLATE 3.'
     &                  ,gfld%igdtnum,': '
                  do j=1,gfld%igdtlen
                    print *,'    j= ',j,' gfld%igdtmpl(j)= '
     &                  ,gfld%igdtmpl(j)
                  enddo

c                 Get parameter abbrev for record that was retrieved
                  print *,' '
                  print *,'     PDT num (gfld%ipdtnum) = '
     &                   ,gfld%ipdtnum
                  print *,' '
                  print '(a20,i3,a2)',' PRODUCT TEMPLATE 4.'
     &                   ,gfld%ipdtnum
     &                 ,': '
                  do j=1,gfld%ipdtlen
                    print *,'    sect 4  j= ',j,' gfld%ipdtmpl(j)= '
     &                     ,gfld%ipdtmpl(j)
                  enddo
                endif

                pdt_4p0_vtime      = gfld%ipdtmpl(9)
                pdt_4p0_vert_level = gfld%ipdtmpl(12)

                pabbrev=param_get_abbrev(gfld%discipline
     &                  ,gfld%ipdtmpl(1),gfld%ipdtmpl(2))

                if (verb .ge. 3) then
                  print *,' '
                  write (6,231)
 231              format (' rec#   param     level  byy  bmm  bdd  '
     &             ,'bhh  '
     &             ,'fhr      npts  firstval    lastval     minval   '
     &             ,'   maxval')
                  print '(i5,3x,a8,2x,6i5,2x,i8,4g12.4)'
     &             ,krec,pabbrev,pdt_4p0_vert_level,gfld%idsect(6)
     &             ,gfld%idsect(7),gfld%idsect(8),gfld%idsect(9)
     &             ,pdt_4p0_vtime,gfld%ngrdpts,firstval,lastval,dmin
     &             ,dmax
cPENG  &             ,krec,pabbrev,pdt_4p0_vert_level/100,gfld%idsect(6)
                endif

c               Convert data to 2-d array

                call conv1d2d_real (imax,jmax,f,cpshgt(1,1,ip)
     &                             ,need_to_flip_lats)

              endif

            enddo grib2_cps_parm_lev_loop

          endif

        endif

      else

        !----------------------------------
        ! Reading from a GRIB v1 file....
        !----------------------------------

        grib1_read_loop: do ip = 1,nreadparms
              
          jpds = -1
          jgds = -1
          j=0     
              
          if (inp%model == 4) then  ! ECMWF hi-res data uses ECMWF table
            print *,' '
            print *,'WARNING: From the namelist, inp%model is set to a'
            print *,'   value of 4, which is for ECMWF, so in routine'
            print *,'   getdata_grib, the input jpds(5,6,7) parms are' 
            print *,'   going to have values that are specific for'
            print *,'   ECMWF GRIB1 data.'
            print *,' '
            jpds(5)  = ec_igparm(ip) 
            jpds(6)  = ec_iglevtyp(ip)
            jpds(7)  = ec_iglev(ip)
          else   ! All other models use NCEP-standard GRIB table
            jpds(5)  = igparm(ip)
            jpds(6)  = iglevtyp(ip) 
            jpds(7)  = iglev(ip)
          endif 

          print *,' '
          print *,' --- Before getgb, jpds(5)= ',jpds(5)
          print *,' ---             , jpds(6)= ',jpds(6)
          print *,' ---             , jpds(7)= ',jpds(7)
                
          if (jpds(5) == 999) then
            cycle 
          endif   

          if (inp%lt_units == 'minutes') then
            jpds(14) = iftotalmins(ifh)
          else
            jpds(14) = ifhours(ifh)
          endif

          if(enable_timing/=0) then
             call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &            ,date_time)
             write (6,831) date_time(5),date_time(6),date_time(7)
 831         format (1x,'TIMING: before getgb-1',i2.2,':',i2.2,':',i2.2)
          endif 

          call getgb (lugb,lugi,jf,j,jpds,jgds,
     &                          kf,k,kpds,kgds,lb,f,iret)

          if (enable_timing /= 0) then
            call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &           ,date_time)
            write (6,832) date_time(5),date_time(6),date_time(7)
 832        format (1x,'TIMING: after getgb-1',i2.2,':',i2.2,':',i2.2)
          endif     

          if ( verb .ge. 3 ) then
            print *,' '
            if (inp%lt_units == 'minutes') then
              print *,'After getgb call, j= ',j,' k= ',k
     &             ,' iftotalmins= '
     &             ,iftotalmins(ifh),' parm # (ip) = ',ip,' iret= ',iret
            else
              print *,'After getgb call, j= ',j,' k= ',k,' ifhours= '
     &             ,ifhours(ifh),' parm # (ip) = ',ip,' iret= ',iret
            endif
          endif

          if (iret == 0) then

            if ( verb .ge. 3 ) then
              print *,'+++ Good Read: getgb found parm: ',chparm(ip)
              print *,'+++       at level = ',jpds(7)
              if (inp%lt_units == 'minutes') then
                print *,'+++       Forecast time = ',iftotalmins(ifh)
     &               ,' minutes'
              else
                print *,'+++       Forecast time = ',ifhours(ifh)
     &                 ,' hours'
              endif
            endif
          
            readflag(ip) = .TRUE.
            call bitmapchk(kf,lb,f,dmin,dmax)

            if ( verb .ge. 3 ) then
              if (inp%lt_units == 'minutes') then
                write (6,29) 
              else
                write (6,31) 
              endif
 29           format (' rec#  parm# levt lev  byy   bmm  bdd  bhh  fmin'
     &             ,'  npts  minval       maxval') 
 31           format (' rec#  parm# levt lev  byy   bmm  bdd  bhh  fhr '
     &             ,'  npts  minval       maxval') 
              print '(i4,2x,8i5,i8,2g12.4)',
     &             k,(kpds(i),i=5,11),kpds(14),kf,dmin,dmax
            endif

c           Convert logical bitmap to 2-d array (only need to do this
c           once since using same model for all variables).

            if (lbrdflag .eq. 'n') then
              call conv1d2d_logic (imax,jmax,lb,valid_pt
     &                                           ,need_to_flip_lats)
              lbrdflag = 'y'
            endif


            select case (chparm(ip))
              case ('absv')
                if (jpds(7) == 850) then
                  call conv1d2d_real (imax,jmax,f,zeta(1,1,1)
     &                                           ,need_to_flip_lats)
                else
                  call conv1d2d_real (imax,jmax,f,zeta(1,1,2)
     &                                           ,need_to_flip_lats)
                endif
              case ('ugrid')
                if (jpds(7) == 850) then
                  call conv1d2d_real (imax,jmax,f,u(1,1,1)
     &                                           ,need_to_flip_lats)
                else if (jpds(7) == 700) then
                  call conv1d2d_real (imax,jmax,f,u(1,1,2)
     &                                           ,need_to_flip_lats)
                else if (jpds(7) == 500) then
                  call conv1d2d_real (imax,jmax,f,u(1,1,3)
     &                                           ,need_to_flip_lats)
                else
                  ! Near-surface data
                  call conv1d2d_real (imax,jmax,f,u(1,1,4)
     &                                           ,need_to_flip_lats)
                endif
              case ('vgrid')
                if (jpds(7) == 850) then
                  call conv1d2d_real (imax,jmax,f,v(1,1,1)
     &                                           ,need_to_flip_lats)
                else if (jpds(7) == 700) then
                  call conv1d2d_real (imax,jmax,f,v(1,1,2)
     &                                           ,need_to_flip_lats)
                else if (jpds(7) == 500) then
                  call conv1d2d_real (imax,jmax,f,v(1,1,3)
     &                                           ,need_to_flip_lats)
                else
                  ! Near-surface data
                  call conv1d2d_real (imax,jmax,f,v(1,1,4)
     &                                           ,need_to_flip_lats)
                endif
              case ('gphgt')
                if (jpds(7) == 850) then
                  call conv1d2d_real (imax,jmax,f,hgt(1,1,1)
     &                                           ,need_to_flip_lats)
                else if (jpds(7) == 700) then
                  call conv1d2d_real (imax,jmax,f,hgt(1,1,2)
     &                                           ,need_to_flip_lats)
                else if (jpds(7) == 500) then
                  call conv1d2d_real (imax,jmax,f,hgt(1,1,3)
     &                                           ,need_to_flip_lats)
                else if (jpds(7) == 200) then
                  call conv1d2d_real (imax,jmax,f,hgt(1,1,4)
     &                                           ,need_to_flip_lats)
                endif
              case ('mslp')
                call conv1d2d_real (imax,jmax,f,slp
     &                                           ,need_to_flip_lats)
              case ('temp')
                call conv1d2d_real (imax,jmax,f,tmean
     &                                           ,need_to_flip_lats)
              case ('lmask')
                call conv1d2d_real (imax,jmax,f,lsmask
     &                                           ,need_to_flip_lats)
              case default

              if ( verb .ge. 1 ) then
                print *,'!!! ERROR: BAD CHPARM IN GETDATA = ',chparm(ip)
              endif

            end select

          else

            if ( verb .ge. 3 ) then
              print *,'!!! NOTE: getgb could not find parm: ',chparm(ip)
              print *,'!!!       at level = ',jpds(7)
              if (inp%lt_units == 'minutes') then
                print *,'!!!       Forecast time = ',iftotalmins(ifh)
     &               ,' minutes'
              else
                print *,'!!!       Forecast time = ',ifhours(ifh)
     &                 ,' hours'
              endif
            endif

          endif

        enddo grib1_read_loop

c       *------------------------------------------------------------*
c        If we are attempting to determine the cyclone structure,
c        then read in data now that will allow us to do that.
c       *------------------------------------------------------------*

        if (phaseflag == 'y') then

          if (phasescheme == 'cps' .or. phasescheme == 'both') then

            ! Read in GP Height levels for cyclone phase space...

            cps_grib1_lev_loop: do ip = 1,nlevs_cps

              jpds = -1
              jgds = -1
              j=0

              if (inp%model == 4) then
                ! Use different grib parm id for ECMWF GP height
                jpds(5)  = ec_cpsgparm(ip)
              else
                jpds(5)  = cpsgparm(ip)
              endif
              jpds(6)  = cpsglevtyp(ip)
              jpds(7)  = cpsglev(ip)

              if (inp%lt_units == 'minutes') then
                jpds(14) = iftotalmins(ifh)
              else    
                jpds(14) = ifhours(ifh)
              endif

              if(enable_timing/=0) then
                 call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                ,date_time)
                 write (6,841) date_time(5),date_time(6),date_time(7)
 841             format (1x,'TIMING: before getgb-2',i2.2,':',i2.2
     &                ,':',i2.2)
              endif
              call getgb (lugb,lugi,jf,j,jpds,jgds,
     &                         kf,k,kpds,kgds,lb,f,iret)
              if(enable_timing/=0) then
                 call date_and_time (big_ben(1),big_ben(2),big_ben(3)
     &                ,date_time)
                 write (6,842) date_time(5),date_time(6),date_time(7)
 842             format (1x,'TIMING: after getgb-2',i2.2,':',i2.2
     &                ,':',i2.2)
              endif

              if ( verb .ge. 3 ) then
                print *,' '
                if (inp%lt_units == 'minutes') then
                  print *,'After getgb (PHASE) call, j= ',j,' k= ',k
     &                 ,' ifmins= ',iftotalmins(ifh),' parm # (ip) = '
     &                 ,ip,' iret= ',iret
                else
                  print *,'After getgb (PHASE) call, j= ',j,' k= ',k
     &                 ,' ifhours= ',ifhours(ifh),' parm # (ip) = '
     &                 ,ip,' iret= ',iret
                endif
              endif

              if (iret == 0) then

                call bitmapchk(kf,lb,f,dmin,dmax)

                if ( verb .ge. 3 ) then
                  if (inp%lt_units == 'minutes') then    
                    write (6,39)
                  else  
                    write (6,41)
                  endif
 39               format (' rec#  parm# levt lev  byy   bmm  bdd  bhh  '
     &                 ,'fmin   npts  minval       maxval')
 41               format (' rec#  parm# levt lev  byy   bmm  bdd  bhh  '
     &                 ,'fhr   npts  minval       maxval')
                  print '(i4,2x,8i5,i8,2g12.4)',
     &                 k,(kpds(i),i=5,11),kpds(14),kf,dmin,dmax
                endif
                
c               Convert data to 2-d array

                call conv1d2d_real (imax,jmax,f,cpshgt(1,1,ip)
     &                             ,need_to_flip_lats)

              endif

            enddo cps_grib1_lev_loop

          endif

        endif

      endif
c
      deallocate (f)
      deallocate (lb)
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine getdata_netcdf (ncfile_id,readflag,valid_pt,imax,jmax
     &                  ,ifh,need_to_flip_lats,need_to_flip_lons
     &                  ,ncfile_tmax,netcdfinfo)
c
c     ABSTRACT: This subroutine reads the input NetCDF file for the 
c     tracked parameters for one lead time.
c
c     There are up to 9 fields that are read in that will be used to
c     locate the storm position.  There are an additional 4 variables
c     (500 mb u- and v-components and 10 m u- and v- components) that
c     will not be used for tracking, but only for helping to estimate
c     the next first guess position (500 mb winds) and for estimating
c     the max near-surface wind speeds in the vicinity of the storm
c     (10 m winds).
c
c     Fields read in are listed here.  Numbers indicate positioning in
c     the readflag logical array:
c
c     1.   850 mb absolute vorticity
c     2.   700 mb absolute vorticity
c     3.   850 mb u-component
c     4.   850 mb v-component
c     5.   700 mb u-component
c     6.   700 mb v-component
c     7.   850 mb geopotential height
c     8.   700 mb geopotential height
c     9.   MSLP
c     10.  10-m u-component
c     11.  10-m v-component
c     12.  500 mb u-component
c     13.  500 mb v-component
c     14.  300-500 mb mean temperature
c     15.  500 mb geopotential height
c     16.  200 mb geopotential height
c     17.  Land-Sea mask -- This is for tcgen applications only, and 
c               even there, it's optional.
c
c     If the user has requested to check the cyclone phase space for
c     this run (phaseflag set to 'y' and phasescheme set to 'cps'), 
c     then we need to have gp height data for 900-300 mb at every 50
c     mb.  Some of those levels for gp height data were already read
c     in with the read of the initial 17 parameters, but we will be
c     sure to read in the others, if requested.
c
c     INPUT:
c     ncfile_id   integer ID associated with the NetCDF file
c     imax        integer number of pts in i-direction on grid
c     jmax        integer number of pts in j-direction on grid
c     ifh         integer index for forecast hour
c     need_to_flip_lats logical flag read in from getgridinfo that
c                 indicates if data needs flipped north to south
c     need_to_flip_lons logical flag read in from getgridinfo that
c                 indicates if data needs flipped east to west
c     ncfile_tmax integer with max number of time levels in the input
c                 NetCDF file, as read in from the NetCDF file
c                 itself in subroutine  read_netcdf_fhours.
c
c     OUTPUT:
c     readflag    logical array, indicates if a parm was read in
c     valid_pt    logical array, indicates for each (i,j) if there is
c                 valid data at the point (used for regional grids)

      USE tracked_parms; USE level_parms; USE inparms; USE phase
      USE netcdf_parms; USE verbose_output

      implicit none
c
      type (netcdfstuff) netcdfinfo
      integer, parameter :: nreadparms=17,nreadparms_cps=13
      real, allocatable :: f(:)
      real :: dmin,dmax,xmissing_value,xfill_value
      logical(1) valid_pt(imax,jmax),readflag(nreadparms)
      logical(1) ::  need_to_flip_lats,need_to_flip_lons
      character*1  :: lbrdflag,match_check
      character*30 :: chparm(nreadparms)
      character*30 :: chparm_cps(nreadparms_cps)
      integer, intent(in) :: ncfile_id,imax,jmax
      integer :: igvret,ifa,ip,ifh,i,j,k,m,n,ncfile_tmax,nf_get_att_real
      integer :: nf_get_att_double,nf_inq_attlen,imvlen,ifvlen
      integer :: usertime,ncix,missing_val_length,nf_status
      integer :: nf_inq_varid,varid
c
      lbrdflag = 'n'

cnc      data cpsgparm   /13*7/
cnc      data cpsglevtyp /13*100/
cnc      data cpsglev    /900,850,800,750,700,650,600,550,500,450,400
cnc     &                ,350,300/

c      data chparm   /'vort850','vort700'
c     &              ,'u850','v850','u700','v700'
c     &              ,'h850','h700','slp','u_ref','v_ref'
c     &              ,'u500','v500','tm'/

c     Load the names of the NetCDF variables for the standard 
c     variables into the chparm array...

      chparm(1)  = netcdfinfo%rv850name
      chparm(2)  = netcdfinfo%rv700name
      chparm(3)  = netcdfinfo%u850name
      chparm(4)  = netcdfinfo%v850name
      chparm(5)  = netcdfinfo%u700name
      chparm(6)  = netcdfinfo%v700name
      chparm(7)  = netcdfinfo%z850name
      chparm(8)  = netcdfinfo%z700name
      chparm(9)  = netcdfinfo%mslpname
      chparm(10) = netcdfinfo%usfcname
      chparm(11) = netcdfinfo%vsfcname
      chparm(12) = netcdfinfo%u500name
      chparm(13) = netcdfinfo%v500name
      chparm(14) = netcdfinfo%tmean_300_500_name
      chparm(15) = netcdfinfo%z500name
      chparm(16) = netcdfinfo%z200name
      chparm(17) = netcdfinfo%lmaskname
 
      
      if (verb .ge. 3) then
        print *,' '
        print *,'NOTE: Program is now in subroutine  getdata_netcdf.'
      endif

      if (allocated(f)) deallocate(f)
      allocate (f(imax*jmax),stat=ifa)
      if (ifa /= 0) then
        print *,' '
        print *,'!!! ERROR in getdata_netcdf allocating f data array.'
        print *,'!!! ifa = ',ifa
        print *,'!!! STOPPING EXECUTION'
        STOP 91
      endif

      !---------------------------------------------------------------
      ! First go through the list of user-requested lead times that 
      ! were read in from subroutine  read_fhours and try to match up
      ! the lead times that were read in with the lead times that 
      ! we read in directly from the NetCDF file.  Get the index from
      ! the NetCDF file for that lead time and use that in the call to
      ! the read routine (get_var3_tlev_double).
      !---------------------------------------------------------------

      usertime = iftotalmins(ifh)

      match_check = 'n'

      find_index_loop: do m = 1,ncfile_tmax

        if (usertime == nctotalmins(m)) then
          ncix = m
          if (verb .ge. 1) then
            print *,'+++ Time match in getdata_netcdf for usertime= '
     &             ,usertime,'  netcdf file index= ncix= ',ncix
          endif
          match_check = 'y'
          exit find_index_loop
        endif

      enddo find_index_loop

      if (match_check == 'n') then
        print *,' '
        print *,'!!! ERROR in getdata_netcdf: '
        print *,'  For a NetCDF file, the user has '
        print *,'  requested to process a lead time, and that lead'
        print *,'  time does not exist in the NetCDF list of time'
        print *,'  values. '
        print *,'  ifh= ',ifh
        print *,'  usertime= iftotalmins(ifh)= ',iftotalmins(ifh)
        print *,'  STOPPING....'
        stop 99
      endif

      !---------------------------------------------------------------
      ! Now go through the read loop for the list of parameters
      !---------------------------------------------------------------

      netcdf_standard_parm_read_loop: do ip = 1,nreadparms

        if (chparm(ip) == 'X' .or. chparm(ip) == 'x') then
          if (verb .ge. 3) then
            print *,' '
            print *,'!!! NetCDF read NOT requested for parm # ',ip
          endif
          cycle netcdf_standard_parm_read_loop
        else
          if (verb .ge. 3) then
            print *,' '
            print *,'+++ NetCDF read requested for parm # ',ip
     &             ,' ... parm= ',chparm(ip)
          endif
        endif

        ! Note that I am sending a 1-d array, "f", to the netcdf read
        ! routine.   While that routine returns a 2-d array (which we 
        ! want), depending on the model & grid, we may need to flip the
        ! grid in the north-south direction.  I already have a routine
        ! for converting data from a 1-d to a 2-d array, and it has 
        ! the functionality for flipping a grid, so I programmed it as
        ! getting a 1-d array from the netcdf read routine and send that
        ! 1-d array to conv1d2d_real.

        call get_var3_tlev_double (ncfile_id,chparm(ip),imax,jmax,ncix
     &                  ,f,igvret)

        if (verb .ge. 3) then
          print *,' '
          print *,'After read, parm= ',chparm(ip),' ifh= ',ifh
     &           ,' lead time index= ',ltix(ifh),' parm# (ip) = ',ip
     &           ,' ncix= ',ncix,' igvret= ',igvret
        endif

        if (igvret == 0) then

c          call bitmapchk(kf,lb,f,dmin,dmax)

          readflag(ip) = .TRUE.
          dmin = minval(f)
          dmax = maxval(f)

          ! Need to get the value of the "missing_value" attribute for
          ! this variable from the list of attributes in the NetCDF
          ! file.  Only do this for the first lead time, since the 
          ! value of the "missing_value" obviously will not change 
          ! with lead time.

c          nf_status = nf_inq_attlen (ncfile_id,varid,"missing_value"
c     &               ,imvlen)
c          nf_status = nf_inq_attlen (ncfile_id,varid,"_FillValue"
c     &               ,ifvlen)

          ! These next two nf function calls retrieve the value of the
          ! "missing_value" attribute from the list of attributes for 
          ! the given variable being read in.  This is needed in order
          ! to know if a non-valid point is being accessed, as for a 
          ! regional grid, like the nested fvGFS.  In GRIB1/GRIB2 files,
          ! such regions would be bitmapped out, but in a NetCDF file,
          ! no such bitmap exists, so we have to check for missing 
          ! values.  In case it's a moving grid, we need to do this 
          ! for every lead time, since the "map of missing values" 
          ! will shift with lead time.  Once we have those missing
          ! values, we can loop through them and fill the valid_pt
          ! logical array so that, in the end, we will have the same
          ! logical bitmap for masking out missing data that we have
          ! with GRIB1/GRIB2 data.

          nf_status = nf_inq_varid (ncfile_id,chparm(ip),varid)

          print *,'nf_status from nf_inq_varid call = ',nf_status

          nf_status = nf_get_att_real (ncfile_id,varid,"missing_value"
     &               ,xmissing_value)

          print *,'nf_status from nf_get_att_real call = ',nf_status

c          nf_status = nf_get_att_real (ncfile_id,varid,"_FillValue"
c     &               ,xfill_value)
c          nf_status = nf90_inquire_attribute (ncfile_id,chparm(ip)
c     &               ,"missing_value",len=imvlen)
c          nf_status = nf90_inquire_attribute (ncfile_id,chparm(ip)
c     &               ,"_FillValue",len=ifvlen)
c
c          nf_status = nf90_get_att (ncfile_id,chparm(ip)
c     &               ,"missing_value",xmissing_value)
c          nf_status = nf90_get_att (ncfile_id,chparm(ip)
c     &               ,"_FillValue",xfill_value)

          if (verb .ge. 3) then
            write (6,31)
  31        format ('parmread lead time     parm#        parm_id   '
     &             ,23x,'minval       maxval')

            write (6,33) ifhours(ifh),ifclockmins(ifh),ip,chparm(ip)
     &                ,dmin,dmax
  33        format ('   ',i3,':',i2.2,14x,i3,10x,a30,1x,2g12.4)
            write (6,35) chparm(ip),xmissing_value
  35        format ('   --- ',a30,' missing value = ',g12.4)
          endif

          ! This call to conv1d2d_logic_netcdf creates
          ! a logical bitmap, so that in case we have 
          ! regional (non-global) data and an irregular grid (e.g., 
          ! the FV3 nested grid), we can mask out grid points that 
          ! have missing values as their data values.  There is not
          ! actually a native logical bitmap in NetCDF, so we will
          ! create one by examining the real data values and masking
          ! out grid points that have missing values.

          if (lbrdflag .eq. 'n') then
            call conv1d2d_logic_netcdf (imax,jmax,f,valid_pt
     &                    ,xmissing_value,need_to_flip_lats)
            lbrdflag = 'y'
          endif

          if (ip == 1) then         ! 850 mb absolute vorticity
            call conv1d2d_real (imax,jmax,f,zeta(1,1,1)
     &                                     ,need_to_flip_lats)
          else if (ip == 2) then    ! 700 mb absolute vorticity
            call conv1d2d_real (imax,jmax,f,zeta(1,1,2)
     &                                     ,need_to_flip_lats)
          else if (ip == 3) then    ! 850 mb u-comp
            call conv1d2d_real (imax,jmax,f,u(1,1,1)
     &                                     ,need_to_flip_lats)
          else if (ip == 4) then    ! 850 mb v-comp
            call conv1d2d_real (imax,jmax,f,v(1,1,1)
     &                                     ,need_to_flip_lats)
          else if (ip == 5) then    ! 700 mb u-comp
            call conv1d2d_real (imax,jmax,f,u(1,1,2)
     &                                     ,need_to_flip_lats)
          else if (ip == 6) then    ! 700 mb v-comp
            call conv1d2d_real (imax,jmax,f,v(1,1,2)
     &                                     ,need_to_flip_lats)
          else if (ip == 7) then    ! 850 mb gp height
            call conv1d2d_real (imax,jmax,f,hgt(1,1,1)
     &                                     ,need_to_flip_lats)
          else if (ip == 8) then    ! 700 mb gp height
            call conv1d2d_real (imax,jmax,f,hgt(1,1,2)
     &                                     ,need_to_flip_lats)
          else if (ip == 9) then    ! MSLP
            call conv1d2d_real (imax,jmax,f,slp
     &                                     ,need_to_flip_lats)
          else if (ip == 10) then   ! Near-sfc (10m) u-comp
            call conv1d2d_real (imax,jmax,f,u(1,1,4)
     &                                     ,need_to_flip_lats)
          else if (ip == 11) then   ! Near-sfc (10m) v-comp
            call conv1d2d_real (imax,jmax,f,v(1,1,4)
     &                                     ,need_to_flip_lats)
          else if (ip == 12) then   ! 500 mb u-comp
            call conv1d2d_real (imax,jmax,f,u(1,1,3)
     &                                     ,need_to_flip_lats)
          else if (ip == 13) then   ! 500 mb v-comp
            call conv1d2d_real (imax,jmax,f,v(1,1,3)
     &                                     ,need_to_flip_lats)
          else if (ip == 14) then   ! 300-500 mb mean Temp
            call conv1d2d_real (imax,jmax,f,tmean
     &                                     ,need_to_flip_lats)
          else if (ip == 15) then   ! 500 mb height
            call conv1d2d_real (imax,jmax,f,hgt(1,1,3)
     &                                     ,need_to_flip_lats)
          else if (ip == 16) then   ! 200 mb height
            call conv1d2d_real (imax,jmax,f,hgt(1,1,4)
     &                                     ,need_to_flip_lats)
          else if (ip == 17) then   ! Land-sea mask
            call conv1d2d_real (imax,jmax,f,lsmask
     &                                     ,need_to_flip_lats)
          else

            print *,'!!! NOTE: Parm not recognized. '
            print *,'!!!       ip is > 17.... ip= ',ip
            print *,'!!!       Forecast time level = ',ifh

          endif

        endif

      enddo netcdf_standard_parm_read_loop

c     *--------------------------------------------------------------*
c      If we are attempting to determine the cyclone structure using
c      Hart's cyclone phase space, then read in data now that will 
c      allow us to do that.  If we are instead just using the 
c      mid-level (300-500 mb) mean temperature to do that with a 
c      simple warm-core check, then that mean temperature field was
c      already read in above in the read loop for the standard 
c      variables.  The variables needed here for CPS are pretty 
c      straightforward:  gp height every 50 mb from 300 to 900 mb.
c      keep in mind that we have already read in a few of these 
c      gp height records for selected levels above.
c     *--------------------------------------------------------------*

      if (phaseflag == 'y') then

        if (phasescheme == 'cps' .or. phasescheme == 'both') then

          chparm_cps(1)  = netcdfinfo%z900name
          chparm_cps(2)  = netcdfinfo%z850name
          chparm_cps(3)  = netcdfinfo%z800name
          chparm_cps(4)  = netcdfinfo%z750name
          chparm_cps(5)  = netcdfinfo%z700name
          chparm_cps(6)  = netcdfinfo%z650name
          chparm_cps(7)  = netcdfinfo%z600name
          chparm_cps(8)  = netcdfinfo%z550name
          chparm_cps(9)  = netcdfinfo%z500name
          chparm_cps(10) = netcdfinfo%z450name
          chparm_cps(11) = netcdfinfo%z400name
          chparm_cps(12) = netcdfinfo%z350name
          chparm_cps(13) = netcdfinfo%z300name

          ! Read in GP Height levels for cyclone phase space...

          if (verb .ge. 3) then
            print *,' '
            print *,'--- Reads for CPS parms follow...'
            print *,' '
          endif

          netcdf_cps_parm_read_loop: do ip = 1,nreadparms_cps

            if (chparm_cps(ip) == 'X' .or. chparm_cps(ip) == 'x') then
              if (verb .ge. 3) then
                print *,'!!! ERROR: NetCDF read NOT requested for'
                print *,'!!! CPS parm # ',ip
                print *,'!!! You must have an error in your namelist.'
                print *,'!!! You have requested to do cyclone phase'
                print *,'!!! checking, so you need to include the '
                print *,'!!! NetCDF names for ALL requested gp height'
                print *,'!!! variables from 900 to 300 mb, every 50 '
                print *,'!!! mb,in the namelist.'
                print *,'!!! phaseflag is being set to NO (n), and '
                print *,'!!! phase-checking will NOT take place.'
                print *,'!!! If you want to run again and just do '
                print *,'!!! phase-checking with a simple warm-core'
                print *,'!!! check, then in the namelist set phaseflag'
                print *,'!!! to y and set phasescheme to vtt.'
                phaseflag = 'n'
              endif
              exit netcdf_cps_parm_read_loop
            else
              if (verb .ge. 3) then
                print *,'+++ NetCDF read requested for cps parm # ',ip
     &                 ,' ... parm= ',chparm_cps(ip)
              endif
            endif

            ! As above, we send a 1-d array, "f", to the netcdf read
            ! routine.   While that routine returns a 2-d array (which 
            ! we want), depending on the model & grid, we may need to 
            ! flip the grid in the north-south direction.  I already 
            ! have a routine for converting data from a 1-d to a 2-d 
            ! array, and it has the functionality for flipping a grid, 
            ! so I programmed it as getting a 1-d array from the netcdf
            ! read routine and send that 1-d array to conv1d2d_real.

            call get_var3_tlev_double (ncfile_id,chparm_cps(ip),imax
     &                  ,jmax,ncix,f,igvret)

            if (verb .ge. 3) then
              print *,' '
              print *,'After read, parm= ',chparm_cps(ip),' ifh= ',ifh
     &               ,' lead time index= ',ltix(ifh),' parm# (ip) = ',ip
     &               ,' ncix= ',ncix,' igvret= ',igvret
            endif

            if (igvret == 0) then

c              call bitmapchk(kf,lb,f,dmin,dmax)

              readflag(ip) = .TRUE.
              dmin = minval(f)
              dmax = maxval(f)

c              nf_status = nf_get_att_double (ncfile_id,chparm(ip)
c     &                   ,"missing_value",xmissing_value)
c              nf_status = nf_get_att_double (ncfile_id,chparm(ip)
c     &                   ,"_FillValue",xfill_value)

               nf_status = nf_inq_varid (ncfile_id,chparm_cps(ip),varid)
               nf_status = nf_get_att_real (ncfile_id,varid
     &                    ,"missing_value",xmissing_value)

              if (verb .ge. 3) then
                write (6,231)
 231            format ('parmread lead time     parm#        parm_id   '
     &                 ,23x,'minval       maxval')

                write (6,233) ifhours(ifh),ifclockmins(ifh),ip
     &                       ,chparm_cps(ip),dmin,dmax
 233            format ('   ',i3,':',i2.2,14x,i3,10x,a30,1x,2g12.4)
                write (6,235) chparm_cps(ip),xmissing_value
 235            format ('   --- ',a30,' missing value = ',g12.4)
              endif

              call conv1d2d_real (imax,jmax,f,cpshgt(1,1,ip)
     &                           ,need_to_flip_lats)
 
            endif
                 
          enddo netcdf_cps_parm_read_loop
      
        endif
      
      endif

      return
      end

c
c------------------------------------------------------------------
c
c------------------------------------------------------------------
      subroutine get_ncdim1 (ncid,var1_name,nmax)
c
c     ABSTRACT: This routine queries a netcdf file to get the
c     value of a requested file dimension (e.g., imax, jmax)
c
      implicit none

      include "netcdf.inc"

      integer,       intent(in)  :: ncid
      character*(*), intent(in)  :: var1_name
      integer,       intent(out) :: nmax
      integer                    :: status, var1id

      status = nf_inq_dimid (ncid,var1_name,var1id)
      if (status .ne. NF_NOERR) call handle_netcdf_err(status)

      status = nf_inq_dimlen (ncid,var1id,nmax)
      if (status .ne. NF_NOERR) call handle_netcdf_err(status)

      end subroutine get_ncdim1
c
c------------------------------------------------------------------
c       
c------------------------------------------------------------------
      subroutine get_var1_double (ncid,var1_name,nmax,var1)
c
c     ABSTRACT: This routine reads a netcdf file in order to return
c     a 1-dimensional array of data.

      implicit         none

      include "netcdf.inc"

      integer, intent(in):: ncid
      character*(*), intent(in)::  var1_name
      integer, intent(in):: nmax
      real, intent(out):: var1(nmax)

      integer ::  status, var1id

      status = nf_inq_varid (ncid,var1_name,var1id)
      if (status .ne. NF_NOERR) call handle_netcdf_err(status)
!     write(*,*) 'Got var1id', var1id

      status = nf_get_var_real (ncid,var1id,var1)
      if (status .ne. NF_NOERR) call handle_netcdf_err(status)

      end subroutine get_var1_double
c
c---------------------------------------------------------
c         
c---------------------------------------------------------
      subroutine get_var3_tlev_double (ncid,var3_name,imax,jmax,ncix
     &                         ,var3,igvret)
c
c     ABSTRACT: This routine reads a netcdf file and returns a 
c     2-dimensional synoptic variable at a particular lead time.
c     The lead time is specified by the ltix array, which is 
c     included in module tracked_parms and defined in subroutine 
c     read_fhours.
c
c     PARAMETERS
c
c     INPUT:
c     ncid   integer that contains the NetCDF file ID
c     var3_name  character name of NetCDF input file
c     imax   integer x-dimension of input data
c     jmax   integer y-dimension of input data
c     ncix   integer index of time level for where this time level 
c            actually is inside the NetCDF data.  Do NOT confuse this 
c            with the index of where this forecast hour is in the 
c            user's list of input forecast hours, as they may be
c            different.  For example, the user may request times that
c            are every 6 hours, but the NetCDF file might have times
c            that are every hour, so the indices for those two arrays
c            will be different.  Be sure to use the one (ncix) that 
c            indicates where the data actually starts in the 
c            NetCDF file.
c
c     OUTPUT:
c     var3   real array with real values returned from NetCDF read
c     igvret integer return code from this routine

      USE tracked_parms; USE verbose_output; USE netcdf_parms

      implicit         none

      include "netcdf.inc"
c
      integer, intent(in)       :: ncid,ncix
      character*(*), intent(in) :: var3_name
      integer, intent(in)       :: imax,jmax
      real, intent(out)         :: var3(imax,jmax)
      integer :: istart(3),ilength(3)
      integer :: status,var3id,igvret

      if (verb .ge. 3) then
        print *,' '
        print *,'In get_var3_tlev_double, ncix=  ',ncix
        print *,' nctotalmins(ncix)= ',nctotalmins(ncix)
      endif

      istart(1) = 1
      istart(2) = 1
      istart(3) = ncix

      ilength(1) = imax
      ilength(2) = jmax
      ilength(3) = 1

      igvret = 0

      status = nf_inq_varid (ncid,var3_name,var3id)

      if (status /= NF_NOERR) then
        print *,' '
        print *,'NOTE: Could not find variable ',var3_name,' at time'
     &         ,' index ncix= ',ncix
     &         ,' nctotalmins(ncix)= ',nctotalmins(ncix)

        igvret = 92
        return
      endif

      status = nf_get_vara_real (ncid,var3id,istart,ilength,var3)
      if (status .ne. NF_NOERR) call handle_netcdf_err(status)

      end subroutine get_var3_tlev_double
c
c----------------------------------------------------------------------
c
c----------------------------------------------------------------------
      subroutine handle_netcdf_err (status)
c
c     ABSTRACT: This subroutine is an error handling routine for NetCDF-
c     related functions.

      implicit         none

      include          "netcdf.inc"

      integer          status
c
      if (status /= nf_noerr) then
        print *,' '
        print *,'Tracker NetCDF error: '
        print *, nf_strerror(status)
        stop 'Stopped'
      endif

      end subroutine handle_netcdf_err
c
c-------------------------------------------------------------------
c                                                   
c-------------------------------------------------------------------
      subroutine bitmapchk (n,ld,d,dmin,dmax)
c
c     This subroutine checks the bitmap for non-existent data values.
c     Since the data from the regional models have been interpolated
c     from either a polar stereographic or lambert conformal grid
c     onto a lat/lon grid, there will be some gridpoints around the
c     edges of this lat/lon grid that have no data; these grid 
c     points have been bitmapped out by Mark Iredell's interpolater.
c     To provide another means of checking for invalid data points
c     later in the program, set these bitmapped data values to a 
c     value of -999.0.  The min and max of this array are also 
c     returned if a user wants to check for reasonable values.
c
      logical(1) ld
      dimension  ld(n),d(n)
c
      dmin=1.E15
      dmax=-1.E15
c
      do i=1,n
        if (ld(i)) then
          dmin=min(dmin,d(i))
          dmax=max(dmax,d(i))
        else
          d(i) = -999.0
        endif
      enddo
c
      return
      end
c
c------------------------------------------------------------------
c
c------------------------------------------------------------------
      subroutine conv1d2d_logic (imax,jmax,lb1d,lb2d,need_to_flip_lats)
c
c     ABSTRACT: This subroutine converts a 1-dimensional input 
c     array of logical data (lb1d) into a 2-dimensional output
c     array (dimension imax,jmax) of logical data (lb2d).
c
c     This subroutine was updated in 6/2000 to add the scanning mode
c     flag (iscanflag) as an input.  This is in order to handle grids
c     that are flipped.  Most grids -- NCEP, UKMET, ECMWF -- have
c     point (1,1) as the uppermost left point on the grid, and the
c     data goes from north to south.  Some grids -- GFDL and the new
c     NAVGEM grid -- are flipped; their point (1,1) is the lowermost
c     left point, and their data goes from south to north.  So if
c     the scanning mode flag indicates northward scanning data
c     (bit 2 in the flag is turned on), we catch it in this
c     subroutine and flip the data ourselves for our own arrays,
c     since this whole program is structured around the data going
c     from north to south.  As of the writing of this, only the
c     first 3 bits of the scanning flag are used, which is why we
c     can use the mod statement in the code below.
c
c     UPDATE 8/2009: I removed the scanning mode flag, since that is
c     GRIB-specific.  The north-south determination is now handled with
c     the logical flag need_to_flip_lats.
c
c     PARAMETERS:
c
c     INPUT:
c     imax     Number of gridpoints in i direction in input box
c     jmax     Number of gridpoints in j direction in input box
c     lb1d     1-d array containing logical bitmap values
c     iscanflag This is kgds(11), an integer value in the GDS,
c              which holds the scanning mode for the data values
c
c     OUTPUT:
c     lb2d     2-d array containing logical bitmap values
c
      logical(1) lb1d(imax*jmax),lb2d(imax,jmax)
      logical(1) :: need_to_flip_lats
      integer :: ilat,ilatix,ilon,imax,jmax
c
      if (need_to_flip_lats) then

        ! Input data is south to north; flip the data while
        ! converting to 2-d grid....

        do ilat=1,jmax
          ilatix = jmax - ilat + 1
          do ilon=1,imax
            lb2d(ilon,ilatix) = lb1d(ilon+(ilat-1)*imax)
          enddo
        enddo

      else

        ! Input data is north to south.  Just convert the
        ! data onto a 2-d grid, do not flip it....

        do ilat=1,jmax
          do ilon=1,imax
            lb2d(ilon,ilat) = lb1d(ilon+(ilat-1)*imax)
          enddo
        enddo

      endif
c
      return
      end

c
c------------------------------------------------------------------
c
c------------------------------------------------------------------
      subroutine conv1d2d_logic_netcdf (imax,jmax,dat1d,lb2d
     &                               ,xmissing_val,need_to_flip_lats)
c
c     ABSTRACT: The purpose of this routine is to create a 2-d logical
c     bitmap to be used for masking out regions with missing data, 
c     such as for a regional grid with irregular boundaries (such as 
c     we've seen for the regional / nested FV3).  This bitmap will 
c     have the same functionality as a GRIB1/GRIB2 bitmap.  The trick
c     is that NetCDF does not have a logical bitmap within its 
c     definition, so we need to make one.  We do this by reading in 
c     the "missing_value" attribute for any variable, then here we 
c     scan through all the data values retrieved from the NetCDF read,
c     and then for all grid points with missing values we set the 
c     valid_pt flag to .false.
c
c     Note the use of the need_to_flip_lats flag.  This is in order to 
c     handle grids that are flipped.  Most grids -- NCEP, UKMET, ECMWF
c     -- have point (1,1) as the uppermost left point on the grid, and
c     the data goes from north to south.  Some grids -- GFDL and the 
c     new NAVGEM grid -- are flipped; their point (1,1) is the lowermost
c     left point, and their data goes from south to north.  So if
c     the need_to_flip_lats flag was set to TRUE in getgridinfo, meaning
c     that we have northward scanning data, we catch it in this
c     subroutine and flip the data ourselves for our own arrays,
c     since this whole program is structured around the data going
c     from north to south.
c
c     PARAMETERS:
c
c     INPUT:
c     imax     Number of gridpoints in i direction in input box
c     jmax     Number of gridpoints in j direction in input box
c     dat1d    1-d array containing floating point data values
c     xmissing_val real value of missing value for the given variable
c                  that was read in for the calling routine
c     need_to_flip_lats  logical flag, set in getgridinfo, that
c              indicates if data is correctly N-to-S, or if it is
c              S-to-N and needs to be flipped.
c
c     OUTPUT:
c     lb2d     2-d array containing logical bitmap values
c
      USE verbose_output

      implicit none

      logical(1) lb2d(imax,jmax)
      logical(1) need_to_flip_lats
      integer    ilat,ilatix,ilon,imax,jmax,tct,fct,mct
      real       dat1d(imax*jmax)
      real       xmissing_val
c
      tct = 0
      fct = 0
      mct = 0

      if (verb >= 3) then
        print *,' '
        print *,'TOP of conv1d2d_logic_netcdf, xmissing_val= '
     &         ,xmissing_val
        print *,' '
      endif
c
      if (need_to_flip_lats) then

        ! Input data is south to north; flip the data while
        ! converting to 2-d grid....

        do ilat=1,jmax
          ilatix = jmax - ilat + 1
          do ilon=1,imax
            if (dat1d(ilon+(ilat-1)*imax) == xmissing_val) then
              lb2d(ilon,ilatix) = .false.
c              print *,'LBSF FLIP: ilon= ',ilon,' ilatix= ',ilatix
c              fct = fct + 1
            else
              lb2d(ilon,ilatix) = .true.
c              tct = tct + 1
            endif
          enddo
        enddo

      else

        ! Input data is north to south.  Just convert the
        ! data onto a 2-d grid, do not flip it....

        do ilat=1,jmax
          do ilon=1,imax
            if (dat1d(ilon+(ilat-1)*imax) == xmissing_val) then
c              print *,'LBSF no-flip: ilon= ',ilon,' ilat= ',ilat
              lb2d(ilon,ilat) = .false.
c              fct = fct + 1
            else
              lb2d(ilon,ilat) = .true.
c              tct = tct + 1
            endif
          enddo
        enddo

      endif

c      print *,' '
c      print *,' LB STATS: tct= ',tct,' fct= ',fct,' mct= ',mct
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine conv1d2d_real (imax,jmax,dat1d,dat2d,need_to_flip_lats)
c
c     ABSTRACT: This subroutine converts a 1-dimensional input 
c     array of real data (dat1d) into a 2-dimensional output
c     array (dimension imax,jmax) of real data (dat2d).
c
c     This subroutine was updated in 6/2000 to add the scanning mode
c     flag (iscanflag) as an input.  This is in order to handle grids
c     that are flipped.  Most grids -- NCEP, UKMET, ECMWF -- have
c     point (1,1) as the uppermost left point on the grid, and the
c     data goes from north to south.  Some grids -- GFDL and the new
c     NAVGEM grid -- are flipped; their point (1,1) is the lowermost
c     left point, and their data goes from south to north.  So if
c     the scanning mode flag indicates northward scanning data
c     (bit 2 in the flag is turned on), we catch it in this
c     subroutine and flip the data ourselves for our own arrays,
c     since this whole program is structured around the data going
c     from north to south.  As of the writing of this, only the
c     first 3 bits of the scanning flag are used, which is why we
c     can use the mod statement in the code below.
c
c     UPDATE 8/2009: I removed the scanning mode flag, since that is
c     GRIB-specific.  The north-south determination is now handled with
c     the logical flag need_to_flip_lats.
c
c     INPUT:
c     imax     Number of gridpoints in i direction in input box
c     jmax     Number of gridpoints in j direction in input box
c     dat1d    1-d real array of data
c     need_to_flip_lats  logical flag, set in getgridinfo, that
c              indicates if data is correctly N-to-S, or if it is
c              S-to-N and needs to be flipped.
c
c     OUTPUT:
c     dat2d    2-d real array of data
c
      logical(1) :: need_to_flip_lats
      real    dat1d(imax*jmax),dat2d(imax,jmax)
c
      if (need_to_flip_lats) then

        ! Input data is south to north; flip the data while
        ! converting to 2-d grid....

        do ilat=1,jmax
          ilatix = jmax - ilat + 1
          do ilon=1,imax
            dat2d(ilon,ilatix) = dat1d(ilon+(ilat-1)*imax)
          enddo
        enddo

      else

        ! Input data is north to south.  Just convert the
        ! data onto a 2-d grid, do not flip it....

        do ilat=1,jmax
          do ilon=1,imax
            dat2d(ilon,ilat) = dat1d(ilon+(ilat-1)*imax)
          enddo
        enddo

      endif
c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine read_nlists (inp,trkrinfo,netcdfinfo)
c
c     ABSTRACT: This subroutine simply reads in the namelists that are
c     created in the shell script.  Namelist datein contains the 
c     starting date information, plus the model identifier.  Namelist
c     stswitch contains the flags for processing for each storm.
c
      USE inparms; USE set_max_parms; USE atcf; USE trkrparms; USE phase
      USE structure; USE gfilename_info
      USE verbose_output; USE waitfor_parms; USE netcdf_parms
      USE tracking_parm_prefs

      implicit none

      integer ifh
      type (datecard) inp
      type (trackstuff) trkrinfo
      type (netcdfstuff) netcdfinfo
c
      namelist/datein/inp
      namelist/atcfinfo/atcfnum,atcfname,atcfymdh,atcffreq
      namelist/trackerinfo/trkrinfo
      namelist/phaseinfo/phaseflag,phasescheme,wcore_depth
      namelist/structinfo/structflag,ikeflag
      namelist/fnameinfo/gmodname,rundescr,atcfdescr
      namelist/verbose/verb,verb_g2
      namelist/waitinfo/use_waitfor,wait_min_age,wait_min_size
     &                 ,wait_max_wait,wait_sleeptime
     &                 ,use_per_fcst_command,per_fcst_command
      namelist/netcdflist/netcdfinfo
      namelist/parmpreflist/user_wants_to_track_zeta850
     &       ,user_wants_to_track_zeta700,user_wants_to_track_wcirc850
     &       ,user_wants_to_track_wcirc700,user_wants_to_track_gph850
     &       ,user_wants_to_track_gph700,user_wants_to_track_mslp
     &       ,user_wants_to_track_wcircsfc,user_wants_to_track_zetasfc
     &       ,user_wants_to_track_thick500850
     &       ,user_wants_to_track_thick200500
     &       ,user_wants_to_track_thick200850

c     Set namelist default values:
      use_per_fcst_command='t'
      per_fcst_command=' '
      atcffreq=600
      trkrinfo%enable_timing=1
      trkrinfo%want_oci=.false.
      trkrinfo%gribver=1   ! Set to GRIB1 as default, can be set to
                           ! something else in the namelist input.

      read (5,NML=datein,END=801)
  801 continue
      read (5,NML=atcfinfo,END=807)
  807 continue
      print *,'just before trackerinfo read namelist'
      read (5,NML=trackerinfo,END=809)
  809 continue
      print *,'just after trackerinfo read namelist'
      read (5,NML=phaseinfo,END=811)
  811 continue
      read (5,NML=structinfo,END=815)
  815 continue
      read (5,NML=fnameinfo,END=817)
  817 continue
      read (5,NML=waitinfo,END=821)
  821 continue
      read (5,NML=netcdflist,END=823)
  823 continue
      read (5,NML=parmpreflist,END=825)
  825 continue
      read (5,NML=verbose,END=819,ERR=833)
  819 continue
      goto 837
  833 continue
      verb = 1
  837 continue

      print *,'in read_nlists, verb= ',verb

      if ( verb .ge. 0 ) then
        print *,' '
        print *,'After datein namelist in trak.f, namelist '
     &         ,'parms follow:'
        print *,'Forecast initial year  = byy = ',inp%byy
        print *,'Forecast initial month = bmm = ',inp%bmm
        print *,'Forecast initial day   = bdd = ',inp%bdd
        print *,'Forecast initial hour  = bhh = ',inp%bhh
        print *,'Forecast model identifier = model= ',inp%model
        print *,'Forecast model type = modtyp= ',inp%modtyp
        print *,'Forecast model data lead time units= lt_units= '
     &       ,inp%lt_units
        print *,'Forecast model data sequencing setup= file_seq= '
     &       ,inp%file_seq
        print *,'Forecast model nest type = ',inp%nesttyp
c         
        print *,' '
        print *,'Values read in from atcfinfo namelist: '
        write (6,89) atcfnum,atcfname
        write (6,90) atcfymdh
        write (6,92) atcffreq
 89     format ('ATCF ID = ',i2,'  ATCF Name = ',a4)
 90     format ('ATCF date (initial date on output atcf records) = '
     &         ,i10)
 92     format ('ATCF output frequency (in hours*100) = atcffreq = ',i6)
c
        print *,' '
        print *,'Values read in from trackerinfo namelist follow: '
        write (6,101) ' western boundary  = westbd  = ',trkrinfo%westbd
        write (6,101) ' eastern boundary  = eastbd  = ',trkrinfo%eastbd
        write (6,101) ' northern boundary = northbd = ',trkrinfo%northbd
        write (6,101) ' southern boundary = southbd = ',trkrinfo%southbd
        write (6,102) ' tracker type = ',trkrinfo%type
        write (6,103) ' mslp threshold = mslpthresh = '
     &       ,trkrinfo%mslpthresh
        write (6,120) ' Flag for using backup mslp gradient check= '
     &       ,'use_backup_mslp_grad_check = '
     &       ,trkrinfo%use_backup_mslp_grad_check
        write (6,103) ' v850 threshold = v850thresh = '
     &       ,trkrinfo%v850thresh
        write (6,122) ' Flag for using backup 850 mb Vt check= '
     &       ,'use_backup_850_vt_check = '
     &       ,trkrinfo%use_backup_850_vt_check
        write (6,123) ' Max allowable distance between the '
     &            ,'tracker-found fixes for mslp and 850 zeta = '
     &            ,trkrinfo%max_mslp_850
        write (6,104) ' model grid type = ',trkrinfo%gridtype
        write (6,101) ' Contour interval to be used = ',trkrinfo%contint
        write (6,106) ' Flag for whether or not roci will be computed'
     &       ,' and written out for tracker-type case = '
     &       ,trkrinfo%want_oci
        write (6,105) ' Flag for whether or not vitals will be written '
     &       ,'out = ',trkrinfo%out_vit
        write (6,109) ' Flag for whether or not a land mask will be '
     &       ,'used for tcgen candidate low filtering = '
     &       ,trkrinfo%use_land_mask
        write (6,110) ' Flag for input data type (grib or netcdf) = '
     &                ,trkrinfo%inp_data_type
        write (6,107) ' Flag for which GRIB version (1 or 2) the input'
     &       ,' data will be in = ',trkrinfo%gribver
        write (6,108) ' Flag for input GRIB2 JPDTN (0 or 1) = '
     &                ,trkrinfo%g2_jpdtn
        write (6,112) ' Flag for input GRIB2 MSLP ID (1 or 192) = '
     &                ,trkrinfo%g2_mslp_parm_id
        write (6,114) ' Flag for input GRIB1 MSLP ID (102 or 130) = '
     &                ,trkrinfo%g1_mslp_parm_id
        write (6,116) ' Flag for input GRIB1 sfcwind level type '
     &                ,'(PDS Octet 10... should be 1 or 105) = '
     &                ,trkrinfo%g1_sfcwind_lev_typ
        write (6,118) ' Flag for input GRIB1 sfcwind level value '
     &                ,'(PDS Octets 11 & 12... usually 0 or 10) = '
     &                ,trkrinfo%g1_sfcwind_lev_val

 101    format (a31,f7.2)
 102    format (a16,a7)
 103    format (a31,f7.4)
 104    format (a19,a8)
 106    format (a46,a41,L1)
 105    format (a48,a6,a1)
 109    format (a45,a41,a1)
 110    format (a45,a6)
 107    format (a47,a19,i1)
 108    format (a39,i2)
 112    format (a43,i4)
 114    format (a45,i4)
 116    format (a41,a39,i4)
 118    format (a42,a43,i4)
 120    format (a44,a29,a1)
 122    format (a40,a26,a1)
 123    format (a36,a44,f7.1)

        print *,' '
        print *,' '
        print *,'Values read in from netcdflist namelist: '
        print *,' '
        write (6,300) netcdfinfo%num_netcdf_vars  ! Total *possible* 
                                  ! number of input NetCDF variables,
                                  ! including those that are included
                                  ! in the input file and those that
                                  ! are not.
        write (6,370) netcdfinfo%netcdf_filename ! full path filename
        write (6,301) 
        write (6,302) netcdfinfo%rv850name  ! 850 mb rel vort
        write (6,304) netcdfinfo%rv700name  ! 700 mb rel vort
        write (6,306) netcdfinfo%u850name   ! 850 mb u-comp
        write (6,308) netcdfinfo%v850name   ! 850 mb v-comp
        write (6,310) netcdfinfo%u700name   ! 700 mb u-comp
        write (6,312) netcdfinfo%v700name   ! 700 mb v-comp
        write (6,314) netcdfinfo%z850name   ! 850 mb gp height
        write (6,316) netcdfinfo%z700name   ! 700 mb gp height
        write (6,318) netcdfinfo%mslpname   ! mslp
        write (6,320) netcdfinfo%usfcname   ! near-sfc u-comp
        write (6,322) netcdfinfo%vsfcname   ! near-sfc v-comp
        write (6,324) netcdfinfo%u500name   ! 500 mb u-comp
        write (6,326) netcdfinfo%v500name   ! 500 mb v-comp
        write (6,328) netcdfinfo%tmean_300_500_name !Mean T @ 300-500 mb
        write (6,330) netcdfinfo%z500name   ! 500 mb gp height
        write (6,332) netcdfinfo%z200name   ! 200 mb gp height
        write (6,334) netcdfinfo%lmaskname  ! Land mask
        write (6,336) netcdfinfo%z900name   ! 900 mb gp height
        write (6,338) netcdfinfo%z800name   ! 800 mb gp height
        write (6,340) netcdfinfo%z750name   ! 750 mb gp height
        write (6,342) netcdfinfo%z650name   ! 650 mb gp height
        write (6,344) netcdfinfo%z600name   ! 600 mb gp height
        write (6,346) netcdfinfo%z550name   ! 550 mb gp height
        write (6,348) netcdfinfo%z450name   ! 450 mb gp height
        write (6,350) netcdfinfo%z400name   ! 400 mb gp height
        write (6,352) netcdfinfo%z350name   ! 350 mb gp height
        write (6,354) netcdfinfo%z300name   ! 300 mb gp height
        write (6,355) netcdfinfo%time_name  ! Name of time variable
                                            ! (usually it is "time")
        write (6,356) netcdfinfo%lon_name   ! longitudes
        write (6,358) netcdfinfo%lat_name   ! latitudes
        write (6,359) netcdfinfo%time_units ! This will be either "days"
                                      ! or "hours".  If it's "hours", 
                                      ! then all the time data values 
                                      ! are for hours since the initial 
                                      ! time.  Same thing for "days",
                                      ! however if it is "days", then
                                      ! know that a value of 0.25 will
                                      ! be the same as a 6-hour lead 
                                      ! time.

 300    format ('Total *possible* number of input NetCDF variables,'
     &         ,/,'     including those that are included in the input'
     &         ,/,'     NetCDF file and those that are not = ',i4)
 370    format ('Input NetCDF filename = ',a180)
 301    format (' ',/
     &         ,'List of NetCDF variables follows.  A value of X ',/
     &         ,'indicates the variable is not included in the ',/
     &         ,'input file and no attempt will be made to read in ',/
     &         ,'that variable: ',/,' ')
 302    format ('NetCDF variable name for 850 mb vort =       ',a30)
 304    format ('NetCDF variable name for 700 mb vort =       ',a30)
 306    format ('NetCDF variable name for 850 mb u-comp =     ',a30)
 308    format ('NetCDF variable name for 850 mb v-comp =     ',a30)
 310    format ('NetCDF variable name for 700 mb u-comp =     ',a30)
 312    format ('NetCDF variable name for 700 mb v-comp =     ',a30)
 314    format ('NetCDF variable name for 850 mb gp height =  ',a30)
 316    format ('NetCDF variable name for 700 mb gp height =  ',a30)
 318    format ('NetCDF variable name for MSLP =              ',a30)
 320    format ('NetCDF variable name for near-sfc u-comp =   ',a30)
 322    format ('NetCDF variable name for near-sfc v-comp =   ',a30)
 324    format ('NetCDF variable name for 500 mb u-comp =     ',a30)
 326    format ('NetCDF variable name for 500 mb v-comp =     ',a30)
 328    format ('NetCDF variable name for 300-500 mb Mean T = ',a30)
 330    format ('NetCDF variable name for 500 mb gp height =  ',a30)
 332    format ('NetCDF variable name for 200 mb gp height =  ',a30)
 334    format ('NetCDF variable name for land-sea mask =     ',a30)
 336    format ('NetCDF variable name for 900 mb gp height =  ',a30)
 338    format ('NetCDF variable name for 800 mb gp height =  ',a30)
 340    format ('NetCDF variable name for 750 mb gp height =  ',a30)
 342    format ('NetCDF variable name for 650 mb gp height =  ',a30)
 344    format ('NetCDF variable name for 600 mb gp height =  ',a30)
 346    format ('NetCDF variable name for 550 mb gp height =  ',a30)
 348    format ('NetCDF variable name for 450 mb gp height =  ',a30)
 350    format ('NetCDF variable name for 400 mb gp height =  ',a30)
 352    format ('NetCDF variable name for 350 mb gp height =  ',a30)
 354    format ('NetCDF variable name for 300 mb gp height =  ',a30)
 355    format ('NetCDF variable name for time =              ',a30)
 356    format ('NetCDF variable name for longitudes =        ',a30)
 358    format ('NetCDF variable name for latitudes =         ',a30)
 359    format ('NetCDF time value (hours|days) =             ',a30)

        print *,' '
        print *,' '
        print *,'Values read in from parmpreflist namelist: '
        print *,' '
        write (6,402) user_wants_to_track_zeta850
        write (6,404) user_wants_to_track_zeta700
        write (6,406) user_wants_to_track_wcirc850
        write (6,408) user_wants_to_track_wcirc700
        write (6,410) user_wants_to_track_gph850
        write (6,412) user_wants_to_track_gph700
        write (6,414) user_wants_to_track_mslp
        write (6,416) user_wants_to_track_wcircsfc
        write (6,418) user_wants_to_track_zetasfc
        write (6,420) user_wants_to_track_thick500850
        write (6,422) user_wants_to_track_thick200500
        write (6,424) user_wants_to_track_thick200850

 402    format ('user_wants_to_track_zeta850=     ',a2)
 404    format ('user_wants_to_track_zeta700=     ',a2)
 406    format ('user_wants_to_track_wcirc850=    ',a2)
 408    format ('user_wants_to_track_wcirc700=    ',a2)
 410    format ('user_wants_to_track_gph850=      ',a2)
 412    format ('user_wants_to_track_gph700=      ',a2)
 414    format ('user_wants_to_track_mslp=        ',a2)
 416    format ('user_wants_to_track_wcircsfc=    ',a2)
 418    format ('user_wants_to_track_zetasfc=     ',a2)
 420    format ('user_wants_to_track_thick500850= ',a2)
 422    format ('user_wants_to_track_thick200500= ',a2)
 424    format ('user_wants_to_track_thick200850= ',a2)
        
        print *,' '
        print *,'Values read in from phaseinfo namelist: '
        write (6,211) phaseflag,phasescheme
        write (6,212) wcore_depth
 211    format ('Storm phase flag = ',a1,'  Phase scheme = ',a4)
 212    format ('Storm phase, warm core depth (wcore_depth) = ',f7.2)
        
        print *,' '
        print *,'Values read in from structinfo namelist: '
        write (6,93) structflag
        write (6,95) ikeflag
 93     format ('Structure flag = ',a1)
 95     format ('IKE flag = ',a1)
        
        print *,' '
        print *,'Values read in for grib file name from fnameinfo'
     &       ,' namelist: '
        write (6,131) gmodname
        write (6,133) rundescr
        write (6,135) atcfdescr
 131    format ('Model name description = gmodname = ',a4)
 133    format ('Forecast run description = rundescr = ',a40)
 135    format ('Optional ATCF / Storm name description = atcfdescr = '
     &       ,a40)

        print *,' '
        print *,'Value read in for verbose output for most output:'
        write (6,141) verb
 141    format ('Value read in for verbose flag = verb = ',i2)

        print *,' '
        print *,'Value read in for verbose output for grib2 output:'
        write (6,142) verb_g2
 142    format ('Value read in for GRIB2 verbose flag = verb_g2 = ',i2)

        print *,' '
        print *,'Values read in from waitinfo namelist:'
        write (6,151) use_waitfor
        write (6,152) wait_min_age
        write (6,153) wait_min_size
        write (6,154) wait_max_wait
        write (6,155) wait_sleeptime
        if(len_trim(per_fcst_command)>0) then
           write (6,156) trim(per_fcst_command)
        else
c          No command specified, so disable the feature
           use_per_fcst_command='n'
        endif
 151    format ('Flag for input file waiting = use_waitfor = ',a1)
 152    format ('min age (time in seconds since last mod) = '
     &         ,'wait_min_age = ',i8)
 153    format ('min file size in bytes = wait_min_size = ',i12)
 154    format ('max number of seconds to wait for each file = '
     &         ,'wait_max_wait = ',i6)
 155    format ('number of seconds to sleep between checks = '
     &         ,'wait_sleeptime = ',i6)
 156    format ('command to run after every forecast time = "',A,'"')
c
        if (use_waitfor == 'y') then
          if (inp%file_seq == 'multi') then
            continue
          else
            print *,' '
            print *,'!!! ERROR: The use_waitfor flag is set to "y".'
            print *,'    This requires that the inp%file_seq flag be'
            print *,'    set to "multi", but you have specified '
            print *,'    something else.  '
            print *,'    inp%file_seq = ',inp%file_seq
            print *,'    STOPPING....'
            print *,' '
            STOP 95
          endif
        endif
c
      endif
      return
      end
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine read_fhours (ifhmax)
c
c     ABSTRACT: This subroutine reads in a text file that contains the
c     forecast times that will be read in.  The format of the file is
c     in "MMMMM", i.e., minutes, for example, for a forecast going out
c     to 120h, the file would look like this:
c
c                            For reference, here
c                            are the times that
c                            match up with the
c                            minutes on the left:
c
c      1        0                    0:00
c      2      240                    4:00
c      3      270                    4:30
c      4      300                    5:00
c      5      330                    5:30
c      6      360                    6:00
c      7      600                   10:00
c      8      630                   10:30
c      9      660                   11:00
c     10      690                   11:30
c     11      720                   12:00
c     12      960                   16:00
c     13      990                   16:30
c      .       .                      .
c      .       .                      .
c      .       .                      .
c     87     7200                  120:00
c
c     Note that we are now allowing for sub-hourly time intervals.
c
      USE tracked_parms
      USE verbose_output

      implicit none
c
      integer, parameter :: iunit_fh=15
      integer itmphrs(750),itmpmins(750),input_mins(750),itmpltix(750)
      integer ifhmax,inphr,inpmin,ict,i,ifa,ifma,icma,ira,inpltix,ila
      real    xminfract

      itmphrs  = -99
      itmpmins = -99

      if (allocated(ifhours)) deallocate (ifhours)
      if (allocated(iftotalmins))  deallocate (iftotalmins)
      if (allocated(ifclockmins))  deallocate (ifclockmins)
      if (allocated(fhreal))  deallocate (fhreal)
      if (allocated(ltix))  deallocate (ltix)

      ict = 0
      do while (.true.)

        if ( verb .ge. 3 ) then
          print *,'Top of while loop in read_fhours'
        endif

        read (iunit_fh,85,end=130) inpltix,inpmin
        write (6,85) inpltix,inpmin

        if (inpmin >= 0 .and. inpmin < 150000) then
          ict = ict + 1
          itmpltix(ict) = inpltix
          itmphrs(ict)  = inpmin / 60
          itmpmins(ict) = mod(inpmin,60)
          input_mins(ict) = inpmin
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: Input minutes not between 0 and 150000'
            print *,'!!!        inpmin= ',inpmin
            print *,'!!! STOPPING EXECUTION'
          endif

          STOP 91
        endif

        if ( verb .ge. 3 ) then
          print *,'readloop, ict= ',ict,' inpmin= ',inpmin
        endif

      enddo

  130 continue

      ifhmax = ict

 85   format (i4,1x,i5)

      if ( verb .ge. 3 ) then
        print *,' '
      endif

      allocate (ifhours(ifhmax),stat=ifa)
      allocate (iftotalmins(ifhmax),stat=ifma)
      allocate (ifclockmins(ifhmax),stat=icma)
      allocate (fhreal(ifhmax),stat=ira)
      allocate (ltix(ifhmax),stat=ila)
      if (ifa /= 0 .or. ifma /= 0 .or. icma /= 0 .or. ira /= 0 .or.
     &    ila /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in read_fhours allocating either ifhours,'
          print *,'!!! iftotalmins, ifclockmins or fhreal.'
          print *,'!!! ifa = ',ifa,' ifma= ',ifma,' ira= ',ira
          print *,'!!! icma= ',icma,' ila= ',ila
          print *,'!!! STOPPING EXECUTION'
        endif

        STOP 91
      endif

      do i = 1,ifhmax

        ltix(i) = itmpltix(i)
        xminfract = float(itmpmins(i)) / 60.
        fhreal(i) = float(itmphrs(i)) + xminfract
        ifhours(i) = itmphrs(i)
        ifclockmins(i)  = itmpmins(i)
        iftotalmins(i)  = input_mins(i)

        if (i > 1) then
          if (fhreal(i) > fhreal(i-1)) then
            continue
          else

            if ( verb .ge. 3 ) then
              print *,' '
              print *,'!!! ERROR: In read_fhours, the time read in '
              print *,'!!! is not greater than the previous time.'
              print *,'!!! i= ',i
              print *,'!!! fhreal(i)=   ',fhreal(i)
              print *,'!!! fhreal(i-1)= ',fhreal(i-1)
              print *,'!!! STOPPING EXECUTION'
            endif

            STOP 91
          endif
        endif

        if ( verb .ge. 3 ) then
          write (6,87) i,ltix(i),iftotalmins(i),fhreal(i),ifhours(i)
     &         ,ifclockmins(i)
        endif

      enddo

   87 format (1x,'i= ',i3,'  input lead time index= ',i4,' minutes= '
     &       ,i5,' real_lead_time= ',f6.2,' clock_lead_time= ',i3,':'
     &       ,i2)
c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine read_tcv_card1 (lucard,maxstorm,trkrinfo,numtcv,iret)
c
c     ABSTRACT: This subroutine reads in the updated TC Vitals file
c               for the current time and prints out those cards (storms)
c               that have been selected to be processed.  It also 
c               takes the initial positions from the tcv card for each
c               storm and puts them into the slonfg & slatfg arrays.
c               Note that this routine is reading in vitals in the 
c               standard format for TCs only.  Any genesis vitals are
c               read in in subroutine  read_gen_vitals.
c
c     INPUT:    
c     lucard    integer unit number for tcvitals card
c     trkrinfo  derived type that contains info on the type of 
c               tracker run that we are performing.
c
c     OUTPUT:   
c     maxstorm  max # of storms to be handled for this case
c     numtcv    number of storms read off of the input tcvitals file
c     iret      return code from this subroutine
c
c     OTHER:
c     stormswitch 1,2 or 3 (see more description under Main pgm section)
c     slonfg     first guess array for longitude
c     slatfg     first guess array for latitude
c     storm      contains the tcvitals info
c     (storm, stormswitch, slonfg and slatfg are allocatable and are 
c      defined in module def_vitals)

      USE def_vitals; USE set_max_parms; USE trkrparms
      USE verbose_output

      implicit none

      logical(1) :: vit_file_exists
      type (tcvcard) tmpstorm(maxstorm_tc)
      type (trackstuff) trkrinfo
      integer    isa,issa,ioa,iaa,ita,iret,ict,maxstorm
      integer    i,ii,lucard,numtcv
c------

      ! Check to see if the TC Vitals file exists.  If so, then open it
      ! using the unit specified in lucard.

      inquire (file="tcvit_rsmc_storms.txt",exist=vit_file_exists)

      if (vit_file_exists) then

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'+++ TC Vitals file for existing, RSMC-numbered'
     &           ,'    storms exists and will be opened with '
     &           ,'    unit= lucard= ',lucard 
        endif

        open (unit=lucard,file="tcvit_rsmc_storms.txt",status='old'
     &       ,err=887)

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'+++ TC vitals file tcvit_rsmc_storms.txt has '
          print *,'    been opened with unit= lucard= ',lucard
        endif

      else

        if (trkrinfo%type == 'tracker') then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in read_tcv_card.  The fortran inquire'
            print *,'!!! statement indicates that the tcvitals file for'
            print *,'!!! already-existing, RSMC-numbered storms does '
            print *,'!!! NOT exist.  This TC Vitals file is needed for'
            print *,'!!! a tracker case.  Check to see that the '
            print *,'!!! TC Vitals file exists in this directory and'
            print *,'!!! is named tcvit_rsmc_storms.txt'
            print *,'!!! STOPPING....'
            print *,'!!! '
            iret=99
            return
          endif

        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! NOTE:  In read_tcv_card, the fortran inquire'
            print *,'!!! statement indicates that the tcvitals file for'
            print *,'!!! already-existing, RSMC-numbered storms does '
            print *,'!!! NOT exist.  While this TC Vitals file is '
            print *,'!!! needed for tracker cases, you are running'
            print *,'!!! either a midlat or tcgen case here, and so '
            print *,'!!! that file is not needed... although you can '
            print *,'!!! run with using tc vitals for those genesis'
            print *,'!!! cases if you want to.  You may want to check'
            print *,'!!! and make sure this is what you intend.  If '
            print *,'!!! you do want to use it, the TC Vitals file '
            print *,'!!! should be in this directory and it should be'
            print *,'!!! named tcvit_rsmc_storms.txt'
            print *,'!!! '
          endif

        endif

      endif

      ii=1

      if (vit_file_exists) then
        do while (.true. .and. ii <= maxstorm_tc)
          read (lucard,21,END=801,ERR=891) tmpstorm(ii)
          ii = ii + 1
        enddo
   21   format (a4,1x,a3,1x,a9,1x,i8,1x,i4,1x,i3,a1,1x,i4,a1,1x,i3,1x
     &         ,i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)
  801   continue
      endif

      numtcv = ii - 1

      if (trkrinfo%type == 'midlat' .or. trkrinfo%type == 'tcgen') then
        ! For the mid-latitude or tc genesis cases, the max number
        ! of storms (maxstorm) allowed to be tracked throughout a
        ! forecast is defined in module set_max_parms.

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'In read_tcv_card, tracker type of "midlat" or '
          print *,'"tcgen" indicates that this run of the  tracker is'
          print *,'for a midlat or a tcgen case....'
        endif

        maxstorm = maxstorm_mg
        allocate (stormswitch(maxstorm),stat=isa)
        allocate (storm(maxstorm),stat=issa)
        allocate (slonfg(maxstorm,maxtime),stat=ioa)
        allocate (slatfg(maxstorm,maxtime),stat=iaa)
        allocate (stcvtype(maxstorm),stat=ita)
        if (isa /= 0 .or. ioa /= 0 .or. iaa /= 0 .or. issa /= 0 .or.
     &      ita /= 0) then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in read_tcv_card allocating stormswitch,'
            print *,'!!! slonfg, storm, slatfg or stcvtype arrays.  '
            print *,'!!! isa = ',isa,' ioa= ',ioa,' iaa= ',iaa,' issa= '
            print *,'!!! ',issa,' ita= ',ita
          endif

          iret = 97
          return
        endif
        slonfg = 0.0; slatfg = 0.0
        stcvtype = 'FOF' ! Found On the Fly by tracker (not on tcvitals)
        stormswitch = 3    ! Initialize whole array to case of '3'
        if (numtcv > 0) then
          if ( verb .ge. 3 ) then
            print *,' '
            print *,'Following are the already-existing storms that'
            print *,'were read in from the tc vitals file: '
            print *,' '       
          endif

          ict = 0
          do i=1,numtcv
            stormswitch(i) = 1
            storm(i) = tmpstorm(i)
            ict = ict + 1

            if ( verb .ge. 3 ) then
              write (*,31) storm(i)
            endif
          
            if (storm(i)%tcv_lonew == 'W') then
              slonfg(i,1) =  360. - float(storm(i)%tcv_lon)/10.0
            else
              slonfg(i,1) = float(storm(i)%tcv_lon)/10.0
            endif
            if (storm(i)%tcv_latns == 'S') then
              slatfg(i,1) = -1. * float(storm(i)%tcv_lat)/10.0
            else
              slatfg(i,1) = float(storm(i)%tcv_lat)/10.0
            endif
            stcvtype(i) = 'TCV' ! Storm listed on tcvitals

c            if (trkrinfo%type == 'midlat') then
c              storm(i)%tcv_center = 'MIDL'
c            else if (trkrinfo%type == 'tcgen') then
c              storm(i)%tcv_center = 'TCG '
c            endif
c            write (storm(i)%tcv_storm_id,'(i4.4)') i
c            write (storm(i)%tcv_storm_name,'(i4.4)') i

          enddo
        endif
        iret=0
        return
      else
        ! For the  tracker cases, the max number of storms (maxstorm) 
        ! allowed to be tracked throughout a forecast is defined by 
        ! the number of vitals read in above.

        maxstorm = numtcv

        if (maxstorm > 0) then
          continue
        else
          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in read_tcv_card, num storms to be '
            print *,'!!! processed is not greater than 0 for a tracker'
            print *,'!!! case.  Check to see that the TC Vitals file'
            print *,'!!! has been created and exists in the working'
            print *,'!!! directory.  That TC vitals file should be'
            print *,'!!! named tcvit_rsmc_storms.txt'
            print *,'!!! STOPPING...'
            print *,'!!! '
            iret=99
            return
          endif
        endif

        allocate (stormswitch(maxstorm),stat=isa)
        allocate (storm(maxstorm),stat=issa)
        allocate (slonfg(maxstorm,maxtime),stat=ioa)
        allocate (slatfg(maxstorm,maxtime),stat=iaa)
        allocate (stcvtype(maxstorm),stat=ita)
        if (isa /= 0 .or. ioa /= 0 .or. iaa /= 0 .or. issa /= 0 .or.
     &      ita /= 0) then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in read_tcv_card allocating stormswitch,'
            print *,'!!! slonfg, storm, slatfg or stcvtype arrays.  '
            print *,'!!! isa = ',isa,' ioa= ',ioa,' iaa= ',iaa,' issa= '
            print *,'!!! ',issa,' ita= ',ita
          endif

          iret = 97
          return   
        endif

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'Following are the storms to be processed: '
          print *,' '
        endif

        slonfg = 0.0; slatfg = 0.0
        stcvtype = '   '  ! Not needed for regular tracker run....
        ict=0
        do i=1,maxstorm
          stormswitch(i) = 1
          storm(i) = tmpstorm(i)
          ict = ict + 1

          if ( verb .ge. 3 ) then
            write (*,31) storm(i)
          endif

          if (storm(i)%tcv_lonew == 'W') then
            slonfg(i,1) =  360. - float(storm(i)%tcv_lon)/10.0
          else
            slonfg(i,1) = float(storm(i)%tcv_lon)/10.0
          endif
          if (storm(i)%tcv_latns == 'S') then
            slatfg(i,1) = -1. * float(storm(i)%tcv_lat)/10.0
          else
            slatfg(i,1) = float(storm(i)%tcv_lat)/10.0
          endif
        enddo
 
        if (ict.gt.0) then
          iret = 0
          return
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in read_tcv_card, num storms to be '
            print *,'!!! processed is not greater than 0 for a tracker'
            print *,'!!! case.  Check to see that the TC Vitals file'
            print *,'!!! has been created and exists in the working'
            print *,'!!! directory.  That TC vitals file should be'
            print *,'!!! named tcvit_rsmc_storms.txt'
            print *,'!!! Stopping....'
            print *,' '
          endif

          iret = 99
          return

        endif

      endif

   31 format (a4,1x,a3,1x,a9,1x,i8.8,1x,i4.4,1x,i3,a1,1x,i4,a1,1x
     &       ,i3,1x,i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)

 887  continue

      if ( verb .ge. 1 ) then
        print *,'!!! ERROR in read_tcv_card opening rsmc TC vitals'
        print *,'!!! file named tcvit_rsmc_storms.txt.  A file with'
        print *,'!!! that name needs to be in your working directory.'
        print *,'!!! It should contain the input TC vitals for '
        print *,'!!! already-existing storms that have rsmc-issued'
        print *,'!!! storm IDs.'
      endif

      iret = 97
      return

 891  continue

      if ( verb .ge. 1 ) then
        print *,'!!! ERROR in read_tcv_card reading unit ',lucard
      endif

      iret = 98
c
      return
      end
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      subroutine read_gen_vitals1(lgvcard,maxstorm,trkrinfo,numtcv,iret)
c
c     ABSTRACT: This subroutine reads in a modified TC Vitals file
c     for the current time and prints out those cards (storms) that
c     have been selected to be processed.  It also takes the initial 
c     positions from the tcv card for each storm and puts them into 
c     the slonfg & slatfg arrays.
c
c     The reason that these are referred to as modified tcvitals is
c     that the format is different from standard TC vitals format.
c     These vitals are created by a previous run of this tracker 
c     executable, and the storm identifier is different than that 
c     for a standard tcvitals.  The storm
c     identifier contains the date/time that the storm was first 
c     identified, and the lat/lon position at which it was first
c     identified.
c
c     EXAMPLE:  The following is a standard TC Vitals record, split
c               up over 3 lines:
c
c       NHC  01L ALBERTO   20060614 1200 343N 0807W 035 093 1004 1012 
c            0278 15 222 -999 -999 -999 -999 M -999 -999 -999 -999 72 
c            520N  410W  -999 -999 -999 -999
c
c     EXAMPLE:  The following is the format for the "genesis" vitals,
c               split over 3 lines, for the same system:
c
c       2006061000_F000_210N_0853W_01L 20060614 1200 343N 0807W 035 093
c            1004 1012 0278 15 222 -999 -999 -999 -999 M -999 -999 
c            -999 -999 72 520N  410W  -999 -999 -999 -999
c
c     EXAMPLE:  If the vitals record is for a non-officially numbered
c               system (i.e., any system that's not a TC being tracked
c               by NHC or JTWC), then the storm number is replaced 
c               by the characters "FOF", for "Found On the Fly" by 
c               the  tracker.
c
c       2006071500_F000_150N_0681W_FOF 20060718 1200 185N 0792W 035 093
c            1004 1012 0278 15 222 -999 -999 -999 -999 M -999 -999 
c            -999 -999 72 520N  410W  -999 -999 -999 -999
c
c       NOTE: The "F000" in there at character positions 12-15 are to 
c             indicate the forecast hour within that forecast cycle 
c             that the storm was first detected.  For a vitals record,
c             this is always going to be 000 for fhr=0h, and really,
c             it's not even needed.  However, I'm keeping it in there
c             in order to keep the storm ID format exactly the same 
c             as the  output_atcf_sink forecast track record, which 
c             does have a use for that "FXXX" identifier in the 
c             output.
c
c     INPUT:
c     lgvcard    integer unit number for tcgen-tcvitals card
c
c     OUTPUT:
c     maxstorm  max # of storms to be handled for this case
c     iret      return code from this subroutine
c
c     INPUT/OUTPUT: 
c     numtcv    As an input, this variable contains the number of 
c               *tropical* cyclone vitals (i.e., regular tcvitals) that
c               were read off of the input tcvitals file in subroutine
c               read_tcv_card.  This variable will be incremented for 
c               each "modified" vitals record that is read in this 
c               subroutine, and so as output, this variable will 
c               contain the combined total of tcvitals and modified 
c               vitals records.
c
c     OTHER:
c     stormswitch 1,2 or 3 (see more description under Main pgm section)
c     slonfg     first guess array for longitude
c     slatfg     first guess array for latitude
c     storm      contains the tcvitals info
c     (storm, stormswitch, slonfg and slatfg are allocatable and are
c      defined in module def_vitals)
c               
      USE def_vitals; USE set_max_parms; USE trkrparms; USE gen_vitals
      USE verbose_output

      implicit none

      type (gencard) tmpstorm(maxstorm_mg)
      type (trackstuff) trkrinfo
      logical(1) :: vit_file_exists
      integer    iret,maxstorm
      integer    i,ii,lgvcard,numtcv,num_mod_vit,vitix,iga
c------

      ! Check to see if the genesis TC Vitals file exists.  If so, then
      ! open it using the unit specified in lgvcard.

      inquire (file="tcvit_genesis_storms.txt",exist=vit_file_exists)

      if (vit_file_exists) then

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'+++ TC Vitals file for genesis'
     &           ,'    storms exists and will be opened with '
     &           ,'    unit= lgvcard= ',lgvcard
        endif

        open (unit=lgvcard,file="tcvit_genesis_storms.txt",status='old'
     &       ,err=887)

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'+++ TC vitals file tcvit_genesis_storms.txt has '
          print *,'    been opened with unit= lgvcard= ',lgvcard
        endif

      endif

      ! Read in all of the "genesis vitals" into a temp array.  The 
      ! index for the first array member is one past the number of 
      ! tc vitals that were read in in subroutine  read_tcv_card.

      ii = numtcv + 1

      if (vit_file_exists) then

        do while (.true. .and. ii <= maxstorm_mg)
          read (lgvcard,24,END=801,ERR=891) tmpstorm(ii)
          ii = ii + 1
        enddo

   24   format (i10,2x,i3,1x,i3,a1,1x,i4,a1,1x,a3,1x,i8,1x,i4,1x,i3,a1
     &      ,1x,i4,a1,1x,i3,1x,i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)

  801   continue

      endif


      num_mod_vit = ii - numtcv - 1

      allocate (gstorm(maxstorm_mg),stat=iga)
      if (iga /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in read_gen_vitals allocating gstorm array'
          print *,'!!! iga = ',iga
        endif

        iret = 97
        return   
      endif   

      ! Initialize all "genesis dates" to 99999.  Any new genesis 
      ! vitals that are read in below will bring in real dates, and 
      ! then we can test the date in output_gen_vitals to know if a
      ! storm was already defined or not at the beginning of this 
      ! executable or if it was a new storm that was found.

      do i = 1,maxstorm_mg
        gstorm(i)%gv_gen_date = 99999
      enddo

      ! If there are any TC vitals (i.e., officially named TCs
      ! that are being numbered/tracked by either NHC or JTWC), then
      ! we want to take the important information from those vitals
      ! and put that into genesis vitals.  This will enable us to 
      ! output *all* of these systems in the "gen_vitals" or 
      ! "gstorm" format.  The one difference here is that for the
      ! genesis date, we use the starting date of this forecast, not
      ! the time that the storm first formed.  Also, set the genesis
      ! forecast hour (gv_gen_fhr) to be 0 for TCs that have a 
      ! TC vitals record.

      if (numtcv > 0) then
        do i = 1,numtcv
          gstorm(i)%gv_gen_date  = storm(i)%tcv_ymd * 100 +
     &                             storm(i)%tcv_hhmm / 100
          gstorm(i)%gv_gen_fhr   = 0
          gstorm(i)%gv_gen_lat   = storm(i)%tcv_lat
          gstorm(i)%gv_gen_latns = storm(i)%tcv_latns
          gstorm(i)%gv_gen_lon   = storm(i)%tcv_lon
          gstorm(i)%gv_gen_lonew = storm(i)%tcv_lonew
          gstorm(i)%gv_gen_type  = storm(i)%tcv_storm_id
          gstorm(i)%gv_obs_ymd   = storm(i)%tcv_ymd
          gstorm(i)%gv_obs_hhmm  = storm(i)%tcv_hhmm
          gstorm(i)%gv_obs_lat   = storm(i)%tcv_lat
          gstorm(i)%gv_obs_latns = storm(i)%tcv_latns
          gstorm(i)%gv_obs_lon   = storm(i)%tcv_lon
          gstorm(i)%gv_obs_lonew = storm(i)%tcv_lonew
          if ( verb .ge. 3 ) then
            write (*,34) gstorm(i)
          endif
        enddo
      endif

      if (num_mod_vit > 0) then

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'Following are the vitals for storms that were'
          print *,'read in from the modified (genesis) tc vitals file: '
          print *,' '
        endif

        do i=1,num_mod_vit
          vitix = i + numtcv
          stormswitch(vitix) = 1
          ! On the following line we are filling the array gstorm, 
          ! which is new in this subroutine.  Note, however, that we
          ! are not necessarily starting it at 1, but at the point in
          ! the array after any TC Vitals may have been read in.
          gstorm(vitix) = tmpstorm(vitix)

          if ( verb .ge. 3 ) then
            write (*,34) gstorm(vitix)
          endif

          ! For the sake of consistency (and sanity!!), we need to also
          ! use the same "storm" array as was used in read_tcv_card, 
          ! since this "storm" array is used often throughout the rest
          ! of this executable.

          write (storm(vitix)%tcv_storm_id,'(i4.4)') vitix
          write (storm(vitix)%tcv_storm_name,'(i4.4)') vitix
          storm(vitix)%tcv_ymd   = gstorm(vitix)%gv_obs_ymd
          storm(vitix)%tcv_hhmm  = gstorm(vitix)%gv_obs_hhmm
          storm(vitix)%tcv_lat   = gstorm(vitix)%gv_obs_lat
          storm(vitix)%tcv_latns = gstorm(vitix)%gv_obs_latns
          storm(vitix)%tcv_lon   = gstorm(vitix)%gv_obs_lon
          storm(vitix)%tcv_lonew = gstorm(vitix)%gv_obs_lonew
          storm(vitix)%tcv_stdir = gstorm(vitix)%gv_stdir
          storm(vitix)%tcv_stspd = gstorm(vitix)%gv_stspd

          if (trkrinfo%type == 'midlat') then
            storm(vitix)%tcv_center = 'MIDL'
          else if (trkrinfo%type == 'tcgen') then
            storm(vitix)%tcv_center = 'TCG '
          endif
      
          if (gstorm(vitix)%gv_obs_lonew == 'W') then
            slonfg(vitix,1) =  360. - float(gstorm(vitix)%gv_obs_lon)
     &                         / 10.0
          else
            slonfg(vitix,1) = float(gstorm(vitix)%gv_obs_lon)/10.0
          endif
          if (gstorm(vitix)%gv_obs_latns == 'S') then
            slatfg(vitix,1) = -1. * float(gstorm(vitix)%gv_obs_lat)/10.0
          else
            slatfg(vitix,1) = float(gstorm(vitix)%gv_obs_lat)/10.0
          endif
          stcvtype(vitix) = 'FOF' ! Storm "Found On the Fly" by tracker
        
        enddo
      endif

   34 format (i10,1x,'F',i3.3,1x,i3.3,a1,1x,i4.4,a1,1x,a3,1x,i8,1x,i4.4
     &       ,1x,i3.3,a1,1x,i4.4,a1,1x,i3,1x,i3,3(1x,i4),1x,i2,1x,i3,1x
     &       ,4(i4,1x),a1)

c     Update the total number of vitals that have been read in

      numtcv = numtcv + num_mod_vit

      goto 895
c     

 887  continue

      if ( verb .ge. 1 ) then 
        print *,'!!! ERROR in read_gen_vitals opening genesis vitals'
        print *,'!!! file named tcvit_genesis_storms.txt'
      endif
   
      iret = 97
      return


 891  continue
      
      if ( verb .ge. 1 ) then
        print *,'!!! ERROR in read_gen_vitals reading unit ',lgvcard
      endif

      iret = 98

  895 continue
c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine getgridinfo_grib (imax,jmax,ifh,dx,dy,lugb,lugi
     &                ,trkrinfo,need_to_flip_lats,need_to_flip_lons
     &                ,inp,iggret)
c
c     ABSTRACT: The purpose of this subroutine is just to get the max
c     values of i and j and the dx and dy grid spacing intervals for the
c     grid to be used in the rest of the program.  So just read the 
c     grib file to get the lon and lat data.  Also, get the info for 
c     the data grid's boundaries.  This boundary information will be 
c     used later in the tracking algorithm, and is accessed via Module 
c     grid_bounds.
c
      USE grid_bounds; USE trkrparms; USE tracked_parms; USE inparms
      USE verbose_output; USE params; USE grib_mod

      implicit none

      type (trackstuff) trkrinfo
      type (datecard) inp

      type(gribfield) :: gfld,prevfld,holdgfld
      logical(1) :: need_to_flip_lats,need_to_flip_lons
      logical(1), allocatable :: lb(:)
      logical :: unpack=.true.
      logical :: open_grb=.false.
      CHARACTER(len=8) :: pabbrev
      integer,dimension(200) :: jids,jpdt,jgdt
      integer, parameter :: jf=40000000
      integer :: listsec1(13)
      integer   pdt_4p0_vert_level,pdt_4p0_vtime
      real      xhold,xlondiff,xlatdiff,temp,firstval,lastval
      real, allocatable :: f(:)
      real, allocatable :: tmplon(:),tmplat(:)
      real, intent(out) :: dx,dy
      integer   jpds(200),jgds(200),igetpds(200),igetgds(200)
      integer, intent(in)  :: ifh
      integer, intent(out) :: imax,jmax
      integer   iia,ija,ila,midi,midj,i,j,iix,jix,ifa,iret
      integer   iscanflag,iggret,kf,k,lugb,lugi,jskp,jdisc
      integer   jpdtn,jgdtn,npoints,icount,ipack,krec
      integer :: listsec0(2)=(/0,2/)
      integer :: igds(5)=(/0,0,0,0,0/),previgds(5)
      integer :: idrstmpl(200)
      integer :: currlen=1000000

      iggret = 0

      allocate (lb(jf),stat=ila); allocate (f(jf),stat=ifa)
      if (ila /= 0 .or. ifa /= 0) then
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in getgridinfo allocating either lb or f'
          print *,'!!! ila = ',ila,' ifa= ',ifa
        endif
        iggret = 97
        return
      endif

      if (trkrinfo%gribver == 2) then

        ! Search for a record from a GRIB2 file

        !
        ! ---  Initialize Variables ---
        !

        gfld%idsect => NULL()
        gfld%local => NULL()
        gfld%list_opt => NULL()
        gfld%igdtmpl => NULL()
        gfld%ipdtmpl => NULL()
        gfld%coord_list => NULL()
        gfld%idrtmpl => NULL()
        gfld%bmap => NULL()
        gfld%fld => NULL()

        jdisc=0 ! meteorological products
        jids=-9999
        jpdtn=trkrinfo%g2_jpdtn ! 0 = analysis or forecast; 1 = ens fcst
        jgdtn=0 ! lat/lon grid
        jgdt=-9999
        jpdt=-9999

        npoints=0
        icount=0
        jskp=0

c       Search for Temperature or GP Height by production template....

        JPDT(1:15)=(/-9999,-9999,-9999,-9999,-9999,-9999,-9999
     &           ,-9999,-9999,-9999,-9999,-9999,-9999,-9999,-9999/)

        !  Request a record on a lat/lon grid.

        jgdtn = 0

        !  Request a record at the current forecast lead time.

        if (inp%lt_units == 'minutes') then
          jpdt(8) = 0
          jpdt(9) = iftotalmins(ifh)
        else
          jpdt(8) = 1
          jpdt(9) = ifhours(ifh)
        endif

        if (verb >= 3) then
          print *,'before getgb2 call, lugb= ',lugb,' lugi= ',lugi
        endif

        call getgb2(lugb,lugi,jskp,jdisc,jids,jpdtn,jpdt,jgdtn,jgdt
     &             ,unpack,krec,gfld,iret)
        if ( iret.ne.0) then
          print *,' '
          print *,' ERROR: getgb2 error in getgridinfo = ',iret
          print *,' FATAL ERROR: cannot proceed without info '
          print *,' from getgridinfo.  STOPPING....'
          stop 95
        endif

c       Determine packing information from GRIB2 file
c       The default packing is 40  JPEG 2000

        ipack = 40

        if ( verb_g2 .ge. 1 ) then
          print *,' '
          print *,' -- BEGIN getgridinfo diagnostics for GRIB2 file ---'
          print *,' --       at ifh= ',ifh
          print *,' '
          print *,' gfld%idrtnum = ', gfld%idrtnum
        endif

        !   Set DRT info  ( packing info )
        if ( gfld%idrtnum.eq.0 ) then      ! Simple packing
          ipack = 0
        elseif ( gfld%idrtnum.eq.2 ) then  ! Complex packing
          ipack = 2
        elseif ( gfld%idrtnum.eq.3 ) then  ! Complex & spatial packing
          ipack = 31
        elseif ( gfld%idrtnum.eq.40.or.gfld%idrtnum.eq.15 ) then
          ! JPEG 2000 packing
          ipack = 40
        elseif ( gfld%idrtnum.eq.41 ) then  ! PNG packing
          ipack = 41
        endif

        if ( verb_g2 .ge. 1 ) then
          print *,'After check of idrtnum, ipack= ',ipack
          print *,'Number of gridpts= gfld%ngrdpts= ',gfld%ngrdpts
          print *,'Number of elements= gfld%igdtlen= ',gfld%igdtlen
          print *,'PDT num= gfld%ipdtnum= ',gfld%ipdtnum
          print *,'GDT num= gfld%igdtnum= ',gfld%igdtnum
        endif

        imax = gfld%igdtmpl(8)
        jmax = gfld%igdtmpl(9)
        dx   = float(gfld%igdtmpl(17))/1.e6
        dy   = float(gfld%igdtmpl(17))/1.e6
        kf   = gfld%ngrdpts

        holdgfld = gfld

        if (verb_g2 .ge. 1) then

          print *,' '
          print *,' SECTION 0: discipl= ',gfld%discipline
     &           ,' gribver= ',gfld%version

          print *,' '
          print *,' SECTION 1: '

          do j = 1,gfld%idsectlen
            print *,'     sect1, j= ',j,' gfld%idsect(j)= '
     &             ,gfld%idsect(j)
          enddo

          if ( associated(gfld%local).AND.gfld%locallen.gt.0) then
            print *,' '
            print *,' SECTION 2: ',gfld%locallen,' bytes'
          else
            print *,' '
            print *,' SECTION 2 DOES NOT EXIST IN THIS RECORD'
          endif

          print *,' '
          print *,' SECTION 3: griddef= ',gfld%griddef
          print *,'            ngrdpts= ',gfld%ngrdpts
          print *,'            numoct_opt= ',gfld%numoct_opt
          print *,'            interp_opt= ',gfld%interp_opt
          print *,'            igdtnum= ',gfld%igdtnum
          print *,'            igdtlen= ',gfld%igdtlen

          print *,' '
          print '(a17,i3,a2)',' GRID TEMPLATE 3.',gfld%igdtnum,': '
          do j=1,gfld%igdtlen
            print *,'    j= ',j,' gfld%igdtmpl(j)= ',gfld%igdtmpl(j)
          enddo

c         Get parameter abbrev for record that was retrieved
          print *,' '
          print *,'     PDT num (gfld%ipdtnum) = ',gfld%ipdtnum
          print *,' '
          print '(a20,i3,a2)',' PRODUCT TEMPLATE 4.',gfld%ipdtnum,': '
          do j=1,gfld%ipdtlen
            print *,'    sect 4  j= ',j,' gfld%ipdtmpl(j)= '
     &             ,gfld%ipdtmpl(j)
          enddo

        endif


        pdt_4p0_vtime      = gfld%ipdtmpl(9)
        pdt_4p0_vert_level = gfld%ipdtmpl(12)

        pabbrev=param_get_abbrev(gfld%discipline,gfld%ipdtmpl(1)
     &                          ,gfld%ipdtmpl(2))

        firstval=gfld%fld(1)
        lastval=gfld%fld(kf)

        if (verb .ge. 3) then
          print *,' '
          write (6,131)
 131      format (' rec#   param     level  byy  bmm  bdd  bhh  '
     &           ,'fhr      npts  firstval    lastval')
          print '(i5,3x,a8,2x,6i5,2x,i8,4g12.4)'
     &        ,krec,pabbrev,pdt_4p0_vert_level,gfld%idsect(6)
     &           ,gfld%idsect(7),gfld%idsect(8),gfld%idsect(9)
     &           ,pdt_4p0_vtime,gfld%ngrdpts,firstval,lastval
cPENG &        ,krec,pabbrev,pdt_4p0_vert_level/100,gfld%idsect(6)
        endif

        if (verb_g2 .ge. 1) then

          print *,' '
          print *,' -- END getgridinfo diagnostics for GRIB2 file ---'
          print *,' --     at ifh= ',ifh
          print *,' '
          print *,' '
          print *,' '

        endif

        need_to_flip_lons = .false.

        iscanflag = gfld%igdtmpl(19)
        if (mod(iscanflag,128) >= 64) then
          ! Input data is south to north...
          glatmin = float(gfld%igdtmpl(12))/1.e6
          glatmax = float(gfld%igdtmpl(15))/1.e6
          need_to_flip_lats = .true.
        else
          ! Input data is north to south...
          glatmin = float(gfld%igdtmpl(15))/1.e6
          glatmax = float(gfld%igdtmpl(12))/1.e6
          need_to_flip_lats = .false.
        endif

        glonmin = float(gfld%igdtmpl(13))/1.e6
        glonmax = float(gfld%igdtmpl(16))/1.e6

        if (verb .ge. 3) then
          print *,'In getgridinfo: glatmin= ',glatmin
          print *,'                glatmax= ',glatmax
          print *,'                glonmin= ',glonmin
          print *,'                glonmax= ',glonmax
        endif

      else

        !------------------------------------------
        ! Search for a record from a GRIB1 file
        !------------------------------------------

        jpds = -1
        jgds = -1

        jgds(1) = 0   ! Request a record that's on a lat/lon grid

        if ( verb .ge. 3 ) then
          print *,'before getgb in getgridinfo, ifh= ',ifh
          write (6,402) ifhours(ifh),ifclockmins(ifh)
 402      format (1x,'*       Forecast hour: ',i4,':',i2.2)
          print *,'       ifhours(ifh)= ',ifhours(ifh)
          print *,'   iftotalmins(ifh)= ',iftotalmins(ifh)
        endif

        !  Request a record at the current forecast lead time.

        if (inp%lt_units == 'minutes') then
          jpds(14) = iftotalmins(ifh)
        else
          jpds(14) = ifhours(ifh)
        endif

        j=0

c        jpds(14) = 0   ! test
c
        write(*,980) jpds(1),jpds(2)
        write(*,981) jpds(3),jpds(4)
        write(*,982) jpds(5),jpds(6)
        write(*,983) jpds(7),jpds(8)
        write(*,984) jpds(9),jpds(10)
        write(*,985) jpds(11),jpds(12)
        write(*,986) jpds(13),jpds(14)
        write(*,987) jpds(15),jpds(16)
        write(*,988) jpds(17),jpds(18)
        write(*,989) jpds(19),jpds(20)
        write(*,990) jpds(21),jpds(22)
        write(*,991) jpds(23),jpds(24)
        write(*,992) jpds(25)
        write(*,880) jgds(1),jgds(2)
        write(*,881) jgds(3),jgds(4)
        write(*,882) jgds(5),jgds(6)
        write(*,883) jgds(7),jgds(8)
        write(*,884) jgds(9),jgds(10)
        write(*,885) jgds(11),jgds(12)
        write(*,886) jgds(13),jgds(14)
        write(*,887) jgds(15),jgds(16)
        write(*,888) jgds(17),jgds(18)
        write(*,889) jgds(19),jgds(20)
        write(*,890) jgds(21),jgds(22)

  980   format('    jpds(1)  = ',i7,'  jpds(2)  = ',i7)
  981   format('    jpds(3)  = ',i7,'  jpds(4)  = ',i7)
  982   format('    jpds(5)  = ',i7,'  jpds(6)  = ',i7)
  983   format('    jpds(7)  = ',i7,'  jpds(8)  = ',i7)
  984   format('    jpds(9)  = ',i7,'  jpds(10) = ',i7)
  985   format('    jpds(11) = ',i7,'  jpds(12) = ',i7)
  986   format('    jpds(13) = ',i7,'  jpds(14) = ',i7)
  987   format('    jpds(15) = ',i7,'  jpds(16) = ',i7)
  988   format('    jpds(17) = ',i7,'  jpds(18) = ',i7)
  989   format('    jpds(19) = ',i7,'  jpds(20) = ',i7)
  990   format('    jpds(21) = ',i7,'  jpds(22) = ',i7)
  991   format('    jpds(23) = ',i7,'  jpds(24) = ',i7)
  992   format('    jpds(25) = ',i7)
  880   format('    jgds(1)  = ',i7,'  jgds(2)  = ',i7)
  881   format('    jgds(3)  = ',i7,'  jgds(4)  = ',i7)
  882   format('    jgds(5)  = ',i7,'  jgds(6)  = ',i7)
  883   format('    jgds(7)  = ',i7,'  jgds(8)  = ',i7)
  884   format('    jgds(9)  = ',i7,'  jgds(10) = ',i7)
  885   format('    jgds(11) = ',i7,'  jgds(12) = ',i7)
  886   format('    jgds(13) = ',i7,'  jgds(14) = ',i7)
  887   format('    jgds(15) = ',i7,'  jgds(16) = ',i7)
  888   format('    jgds(17) = ',i7,'  jgds(18) = ',i7)
  889   format('    jgds(19) = ',i7,'  jgds(20) = ',i7)
  890   format('    jgds(20) = ',i7,'  jgds(22) = ',i7)

        print *,'lugb= ',lugb,' lugi= ',lugi
        print *,'before ggi getgb jpds(14) = ',jpds(14)
        print *,'before ggi getgb jgds(1) = ',jgds(1)

        call getgb(lugb,lugi,jf,j,jpds,jgds,
     &                       kf,k,igetpds,igetgds,lb,f,iret)

        if (iret.ne.0) then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in getgridinfo calling getgb'
            print *,'!!! Return code from getgb = iret = ',iret
          endif

          iggret = iret
        else
          iggret=0
          imax = igetgds(2)
          jmax = igetgds(3)
          dx   = float(igetgds(9))/1000.
          dy   = float(igetgds(10))/1000.
        endif

c        write(*,780) igetpds(1),igetpds(2)
c        write(*,781) igetpds(3),igetpds(4)
c        write(*,782) igetpds(5),igetpds(6)
c        write(*,783) igetpds(7),igetpds(8)
c        write(*,784) igetpds(9),igetpds(10)
c        write(*,785) igetpds(11),igetpds(12)
c        write(*,786) igetpds(13),igetpds(14)
c        write(*,787) igetpds(15),igetpds(16)
c        write(*,788) igetpds(17),igetpds(18)
c        write(*,789) igetpds(19),igetpds(20)
c        write(*,790) igetpds(21),igetpds(22)
c        write(*,791) igetpds(23),igetpds(24)
c        write(*,792) igetpds(25)
c        write(*,680) igetgds(1),igetgds(2)
c        write(*,681) igetgds(3),igetgds(4)
c        write(*,682) igetgds(5),igetgds(6)
c        write(*,683) igetgds(7),igetgds(8)
c        write(*,684) igetgds(9),igetgds(10)
c        write(*,685) igetgds(11),igetgds(12)
c        write(*,686) igetgds(13),igetgds(14)
c        write(*,687) igetgds(15),igetgds(16)
c        write(*,688) igetgds(17),igetgds(18)
c        write(*,689) igetgds(19),igetgds(20)
c        write(*,690) igetgds(21),igetgds(22)
c
c  780   format('    kpds(1)  = ',i7,'  kpds(2)  = ',i7)
c  781   format('    kpds(3)  = ',i7,'  kpds(4)  = ',i7)
c  782   format('    kpds(5)  = ',i7,'  kpds(6)  = ',i7)
c  783   format('    kpds(7)  = ',i7,'  kpds(8)  = ',i7)
c  784   format('    kpds(9)  = ',i7,'  kpds(10) = ',i7)
c  785   format('    kpds(11) = ',i7,'  kpds(12) = ',i7)
c  786   format('    kpds(13) = ',i7,'  kpds(14) = ',i7)
c  787   format('    kpds(15) = ',i7,'  kpds(16) = ',i7)
c  788   format('    kpds(17) = ',i7,'  kpds(18) = ',i7)
c  789   format('    kpds(19) = ',i7,'  kpds(20) = ',i7)
c  790   format('    kpds(21) = ',i7,'  kpds(22) = ',i7)
c  791   format('    kpds(23) = ',i7,'  kpds(24) = ',i7)
c  792   format('    kpds(25) = ',i7)
c  680   format('    kgds(1)  = ',i7,'  kgds(2)  = ',i7)
c  681   format('    kgds(3)  = ',i7,'  kgds(4)  = ',i7)
c  682   format('    kgds(5)  = ',i7,'  kgds(6)  = ',i7)
c  683   format('    kgds(7)  = ',i7,'  kgds(8)  = ',i7)
c  684   format('    kgds(9)  = ',i7,'  kgds(10) = ',i7)
c  685   format('    kgds(11) = ',i7,'  kgds(12) = ',i7)
c  686   format('    kgds(13) = ',i7,'  kgds(14) = ',i7)
c  687   format('    kgds(15) = ',i7,'  kgds(16) = ',i7)
c  688   format('    kgds(17) = ',i7,'  kgds(18) = ',i7)
c  689   format('    kgds(19) = ',i7,'  kgds(20) = ',i7)
c  690   format('    kgds(20) = ',i7,'  kgds(22) = ',i7)

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'In getgridinfo, grid dimensions follow:'
          print *,'imax= ',imax,' jmax= ',jmax
          print *,'  dx= ',dx,'  dy= ',dy
        endif


c       ----------------------------------------------------------------
c       Get boundaries of the data grid.  NOTE: gds(4) is referred to in
c       GRIB documenatation as the "Latitude of origin", which might 
c       imply "minimum Latitude".  However, for the grids that we'll be
c       using in this program, the "Latitude of origin" will be listed 
c       under gds(4) as the northernmost point (eg., in MRF, 
c       gds(4) = 90), so for this program, use gds(4) as your max lat, 
c       and gds(7) as your min lat. However, in case NCEP, UKMET or 
c       ECMWF change their convention and begin flipping their grids, a
c       check is made to make sure that the max lat is not less than the
c       min lat.
c
c       BUGFIX (August, 2001): It is possible to have an input grid 
c       which goes from south to north (such as NAVGEM).  In this case,
c       we flip the data in subroutine conv1d2d_real.  However, the max 
c       and min latitudes listed in the GRIB GDS will be confused, so we
c       need to check the value of the GRIB scanning mode flag here.

        need_to_flip_lons = .false.

        iscanflag = igetgds(11)
        if (mod(iscanflag,128) >= 64) then
          ! Input data is south to north...
          glatmin = float(igetgds(4))/1000.
          glatmax = float(igetgds(7))/1000.
          need_to_flip_lats = .true.
        else
          ! Input data is north to south...
          glatmin = float(igetgds(7))/1000.
          glatmax = float(igetgds(4))/1000.
          need_to_flip_lats = .false.
        endif

        glonmin = float(igetgds(5))/1000.
        glonmax = float(igetgds(8))/1000.

      endif

c     After this point in this subroutine, nothing is GRIB1 / GRIB2
c     specific, so it does not need to be within the if/then 
c     statement above that differentiated between GRIB / GRIB2.

c17Jul2014      if (glonmin < 0.0) glonmin = 360. - abs(glonmin)
c17Jul2014      if (glonmax < 0.0) glonmax = 360. - abs(glonmax)

      if (glonmin >= 0.0 .and. glonmax >= 0.0) then
        if (glonmin > glonmax) then
          if (verb .ge. 3) then
            print *,' '
            print *,'ERROR: Badly notated longitude boundaries in '
            print *,'       GRIB PDS, because the min longitude '
            print *,'       (glonmin) is greater than the max '
            print *,'       longitude (glonmax) where both longitudes'
            print *,'       are greater than 0.'
            print *,'       glonmin= ',glonmin
            print *,'       glonmax= ',glonmax
            print *,'  !!! STOPPING....'
            stop 98
          endif
        endif
      elseif (glonmin < 0.0 .and. glonmax >= 0.0) then
        ! An example of this is the MPAS data, which starts and ends
        ! at the dateline and is specified as glonmin=-179.875,
        ! glonmax=179.875.  Convert to be positive and go from 
        ! 180.125 to 539.875.
        if (verb .ge. 3) then
          print *,' '
          print *,'NOTE: glonmin is < 0, glonmax > 0, so glonmin'
          print *,'      will be converted to be > 0 and 360 will'
          print *,'      be added to glonmax.'
          print *,'      BEFORE CONVERSION: '
          print *,'         glonmin= ',glonmin
          print *,'         glonmax= ',glonmax
        endif
        glonmin = 360. - abs(glonmin)
        glonmax = 360. + abs(glonmax)
        if (verb .ge. 3) then
          print *,'      AFTER CONVERSION: '
          print *,'         glonmin= ',glonmin
          print *,'         glonmax= ',glonmax
        endif
      elseif (glonmin < 0.0 .and. glonmax < 0.0) then
        ! Examples of this are GFDL and HWRF.  In this case, make
        ! both glonmin and glonmax positive.
        if (verb .ge. 3) then
          print *,' '
          print *,'NOTE: glonmin is < 0 and glonmax < 0, so both'
          print *,'      will be converted to be > 0.'
          print *,'      BEFORE CONVERSION: '
          print *,'         glonmin= ',glonmin
          print *,'         glonmax= ',glonmax
        endif
        glonmin = 360. - abs(glonmin)
        glonmax = 360. - abs(glonmax)
        if (verb .ge. 3) then
          print *,'      AFTER CONVERSION: '
          print *,'         glonmin= ',glonmin
          print *,'         glonmax= ',glonmax
        endif
      elseif (glonmin >= 0.0 .and. glonmax < 0.0) then
        ! An example of this is the GFS data, which goes from 
        ! glonmin=0.0 to glonmax=-0.5.  Convert it here to go
        ! from glonmin=0.0 to glonmax=359.5
        if (verb .ge. 3) then
          print *,' '
          print *,'NOTE: glonmin is >= 0 and glonmax < 0, so'
          print *,'      glonmax will be converted to be > 0.'
          print *,'      BEFORE CONVERSION: '
          print *,'         glonmin= ',glonmin
          print *,'         glonmax= ',glonmax
        endif
        glonmax = 360. - abs(glonmax)
        if (verb .ge. 3) then
          print *,'      AFTER CONVERSION: '
          print *,'         glonmin= ',glonmin
          print *,'         glonmax= ',glonmax
        endif
      endif

c17Jul2014      if (glonmin < 0.0) then
c17Jul2014        glonmin = 360. - abs(glonmin)
c17Jul2014        if (glonmax <= 0.0) then
c17Jul2014          glonmax = 360. - abs(glonmax)
c17Jul2014        else
c17Jul2014          glonmax = 360 + abs(glonmax)
c17Jul2014        endif
c17Jul2014      endif

      if (glatmax < glatmin) then
        temp    = glatmax
        glatmax = glatmin
        glatmin = temp
      endif

      if (glonmin > 200.0 .and. glonmin <= 360.) then
        if (glonmax < 50.) then
          ! Likely GM-wrapping in current record
          glonmax = glonmax + 360.
        endif
      endif
c
      if ( verb .ge. 3 ) then
        print *,' '
        print *,'Data Grid Lat/Lon boundaries follow:'
        write (6,81) glatmin,glonmin
 81     format (' Min Lat: ',f8.3,'  Min Lon: ',f8.3)
        write (6,83) glatmax,glonmax
 83     format (' Max Lat: ',f8.3,'  Max Lon: ',f8.3)
        print *,' '
        print *,'NOTE: For regional grids, valid data points might'
        print *,'NOT extend all the way to the gds-defined grid '
        print *,'boundary, due to the fact that data have been '
        print *,'interpolated from a NPS or Lamb-Conf grid onto a '
        print *,'lat/lon grid.  This program checks the logical '
        print *,'bitmap for valid data points, but just keep this in'
        print *,'mind if trying to debug errors that occur near the'
        print *,'grid boundaries for regional models.'
      endif

c     ----------------------------------------------------------------
c     Fill glat and glon with the lat & lon values for the grid.  This
c     info will be used in subroutine  barnes

      if (allocated(glat)) deallocate(glat)
      if (allocated(glon)) deallocate(glon)

      allocate (glat(jmax),stat=ija)
      allocate (glon(imax),stat=iia)
      if (ija /= 0 .or. iia /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in getgridinfo allocating glon or glat'
          print *,'!!! ija = ',ija,' iia= ',iia
        endif

        if (allocated(lb)) deallocate (lb,stat=ila)
        if (allocated(f))  deallocate (f,stat=ifa)

        if (ila /= 0 .or. ifa /= 0) then
          print *,' '
          print *,'!!! ERROR in getgridinfo deallocating arrays.'
          print *,'!!! ila= ',ila,' ifa= ',ifa
          print *,'!!! EXITING....'
          stop 98
        endif

        iggret = 96
        return
      endif

      do j=1,jmax
        glat(j) = glatmax - (j-1)*dy
      enddo
      do i=1,imax
        glon(i) = glonmin + (i-1)*dx
      enddo

      if (allocated(lb)) deallocate (lb,stat=ila)
      if (allocated(f))  deallocate (f,stat=ifa)

      if (ila /= 0 .or. ifa /= 0) then
        print *,' '
        print *,'!!! ERROR in getgridinfo deallocating arrays.'
        print *,'!!! ila= ',ila,' ifa= ',ifa
        print *,'!!! EXITING....'
        stop 98
      endif

c     --------------------------------------------------------------
c     Finally, check to see if the requested boundary limits that
c     the user input are contained within this grid (for example, 
c     someone running this tracker on a regional grid may have 
c     forgotten to change the input grid bounds from a global grid 
c     run).  Modify the user-input bounds as needed.  
c
c     NOTE: Only check these bounds for a genesis run on a regional
c     grid, whether that be a 'midlat' or a 'tcgen' run.

      if (trkrinfo%gridtype == 'regional' .and. 
     &    trkrinfo%type /= 'tracker') then

        if (trkrinfo%eastbd > glonmax) then
          xhold = trkrinfo%eastbd
          trkrinfo%eastbd = glonmax - 5.0
          
          if ( verb .ge. 3 ) then
            write (6,90)
            write (6,91)
            write (6,92)
            write (6,93)
            write (6,94)
            write (6,95)
            write (6,96)
            write (6,97) 'EASTERN LONGITUDE'
            write (6,98) xhold
            write (6,99) trkrinfo%eastbd
            write (6,91)
          endif

        endif

        if (trkrinfo%westbd < glonmin) then
          xhold = trkrinfo%westbd
          trkrinfo%westbd = glonmin + 5.0

          if ( verb .ge. 3 ) then
            write (6,90)
            write (6,91)
            write (6,92)
            write (6,93)
            write (6,94)
            write (6,95)
            write (6,96)
            write (6,97) 'WESTERN LONGITUDE'
            write (6,98) xhold
            write (6,99) trkrinfo%westbd
            write (6,91)
          endif

        endif

        if (trkrinfo%northbd > glatmax) then
          xhold = trkrinfo%northbd
          trkrinfo%northbd = glatmax - 5.0
          if ( verb .ge. 3 ) then
            write (6,90)            
            write (6,91)
            write (6,92)
            write (6,93)
            write (6,94)
            write (6,95)
            write (6,96)
            write (6,97) 'NORTHERN LATITUDE'
            write (6,98) xhold            
            write (6,99) trkrinfo%northbd
            write (6,91)
          endif

        endif

        if (trkrinfo%southbd < glatmin) then
          xhold = trkrinfo%southbd
          trkrinfo%southbd = glatmin + 5.0

          if ( verb .ge. 3 ) then
            write (6,90)            
            write (6,91)
            write (6,92)
            write (6,93)
            write (6,94)
            write (6,95)
            write (6,96)
            write (6,97) 'SOUTHERN LATITUDE'
            write (6,98) xhold            
            write (6,99) trkrinfo%southbd
            write (6,91)
          endif

        endif

      endif

  90  format (///)
  91  format (' *********************************************')
  92  format (' WARNING: A USER-REQUESTED BOUNDARY IS BEYOND')
  93  format (' THE BOUNDARY OF THE DATA, AS DEFINED IN THE ')
  94  format (' GRIB FILE.  THE USER BOUNDARY WILL BE MODIFIED')
  95  format (' TO MATCH THE BOUNDARY OF THE DATA FILE.')
  96  format (' ')
  97  format (' USER-INPUT BOUNDARY AT FAULT: ',A20)
  98  format (' USER-INPUT BOUNDARY VALUE: ',f8.2)
  99  format (' NEW BOUNDARY VALUE: ',f8.2)

c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine getgridinfo_netcdf (ncfile_id,imax,jmax,dx,dy
     &                   ,trkrinfo,need_to_flip_lats,need_to_flip_lons
     &                   ,inp,netcdfinfo,iggret)
c
c     ABSTRACT: The purpose of this subroutine is just to get the max
c     values of i and j and the dx and dy grid spacing intervals for the
c     grid to be used in the rest of the program.  So just query the 
c     netcdf file to get the lon and lat data.  Also, get the info for 
c     the data grid's boundaries.  This boundary information will be 
c     used later in the tracking algorithm, and is accessed via Module 
c     grid_bounds.
c
      USE grid_bounds; USE trkrparms; USE inparms
      USE verbose_output; USE netcdf_parms

      implicit none
c
      type (trackstuff) trkrinfo
      type (netcdfstuff) netcdfinfo
      type (datecard) inp

      logical(1) :: need_to_flip_lats,need_to_flip_lons
      real      xhold,xlondiff,xlatdiff
      real, allocatable :: tmplon(:),tmplat(:)
      real, intent(out) :: dx,dy
      integer   iscanflag,iggret
      integer, intent(in)  :: ncfile_id
      integer, intent(out) :: imax,jmax
      integer :: iia,ija,midi,midj,i,j,iix,jix
c

      iggret = 0

      call get_ncdim1(ncfile_id,netcdfinfo%lon_name,imax)
      call get_ncdim1(ncfile_id,netcdfinfo%lat_name,jmax)

      if (allocated(tmplon)) deallocate (tmplon)
      if (allocated(tmplat)) deallocate (tmplat)
      allocate (tmplon(imax),stat=iia)
      allocate (tmplat(jmax),stat=ija)
      if (iia /= 0 .or. ija /= 0) then
        print *,' '
        print *,'!!! ERROR in sub getgridinfo_netcdf allocating arrays.'
        print *,'!!! iia = ',iia,' ija= ',ija
        iggret = 94
        return
      endif

      if (verb .ge. 1) then
        print *,'in getgridinfo_netcdf, ncfile_id= ',ncfile_id
      endif

      call get_var1_double (ncfile_id,netcdfinfo%lon_name,imax,tmplon)
      call get_var1_double (ncfile_id,netcdfinfo%lat_name,jmax,tmplat)

c     Compute the dx and dy by picking values out of the middle of 
c     the lat and lon arrays....

      midi = imax/2
      midj = jmax/2

      dx = abs(tmplon(midi) - tmplon(midi-1))
      dy = abs(tmplat(midj) - tmplat(midj-1))

      if (verb .ge. 1) then
        print *,' '
        print *,'In getgridinfo, grid dimensions follow:'
        print *,'imax= ',imax,' jmax= ',jmax
        print *,'dx=   ',dx,' dy= ',dy
        print *,' '
        write (6,112) midi,dx
        write (6,113) midj,dy

 112    format(1x,' DX:  midi= ',i4,' dx= ',f8.4)
 113    format(1x,' DY:  midj= ',i4,' dy= ',f8.4)
      endif


c     ------------------------------------------------------------------
c     Get boundaries of the data grid.  Note that it is possible to have
c     an input grid which goes from south to north (in fact, it appears
c     that many NetCDF files are constructed this way).  Keep in mind,
c     however, that the  tracker has been written such that point (1,1)
c     should be the upper-leftmost point on the grid, while point 
c     (imax,jmax) should be the lower-rightmost point.  If we check and
c     find that we're dealing with data that instead starts from the 
c     south and increases northward, we flip the data in subroutine 
c     conv1d2d_real.  Similarly here, we make sure to test so that when
c     we are done in this routine, glatmax refers to the northernmost
c     latitude and glatmin the southernmost latitude.

      if (tmplon(imax) > tmplon(1)) then
        glonmin = tmplon(1)
        glonmax = tmplon(imax)
      else
        glonmin = tmplon(imax)
        glonmax = tmplon(1)
      endif

      if (tmplat(1) > tmplon(jmax)) then
        glatmax = tmplat(1)
        glatmin = tmplat(jmax)
      else
        glatmax = tmplat(jmax)
        glatmin = tmplat(1)
      endif

      print *,' '
      print *,'Data Grid Lat/Lon boundaries follow:'
      write (6,81) glatmin,glonmin
  81  format (' Min Lat: ',f8.3,'  Min Lon: ',f8.3)
      write (6,83) glatmax,glonmax
  83  format (' Max Lat: ',f8.3,'  Max Lon: ',f8.3)

c     ----------------------------------------------------------------
c     Fill glat and glon with the lat & lon values for the grid.  This
c     info will be used in subroutine  barnes

      if (allocated(glon)) deallocate (glon)
      if (allocated(glat)) deallocate (glat)

      allocate (glat(jmax),stat=ija) 
      allocate (glon(imax),stat=iia)
      if (ija /= 0 .or. iia /= 0) then
        print *,' '
        print *,'!!! ERROR in getgridinfo allocating glon or glat'
        print *,'!!! ija = ',ija,' iia= ',iia
        iggret = 96
        return
      endif

      ! If the lat or lon grids are flipped (i.e., the lats increase 
      ! from south to north, or the lons increase westward), then we 
      ! will need to flip both the data arrays as well as the arrays
      ! that are holding the values of the lats and lons....

      need_to_flip_lats = .false.
      need_to_flip_lons = .false.

      if (tmplat(1) > tmplon(jmax)) then
        do j=1,jmax
          glat(j) = tmplat(j)
        enddo
      else
        do j=1,jmax
          jix = jmax - j + 1
          glat(jix) = tmplat(j)
        enddo
        need_to_flip_lats = .true.
      endif

      if (tmplon(imax) > tmplon(1)) then
        do i=1,imax
          glon(i) = tmplon(i)
        enddo
      else
        do i=1,imax
          iix = imax - i + 1
          glon(iix) = tmplon(i)
        enddo
        need_to_flip_lons = .true.
      endif

c      do i = 1,imax
c        print *,'i= ',i,' glon(i)= ',glon(i)
c      enddo
c      do j = 1,jmax
c        print *,'j= ',j,' glat(j)= ',glat(j)
c      enddo

c     ---------------------------------------------------------------
c     Finally, check to see if the requested boundary limits that
c     the user input are contained within this grid (for example, 
c     someone running this tracker on a regional grid may have forgotten
c     to change the input grid bounds from a global grid run).  Modify 
c     the user-input bounds as needed.
c
c     NOTE: Only check these bounds for a genesis run on a regional
c     grid, whether that be a 'midlat' or a 'tcgen' run.

      if (trkrinfo%gridtype == 'regional' .and.
     &    trkrinfo%type /= 'tracker') then

        if (trkrinfo%eastbd > glonmax) then
          xhold = trkrinfo%eastbd
          trkrinfo%eastbd = glonmax - 5.0
          write (6,90)
          write (6,91)
          write (6,92)
          write (6,93)
          write (6,94)
          write (6,95)
          write (6,96)
          write (6,97) 'EASTERN LONGITUDE'
          write (6,98) xhold
          write (6,99) trkrinfo%eastbd
          write (6,91)
        endif

        if (trkrinfo%westbd < glonmin) then
          xhold = trkrinfo%westbd
          trkrinfo%westbd = glonmin + 5.0
          write (6,90)
          write (6,91)
          write (6,92)
          write (6,93)
          write (6,94)
          write (6,95)
          write (6,96)
          write (6,97) 'WESTERN LONGITUDE'
          write (6,98) xhold
          write (6,99) trkrinfo%westbd
          write (6,91)
        endif

        if (trkrinfo%northbd > glatmax) then
          xhold = trkrinfo%northbd
          trkrinfo%northbd = glatmax - 5.0
          write (6,90)            
          write (6,91)
          write (6,92)
          write (6,93)
          write (6,94)
          write (6,95)
          write (6,96)
          write (6,97) 'NORTHERN LATITUDE'
          write (6,98) xhold            
          write (6,99) trkrinfo%northbd
          write (6,91)
        endif

        if (trkrinfo%southbd < glatmin) then
          xhold = trkrinfo%southbd
          trkrinfo%southbd = glatmin + 5.0
          write (6,90)            
          write (6,91)
          write (6,92)
          write (6,93)
          write (6,94)
          write (6,95)
          write (6,96)
          write (6,97) 'SOUTHERN LATITUDE'
          write (6,98) xhold            
          write (6,99) trkrinfo%southbd
          write (6,91)
        endif

      endif

  90  format (///)
  91  format (' *********************************************')
  92  format (' WARNING: A USER-REQUESTED BOUNDARY IS BEYOND')
  93  format (' THE BOUNDARY OF THE DATA, AS DEFINED IN THE ')
  94  format (' GRIB FILE.  THE USER BOUNDARY WILL BE MODIFIED')
  95  format (' TO MATCH THE BOUNDARY OF THE DATA FILE.')
  96  format (' ')
  97  format (' USER-INPUT BOUNDARY AT FAULT: ',A20)
  98  format (' USER-INPUT BOUNDARY VALUE: ',f8.2)
  99  format (' NEW BOUNDARY VALUE: ',f8.2)

c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine read_netcdf_hours (ncfile,ncfile_id,ncfile_tmax,ifhmax
     &                            ,ncfile_has_hour0,netcdfinfo,irnhret)
c
c     ABSTRACT: The purpose of this subroutine is to read the "time"
c     dimension and "time data" from the NetCDF file so that we know
c     how many time levels there are and what those time levels are.
c     One reason for doing this is that some models, like the GFDL
c     FV3, do not output hour 0 data, so we need to check this first
c     before running through the tracking processing for the various 
c     hours.  We will take the list of hours read in here directly from
c     the NetCDF file and compare that against the *requested* list of 
c     forecast hours that the user has entered.  The user might not be 
c     aware that there is no hour 0 data for a given model.  We compare
c     these two lists of forecast hours and then write a message if 
c     there is a lead time that is not in the NetCDF file.
c   
c     INPUT:
c     ncfile     character name of NetCDF file
c     ncfile_id  integer id associated with NetCDF file after open
c     ifhmax     integer max number of lead times that the user has 
c                requested on the input lead times data file.  This
c                value was set in subroutine read_fhours.
c     netcdfinfo variable of user-defined type netcdfstuff (from 
c                module netcdf_parms).
c
c     OUTPUT:
c     ncfile_tmax integer max number of lead times that are in the 
c                 NetCDF file, as read in from this subroutine
c     ncfile_has_hour0 character flag (y|n) that tells whether or not 
c                 the input NetCDF data file actually has an hour0 
c                 record in it or not.
c
      USE netcdf_parms; USE tracked_parms; USE verbose_output

      implicit none
c
      type (netcdfstuff) netcdfinfo

      character :: ncfile*180,ncfile_has_hour0*1,match_check*1
      integer, intent(in)  :: ncfile_id
      integer, intent(out) :: ncfile_tmax
      integer :: infta,k,m,n,ifhmax,irnhret,usertime
c

      irnhret = 0
      ncfile_has_hour0 = 'n'

      !-----------------------------------------------------------
      ! First read the NetCDF file to get the number of time levels,
      ! which will be returned in "ncfile_tmax"....
      !-----------------------------------------------------------

      print *,' '
      print *,'in read_netcdf_hours...'
      print *,'ncfile_id= ',ncfile_id
      print *,'netcdfinfo%time_name= ',netcdfinfo%time_name
      print *,'ncfile_tmax= ',ncfile_tmax

      call get_ncdim1(ncfile_id,netcdfinfo%time_name,ncfile_tmax)

      if (verb .ge. 1) then
        print *,'in getgridinfo_netcdf, ncfile_id= ',ncfile_id
        print *,'Num netcdf time levs=  ncfile_tmax= ',ncfile_tmax
      endif

      if (allocated(netcdf_file_time_values)) then
        deallocate (netcdf_file_time_values)
      endif

      allocate (netcdf_file_time_values(ncfile_tmax),stat=infta)
      if (infta /= 0) then
        print *,' '
        print *,'!!! ERROR in sub read_netcdf_hours allocating'
        print *,'!!! netcdf_file_time_values array.  infta = ',infta
        irnhret = 94
        return
      endif


      !-----------------------------------------------------------
      ! Now read in the actual time values that are stored in the 
      ! NetCDF file....
      !-----------------------------------------------------------

      call get_var1_double (ncfile_id,netcdfinfo%time_name,ncfile_tmax
     &                     ,netcdf_file_time_values)

      if (verb .ge. 1) then
        do k = 1,ncfile_tmax
          print *,'k= ',k,' netcdf_file_time_values(k)= '
     &                     ,netcdf_file_time_values(k)
        enddo
      endif

      !------------------------------------------------------------
      ! Now convert the NetCDF time values into minutes in order to 
      ! be able to compare with the user-requested list of lead 
      ! times.  Remember that the NetCDF lead times will be listed
      ! either as hours or as fractions of days.
      !------------------------------------------------------------

      if (allocated(nctotalmins)) then
        deallocate (nctotalmins)
      endif 

      allocate (nctotalmins(ncfile_tmax),stat=infta)
      if (infta /= 0) then
        print *,' ' 
        print *,'!!! ERROR in sub read_netcdf_hours allocating '
        print *,'!!! nctotalmins array.  infta = ',infta
        irnhret = 94
        return
      endif

      do k = 1,ncfile_tmax

        if (netcdfinfo%time_units == 'hours') then
          nctotalmins(k) = int(netcdf_file_time_values(k)) * 60
        elseif (netcdfinfo%time_units == 'days') then
          nctotalmins(k) = int(netcdf_file_time_values(k) * 60. * 24.)
        else
          print *,' '
          print *,'!!! ERROR: In read_netcdf_hours, the value of'
          print *,'    netcdfinfo%time_units is neither hours nor days.'
          print *,'    netcdfinfo%time_units= ',netcdfinfo%time_units
          print *,'    STOPPING....'
          print *,' '
          stop 99
        endif
 
        if (verb .ge. 1) then
          write (6,71) k,netcdf_file_time_values(k),nctotalmins(k)
        endif

      enddo

   71 format (1x,i5,'  netcdf_file_time_values(k)= ',f8.4
     &             ,'  nctotalmins(k)= ',i10)

      !------------------------------------------------------------
      ! Now go through the list of user-requested lead times that 
      ! were read in from subroutine read_fhours and try to match
      ! the two lists up.  The big one to watch out for is whether
      ! or not the NetCDF file actually has an hour 0 lead time.
      !------------------------------------------------------------

      userloop: do n = 1,ifhmax
  
        usertime = iftotalmins(n)

        match_check = 'n'

        netcdfloop: do m = 1,ncfile_tmax

          if (usertime == nctotalmins(m)) then
            if (verb .ge. 1) then
              print *,'+++ Time match for usertime= ',usertime
            endif
            match_check = 'y'
          endif
        
        enddo netcdfloop 

        if (match_check == 'n') then

          if (usertime == 0) then
            print *,' '
            print *,'Warning: For a NetCDF file, the user has requested'
            print *,'to read in an hour 0 file, however a scan of the'
            print *,'time data values in the NetCDF file indicates'
            print *,'that there is no hour 0 data in this file. '
            print *,'We will substitute either missing values or '
            print *,'the values from the TC Vitals data in the '
            print *,'hour 0 record and then start searching at the '
            print *,'next lead time.'
            ncfile_has_hour0 = 'n'
          else
            print *,' '
            print *,'!!! ERROR: For a NetCDF file, the user has'
            print *,'  requested to process a particular lead time that'
            print *,'  does not exist in the NetCDF list of time '
            print *,'  values.'
            print *,'  n= ',n
            print *,'  usertime= iftotalmins(n)= ',iftotalmins(n)
            print *,'  STOPPING....'
            stop 99
          endif

        elseif (match_check == 'y') then

          if (usertime == 0) then
            if (verb .ge. 1) then
              print *,' ' 
              print *,'+++ For the input NetCDF file, an hour0 data '
              print *,'    record exists in the data file.'
            endif
            ncfile_has_hour0 = 'y'
          endif

        endif

      enddo userloop 
c
      return
      end
c
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine check_valid_point (imax,jmax,dx,dy,fxy,cmaxmin
     &        ,valid_pt,rlont,rlatt,grid_maxlat,grid_minlat,grid_maxlon
     &        ,grid_minlon,trkrinfo,icvpret)
c
c     ABSTRACT: This subroutine checks to see if the input lat/lon
c     point is associated with four surrounding (i,j) locations that
c     have valid data.  The writing of this routine was prompted by the
c     HFIP project in February, 2009.  Some of their high resolution
c     data for their inner nests contained grids that had been rotated
c     from native map projections to regular lat/lon grids, but that
c     rotation left "empty" spots on the lat/lon grid where there is
c     no data.  Then when searching in find_maxmin, we were running
c     barnes iterations from these lat/lon locations where there was
c     no data, which would give artificially low values at those
c     lat/lon locations (because the barnes scheme would only include
c     points that were relatively far away where there was valid data).
c     So in this routine, we call subroutine  fix_latlon_to_ij in order
c     to get the nearest (i,j) coordinates, and then we check all of
c     these points to make sure that valid data exist.
c
c     INPUT:
c     imax     Num pts in i-direction on grid
c     jmax     Num pts in j-direction on grid
c     dx       grid spacing in i-direction
c     dy       grid spacing in j-direction
c     fxy      real array of input data values
c     cmaxmin  character that tells if searching for max or min
c     valid_pt Logical; bitmap indicating if valid data at that pt
c     rlatt,rlont    input lat/lon about which we will check the
c              surrounding (i,j) locations for valid data.
c     grid_maxlat northernmost latitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_minlat southernmost latitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_maxlon easternmost longitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     grid_minlon westernmost longitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset.
c     trkrinfo derived type containing grid info on user boundaries
c
c     OUTPUT:
c     icvpret  return code from this routine.  A value of 0 means that
c              all is okay and the input point is surrounded by valid
c              data.

      USE trkrparms

      implicit none
c
      type (trackstuff) trkrinfo

      integer    imax,jmax,ifix,jfix
      integer    ifilret,icvpret
      character(*)  cmaxmin
      logical(1) valid_pt(imax,jmax)
      real       fxy(imax,jmax)
      real       rlont,rlatt,xdum,gridpoint_maxmin
      real       dx,dy,grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
c
      call fix_latlon_to_ij (imax,jmax,dx,dy,fxy,cmaxmin
     &        ,valid_pt,rlont,rlatt
     &        ,xdum,ifix,jfix,gridpoint_maxmin,'checker'
     &        ,grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
     &        ,trkrinfo,ifilret)

      if (ifilret /= 0) then
        icvpret = 99
        return
      endif

      if (valid_pt(ifix,jfix)) then
        icvpret = 0
      else
        icvpret = 99
      endif
c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine fix_latlon_to_ij (imax,jmax,dx,dy,fxy,cmaxmin
     &                 ,valid_pt,parmlon,parmlat,xdataval
     &                 ,ifix,jfix,gridpoint_maxmin,ccall
     &                 ,grid_maxlat,grid_minlat,grid_maxlon,grid_minlon
     &                 ,trkrinfo,ifilret)
c
c     ABSTRACT: This subroutine takes an input lat/lon position and
c     assigns it to a nearby (i,j) gridpoint.  If this is being used
c     before the call to check_closed_contour after the  barnes analysis
c     to see if we have a storm or not, then the lat/lon position that
c     is input into this subroutine is one which was obtained from a
c     barnes analysis, so it is essentially an area-weighted average
c     of nearby points.  What we need to do in this subroutine is find
c     the actual nearby gridpoint which does have the actual raw max or
c     min value.  Then we return the (i,j) coordinates of that point as
c     well as that raw data value at that point.
c
c     INPUT:
c     imax     Num pts in i-direction on grid
c     jmax     Num pts in j-direction on grid
c     dx       grid spacing of the data grid in i-direction
c     dy       grid spacing of the data grid in j-direction
c     fxy      real array of input data values
c     cmaxmin  character that tells if searching for max or min
c     valid_pt Logical; bitmap indicating if valid data at that pt
c     parmlon  lon at which input parameter center was found, or the lon
c              for the mean storm center fix (check calling routine)
c     parmlat  lat at which input parameter center was found, or the lat
c              for the mean storm center fix (check calling routine)
c     xdataval barnes-obtained value of parameter at (parmlon,parmlat)
c     ccall    character that tells if this call is part of a tracker 
c              fix routine or just from the check_valid_point routine 
c              ('tracker' or 'checker')
c     grid_maxlat northernmost latitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset, or it may be the 
c              original grid itself.
c     grid_minlat southernmost latitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset, or it may be the 
c              original grid itself.
c     grid_maxlon easternmost longitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset, or it may be the 
c              original grid itself.
c     grid_minlon westernmost longitude on the input grid being sent to
c              this routine.  This grid may be a subset of the original
c              full grid from the original dataset, or it may be the 
c              original grid itself.
c     trkrinfo derived type containing grid info on user boundaries
c
c     OUTPUT:
c     ifix     i-index for gridpoint to which the max or min is assigned
c     jfix     j-index for gridpoint to which the max or min is assigned
c     gridpoint_maxmin  value of fxy at (ifix,jfix).  This will be
c              different from the input value xdataval, which came from
c              the  barnes averaging.  This is the raw value at the
c              gridpoint.

      USE grid_bounds; USE trkrparms
      USE verbose_output

      implicit none
c
      type (trackstuff) trkrinfo

      integer    imax,jmax,istart,iend,jstart,jend,ifix,jfix
      integer    ipfix,jpfix,i,j,ifilret,iix,jix,grfact
      character(*)  cmaxmin,ccall
      logical(1) valid_pt(imax,jmax)
      real       fxy(imax,jmax)
      real       parmlon,parmlat,xdataval,gridpoint_maxmin
      real       xplon,yplat,dmin,dmax,dx,dy,grdspc
      real       grid_maxlat,grid_minlat,grid_maxlon,grid_minlon

      ifilret = 0

c      print *,' '
c      print *,'-------------------------------------------- '
c      print *,'Top of fix_latlon_to_ij, call type = ',ccall
c      print *,'parmlon= ',parmlon,' parmlat= ',parmlat
c      print *,'max lon = ',grid_maxlon,' max lat = ',grid_maxlat
c      print *,'min lon = ',grid_minlon,' min lat = ',grid_minlat

c     Fix parmlat to the *nearest* j-point (i.e., round it....)

      if (parmlat >= 0.0) then    ! N. Hemisphere
        jpfix = int((grid_maxlat - parmlat)/dy + 1.0 + 0.5)
      else                        ! S. Hemisphere
        jpfix = ceiling((grid_maxlat - parmlat)/dy + 1.0 - 0.5)
      endif

c     Fix parmlon to the *nearest* i-point (i.e., round it....)
      
      ipfix = int((parmlon - grid_minlon)/dx + 1.0 + 0.5)
      
c     Calculate the longitude and latitude of these ipfix and
c     jpfix points....
      
      xplon = grid_minlon + (ipfix-1)*dx
      yplat = grid_maxlat - (jpfix-1)*dy
      
c     We want to do a simple search in the very few points around
c     this (ipfix,jpfix) point to find the raw max or min data
c     value.  First we need to set up a 4x4 box to search:
c     
c               o     o     o     o
c     
c     
c               o     a     b     o
c                      +
c     
c               o     c     d     o
c     
c     
c               o     o     o     o
c     
c     In the above diagram, if "+" is the lat/lon location of our
c     barnes-found point (i.e., the input (parmlon,parmlat)), and
c     a-b-c-d is the square of points surrounding "+", we only want
c     to look out 1 layer of points further.  So first we need to
c     know, for each case we're looking at, if "+" got assigned to
c     a or b or c or d.  By the way, if the parmlon falls directly
c     on a gridpoint in either the i or j direction, we will only
c     look at the 2 gridpoints on either side of that point, as
c     opposed to having 4 points set up as in the box above.
c
c     UPDATE (4-Feb-2011): For fine resolution grids, it is 
c     possible to have the gridpoint max/min be more than 1 or 2 grid
c     points away from the barnes-averaged max.  So allow for this
c     here, with a check of grdspc ((dx+dy)/2) below and the 
c     addition of the "grfact" multiplier for fine resolution grids.

c      print *,'ipfix= ',ipfix,' xplon= ',xplon
c      print *,'jpfix= ',jpfix,' yplat= ',yplat

       grdspc = (dx+dy)*0.5
       if (grdspc <= 0.025) then
         grfact = 20
       else if (grdspc > 0.025 .and. grdspc <= 0.05) then
         grfact = 12
       else if (grdspc > 0.05  .and. grdspc <= 0.10) then
         grfact = 6
       else if (grdspc > 0.10  .and. grdspc <= 0.20) then
         grfact = 3
       else if (grdspc > 0.20  .and. grdspc <= 0.30) then
         grfact = 2
       else
         grfact = 1
       endif
      
      if (xplon < parmlon) then         !(ipfix is at either a or c)
        istart = ipfix - (1*grfact)
        iend   = ipfix + (2*grfact)
      else if (xplon > parmlon) then    !(ipfix is at either b or d)
        istart = ipfix - (2*grfact)
        iend   = ipfix + (1*grfact)
      else if (xplon == parmlon) then   !(parmlon is exactly ipfix)
        istart = ipfix - (1*grfact)
        iend   = ipfix + (1*grfact)
      endif

      if (yplat < parmlat) then         !(jpfix is at either c or d)
        jstart = jpfix - (2*grfact)
        jend   = jpfix + (1*grfact)
      else if (yplat > parmlat) then    !(jpfix is at either a or b)
        jstart = jpfix - (1*grfact)
        jend   = jpfix + (2*grfact)
      else if (yplat == parmlat) then   !(parmlat is exactly jpfix)
        jstart = jpfix - (1*grfact)
        jend   = jpfix + (1*grfact)
      endif

c      print *,'istart= ',istart,' iend= ',iend
c      print *,'jstart= ',jstart,' jend= ',jend
c      print *,' '

c     Make sure the edges of our box are within the grid bounds...

      if (jstart > jmax ) then

        if ( verb .ge. 1 ) then
          print *,'!!! ERROR in fix_latlon_to_ij, jstart > jmax'
          print *,'!!! ',ccall,'  jstart = ',jstart,' jmax= ',jmax
        endif


        ifilret = 99
        return
      endif
      if (jend < 1) then

        if ( verb .ge. 1 ) then
          print *,'!!! ERROR in fix_latlon_to_ij, ',ccall
     &         ,' jend < 1, jend = ',jend
        endif

        ifilret = 99
        return
      endif
      if (jstart < 1) jstart = 1
      if (jend > jmax) jend = jmax

      if (istart > imax ) then
        if (trkrinfo%gridtype == 'global') then
          continue  ! GM wrapping will be handled in loop below...
        else

          if ( verb .ge. 1 ) then
            print *,'!!! ERROR in fix_latlon_to_ij, istart > imax'
            print *,'!!! istart = ',istart,' imax= ',imax
          endif

          ifilret = 99
          return
        endif
      endif

      if (iend < 1) then
        if (trkrinfo%gridtype == 'global') then
          continue  ! GM wrapping will be handled in loop below...
        else

          if ( verb .ge. 1 ) then
            print *,'!!! ERROR in fix_latlon_to_ij, iend < 1, iend = '
     &           ,iend,' call type = ',ccall
          endif

          ifilret = 99
          return
        endif
      endif

      if (iend > imax) then
        if (trkrinfo%gridtype == 'global') then
          continue  ! GM wrapping will be handled in loop below...
        else
          iend = imax  ! For a regional grid, just cut it off
        endif
      endif

      if (istart < 1) then
        if (trkrinfo%gridtype == 'global') then
          continue  ! GM wrapping will be handled in loop below...
        else
          istart = 1  ! For a regional grid, just cut it off
        endif
      endif

c     Now look for the max or min value....

      dmax = -9.99e12
      dmin =  9.99e12
      ifix = ipfix
      jfix = jpfix

      do iix = istart,iend
        do jix = jstart,jend

          i = iix
          j = jix

          if (i < 1) then
            i = iix + imax  !GM wrapping
          endif
          if (i > imax) then
            i = iix - imax  !GM wrapping
          endif

          if (valid_pt(i,j)) then
            continue
          else      

            if ( verb .ge. 1 ) then
              print *,' '
              print *,'!!! ERROR: In fix_latlon_to_ij, we tried to '
              print *,'!!! access an invalid data point.'
              print *,'!!! ',ccall,' i= ',i,' j= ',j
              print *,'!!! ipfix= ',ipfix,' jpfix= ',jpfix
              print *,'!!! parmlon= ',parmlon,' parmlat= ',parmlat
              print *,' '
            endif

            ifilret = 98
            return
          endif
            
          if (cmaxmin == 'min') then
            if (fxy(i,j) < dmin) then
              dmin = fxy(i,j)
              ifix = i
              jfix = j
            endif
          else
            if (fxy(i,j) > dmax) then
              dmax = fxy(i,j)
              ifix = i
              jfix = j
            endif
          endif

        enddo
      enddo 
            
      if (cmaxmin == 'min') then
        gridpoint_maxmin = dmin
      else  
        gridpoint_maxmin = dmax
      endif 

c      print *,'  End of fix_latlon_to_ij, gridpoint_maxmin = '
c     &       ,gridpoint_maxmin

c
      return
      end  
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine rvcal (imax,jmax,dlon,dlat,z,vp)
c
c     ABSTRACT: This routine calculates the relative vorticity (zeta)
c     from u,v on an evenly-spaced lat/lon grid. Centered finite 
c     differences are used on the interior points and one-sided 
c     differences are used on the boundaries.
c
c     NOTE: There are 3 critical arrays in this subroutine, the first
c     being zeta and the 2nd and 3rd being u and v.  There is a 
c     critical difference in the array indexing for the levels.  For
c     zeta, the array is dimensioned with levels from 1 to 3, with 
c     1 = 850, 2 = 700, 3 = sfc.  However, there is an extra level 
c     for the winds, such that the level dimension goes 1 = 850, 
c     2 = 700, 3 = 500, 4 = sfc.  So we need to adjust for that in
c     this routine.
c
c     LOCAL VARIABLES:
c
      USE tracked_parms; USE trig_vals; USE grid_bounds
      USE verbose_output

      implicit none

      dimension cosfac(jmax),tanfac(jmax)
      real      tmpzeta(imax,jmax)
      real      xlondiff,xlatdiff,dlon,dlat,dfix
      real      dlat_edge,dlat_inter,dlon_edge,dlon_inter
      real      rlat(jmax),cosfac,tanfac
      integer   z,iscanflag,nlat,nlon,i,j,imax,jmax,w
      integer   ii,jj
      logical(1) vp(imax,jmax)

c     --------------------------

c     Figure out what level of data we have and what the array 
c     indices should be.

      if (z == 1) then
        ! z = 1 for 850 mb zeta, w = 1 for 850 mb winds
        w = 1  
      else if (z == 2) then
        ! z = 2 for 700 mb zeta, w = 2 for 700 mb winds
        w = 2  
      else if (z == 3) then
        ! z = 3 for sfc zeta, w = 4 for sfc (10m) winds
        w = 4
      endif

c     Calculate grid increments for interior and edge points.

c     IMPORTANT: If dtk is defined in module trig_vals in km, then
c     we need to multiply by 1000 here to get meters.  If it's defined
c     as meters, just let it be.  Since the wind values are given in 
c     meters, that's why we need the dlon values to be in meters.

      if (dtk < 750.) then     ! chances are, dtk was defined as km
        dfix = 1000.0
      else                     ! dtk was already defined as meters
        dfix = 1.0
      endif

      dlon_edge = dtk * dfix * dlon          ! Di dist over 1 grid pt
      dlat_edge = dtk * dfix * dlat          ! Dj dist over 1 grid pt
      dlon_inter = dtk * dfix * 2.0 * dlon   ! Di dist over 2 grid pts
      dlat_inter = dtk * dfix * 2.0 * dlat   ! Dj dist over 2 grid pts


c     Calculate required trig functions.  These are functions of 
c     latitude.  Remember that the grid must go from north to south.
c     This north-to-south requirement has 
c     already been checked in subroutine  getgridinfo.  If necessary,
c     any flipping of the latitudes was done there, and flipping of
c     the data, again if necessary, was done in subroutine  getdata.

      do j=2,jmax-1
         rlat(j) = glatmax - ((j-1) * dlat)
         cosfac(j) = cos(dtr*rlat(j))
         tanfac(j) = (tan(dtr*rlat(j)))/erad
      enddo

c     Set trig factors at end points to closest interior point
c     to avoid a singularity if the domain includes the poles,
c     which it will for the global grids (MRF, GDAS, GFS, UKMET,NCE)

      cosfac(1) = cosfac(2)
      tanfac(1) = tanfac(2)
      cosfac(jmax) = cosfac(jmax-1)
      tanfac(jmax) = tanfac(jmax-1)

c     NOTE: These next bits of vorticity calculation code assume that 
c           the input grid is oriented so that point (1,1) is the upper
c           left-most (NW) and point (imax,jmax) is the lower right-
c           most point.  Any other grids will probably crash the 
c           program due to array out of bounds errors.
c     NOTE: Before each calculation is done, the logical array is 
c           checked to make sure that all the data points in this 
c           calculation have valid data (ie., that the points are not
c           outside a regional model's boundaries).
c
c !!! IMPORTANT NOTE: While testing this, I uncovered a bug, which was
c     that I had the "j+1" and "j-1" reversed.  Just from a physical 
c     understanding, the du/dy term at a point is calculated by taking 
c     the u value north of the point minus the u value south of the 
c     point. Intuitively, this is u(j+1) - u(j-1).  However, we have 
c     designed this program to have the northernmost point as
c     the beginning of the grid (i.e., for the global grids, j=1 at 90N,
c     and j increases southward).  Thus, if you would do u(j+1) -
c     u(j-1), you would actually be taking the u value south of the 
c     point minus the u value north of the point, EXACTLY THE OPPOSITE
c     OF WHAT YOU WANT.  Therefore, the vorticity calculations have
c     been changed so that we now have u(j-1) - u(j+1).
c
c     UPDATE FEB 2009:  With limited domain grids that have missing
c     data on them (such as you would have for a grid that has been
c     converted from a non-lat/lon grid to a lat/lon grid), we were
c     running into problems below with the setting of zeta values to
c     a missing value of -999.  In place of this, the easiest thing to
c     do is to simply assign a value of the background coriolis value
c     to that point.  No, this is not correct, but it is the easiest
c     workaround for this right now.  Setting it to zero would be too
c     far off.  Setting it to the coriolis component has a net effect
c     of not having much impact on the  barnes scheme result.
c
c     ---------------
c     Interior points
c     ---------------
    
      if ( verb .ge. 3 ) then
        print *,'Just before inter rvcalc, dlon_inter = ',dlon_inter
     &       ,' dlat_inter = ',dlat_inter
      endif

      do j=2,jmax-1
       do i=2,imax-1
c
        if (vp(i,j) .and. vp(i+1,j) .and. vp(i-1,j) .and. 
     &      vp(i,j+1) .and. vp(i,j-1)) then
c 
         zeta(i,j,z)= (v(i+1,j,w) - v(i-1,j,w))/(dlon_inter * cosfac(j))
     &               - (u(i,j-1,w) - u(i,j+1,w))/(dlat_inter)
     &               + tanfac(j)*u(i,j,w)

        else
c         zeta(i,j,z)= -999.
         zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
        endif
c
       enddo
      enddo
c
c     -----------------------------
c     Bottom (Southernmost) points
c     -----------------------------
c
      j=jmax
      do i=2,imax-1
c
       if (vp(i,j) .and. vp(i+1,j) .and. vp(i-1,j) .and. 
     &     vp(i,j-1)) then
c
         zeta(i,j,z)= (v(i+1,j,w) - v(i-1,j,w))/(dlon_inter * cosfac(j))
     &              - (u(i,j-1,w) - u(i,j,w))/(dlat_edge) 
     &              + tanfac(j)*u(i,j,w)
       else
c         zeta(i,j,z)= -999.
         zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
       endif
c
      enddo
c
c     --------------------------
c     Top (Northernmost) points
c     --------------------------
c
      j=1
      do i=2,imax-1
c
       if (vp(i,j) .and. vp(i+1,j) .and. vp(i-1,j) .and.  
     &     vp(i,j+1)) then
c
         zeta(i,j,z)= (v(i+1,j,w) - v(i-1,j,w))/(dlon_inter * cosfac(j))
     &              - (u(i,j,w) - u(i,j+1,w))/(dlat_edge)
     &              + tanfac(j)*u(i,j,w)
       else
c         zeta(i,j,z)= -999.
         zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
       endif
c
      enddo
c
c     -------------------------------
c     Left edge (Westernmost) points
c     -------------------------------
c
      i=1
      do j=2,jmax-1
c
       if (vp(i,j) .and. vp(i+1,j) .and. vp(i,j+1) .and.  
     &     vp(i,j-1)) then
c
         zeta(i,j,z) = (v(i+1,j,w) - v(i,j,w))/(dlon_edge * cosfac(j))
     &               - (u(i,j-1,w) - u(i,j+1,w))/(dlat_inter)
     &               + tanfac(j)*u(i,j,w)
       else
c         zeta(i,j,z)= -999.
         zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
       endif
c
      enddo
c
c     --------------------------------
c     Right edge (Easternmost) points
c     --------------------------------
c
      i=imax
      do j=2,jmax-1
c
       if (vp(i,j) .and. vp(i-1,j) .and. vp(i,j+1) .and.  
     &     vp(i,j-1)) then
c
         zeta(i,j,z) = (v(i,j,w) - v(i-1,j,w))/(dlon_edge * cosfac(j))
     &               - (u(i,j-1,w) - u(i,j+1,w))/(dlat_inter)
     &               + tanfac(j)*u(i,j,w)
       else 
c         zeta(i,j,z)= -999.
         zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
       endif
c
      enddo
c
c     ---------
c     SW corner
c     ---------
      i=1
      j=jmax
      if (vp(i,j) .and. vp(i+1,j) .and. vp(i,j-1) ) then 
c
        zeta(i,j,z) = (v(i+1,j,w)-v(i,j,w))/(dlon_edge * cosfac(j))
     &              - (u(i,j-1,w)-u(i,j,w))/(dlat_edge)
     &              + tanfac(j)*u(i,j,w)
      else
c        zeta(i,j,z)= -999.
        zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
      endif
c
c     ---------
c     NW corner
c     ---------
      i=1
      j=1
      if (vp(i,j) .and. vp(i+1,j) .and. vp(i,j+1) ) then
c
        zeta(i,j,z) = (v(i+1,j,w) - v(i,j,w))/(dlon_edge * cosfac(j))
     &              - (u(i,j,w) - u(i,j+1,w))/(dlat_edge)
     &              + tanfac(j)*u(i,j,w)
      else
c        zeta(i,j,z)= -999.
        zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
      endif
c
c     ---------
c     NE corner
c     ---------
      i=imax
      j=1
      if (vp(i,j) .and. vp(i-1,j) .and. vp(i,j+1) ) then
c
        zeta(i,j,z) = (v(i,j,w) - v(i-1,j,w))/(dlon_edge * cosfac(j))
     &              - (u(i,j,w) - u(i,j+1,w))/(dlat_edge)
     &              + tanfac(j)*u(i,j,w)
      else
c        zeta(i,j,z)= -999.
        zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
      endif
c
c     ---------
c     SE corner
c     ---------
      i=imax
      j=jmax
      if (vp(i,j) .and. vp(i-1,j) .and. vp(i,j-1) ) then
c
        zeta(i,j,z) = (v(i,j,w)-v(i-1,j,w))/(dlon_edge * cosfac(j))
     &              - (u(i,j-1,w)-u(i,j,w))/(dlat_edge)
     &              + tanfac(j)*u(i,j,w)
      else
c        zeta(i,j,z)= -999.
        zeta(i,j,z) = 2. * omega * sin(rlat(j)*dtr)
      endif
c
      do ii=1,imax
        do jj=1,jmax
          tmpzeta(ii,jj) = zeta(ii,jj,z) * 1.e5
        enddo
      enddo

      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine thickness_calc (imax,jmax,vp)
c
c     ABSTRACT: This routine calculates the  thicknesses for three 
c     different layers: 200-500, 500-850 and 200-850 mb.
c
c     LOCAL VARIABLES:
c
      USE tracked_parms; USE verbose_output

      implicit none

      integer   i,j,layer,upper,lower,imax,jmax
      logical(1) vp(imax,jmax)

c     --------------------------

c     The array indices for the 3 different thickness layers are
c     as follows:
c       1: 500-850
c       2: 200-500
c       3: 200-850
c
c     The array indices for the levels for the 4 different GP height 
c     arrays (as assigned in subroutine  getdata) are as follows:
c       1: 850 mb
c       2: 700 mb
c       3: 500 mb
c       4: 200 mb


      do layer = 1,3

        select case (layer)
          case (1); upper=3; lower=1;
          case (2); upper=4; lower=3;
          case (3); upper=4; lower=1;
        end select

        do j = 1,jmax
          do i = 1,imax

            if (vp(i,j)) then
              thick(i,j,layer) = hgt(i,j,upper) - hgt(i,j,lower)
            else
              thick(i,j,layer) = -999.0
            endif

          enddo
        enddo

      enddo
c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine first_ges_center (imax,jmax,dx,dy,cparm,fxy
     &            ,cmaxmin,trkrinfo,ifh,valid_pt,maxstorm,masked_out
     &            ,stormct,contour_info,maxmini,maxminj,ifgcret)
c
c     ABSTRACT: This subroutine scans an array and picks out areas of 
c     max or min, then loads those center positions into the first-
c     guess lat & lon arrays to be used by subroutine  tracker for 
c     locating the very specific low center positions.
c
c     INPUT:
c     imax     Number of gridpoints in i direction in input grid
c     jmax     Number of gridpoints in j direction in input grid
c     dx       Grid spacing in i-direction for the input grid
c     dy       Grid spacing in j-direction for the input grid
c     cparm    Char string indicating what parm is being passed in
c     fxy      Real array of data values
c     finf     Logical. Field of influence.  Dimension same as fxy
c     cmaxmin  Char string to indicate if search is for a max or a min
c     trkrinfo Derived type that holds/describes various tracker parms,
c              including the contour interval to be used
c     ifh      Index for the forecast hour
c     valid_pt Logical bitmap masking non-valid grid points.  This is a
c              concern for the regional models, which are interpolated
c              from Lam-Conf or NPS grids onto lat/lon grids, leaving
c              grid points around the edges which have no valid data.
c     maxstorm max # of storms that can be handled in this run
c
c     INPUT/OUTPUT:
c     masked_out Logical. T = data point is already accounted for, under
c                the influence of another nearby max or min center, 
c                F = data point is available to be scanned by this 
c                subroutine for max or min centers.
c     stormct  Integer: keeps and increments a running tab of the number
c              of storms that have been tracked at any time across all
c              forecast hours
c     contour_info Type cint_stuff from module contours.  Contains 
c                  contour information
c
c     OUTPUT:
c     maxmini  Integer array containing i-indeces of max/min locations
c     maxminj  Integer array containing j-indeces of max/min locations
c     ifgcret  return code from this subroutine
c
c     OTHER:
c     storm    Contains the tcvitals for the storms (module def_vitals)

      USE trkrparms; USE grid_bounds; USE set_max_parms; USE def_vitals
      USE contours; USE tracked_parms
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo
      type (cint_stuff) contour_info

      integer       i,j,n,isstart,ifamret,ibeg,jbeg,iend,jend
      integer       ifh,maxstorm,imax,jmax,itemp,ifgcret
      integer       stormct,oldstormct,mm
      logical(1)    valid_pt(imax,jmax),masked_out(imax,jmax)
      character(*)  cparm,cmaxmin
      integer       maxmini(maxstorm),maxminj(maxstorm)
      real          fxy(imax,jmax)
      real          dmax,dmin,dx,dy,dbuffer,tmp

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'*-------------------------------------------------*'
        print *,'* At top of first_ges_center                      *' 
        write (6,102) ifhours(ifh),ifclockmins(ifh)
 102    format (1x,'* Searching for new lows at hour ',i4,':',i2.2)
        print *,'*-------------------------------------------------*'
      endif


c     First check the user-supplied grid boundaries to see if we will 
c     scan the entire array or just a portion of it.

      if (trkrinfo%northbd < -998.0 .or. trkrinfo%southbd < -998.0 .or.
     &    trkrinfo%westbd < -998.0  .or. trkrinfo%eastbd < -998.0) then
        ! User did not specify a subgrid, so scan the whole domain
        ibeg = 1
        iend = imax
        jbeg = 1
        jend = jmax
      else

c        if (trkrinfo%westbd > 360.0 .or. trkrinfo%eastbd < 0.0 .or.
c     &      trkrinfo%westbd <   0.0 .or.

        if (trkrinfo%westbd > 360.0 .or. 
     &      trkrinfo%northbd > 90.0 .or. trkrinfo%northbd <-90.0 .or.
     &      trkrinfo%southbd > 90.0 .or. trkrinfo%southbd <-90.0 .or.
     &      trkrinfo%westbd  >= trkrinfo%eastbd .or.
     &      trkrinfo%southbd >= trkrinfo%northbd) then

          if (trkrinfo%westbd  > trkrinfo%eastbd) then

            if (trkrinfo%westbd < 360.0 .and.
     &          trkrinfo%eastbd >= 0.0)then

              ! In this special case, the user has specified that the 
              ! western boundary be to the west of the Greenwich 
              ! meridian and the eastern boundary be to the east of it.

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'++ NOTE: The user supplied grid lon boundaries'
                print *,'++       span across the Greenwich meridian.'
                print *,'++    '
                print *,'++        Western boundary: ',trkrinfo%westbd
                print *,'++        Eastern boundary: ',trkrinfo%eastbd
                print *,'++        Northern boundary: ',trkrinfo%northbd
                print *,'++        Southern boundary: ',trkrinfo%southbd
                print *,' '
              endif

              ! Calculate the beginning and ending i and j points for
              ! this case of spanning the Greenwich meridian.  The 
              ! beginning and ending j points are, obviously, the same
              ! as for the regular case below in the else.  The 
              ! i-beginning point will also be the same as for the 
              ! regular case.  However, the i-ending point will be 
              ! modified for the meridian wrap; it will be > imax.

              jbeg = int(((glatmax + dy - trkrinfo%northbd) 
     &               / dy) + 0.5)
              jend = int(((glatmax + dy - trkrinfo%southbd) 
     &               / dy) + 0.5)
              ibeg = int(((trkrinfo%westbd - glonmin + dx)  
     &               / dx) + 0.5)
c              iend = int(((trkrinfo%eastbd - glonmin + dx)  
c     &               / dx) + 0.5)
              iend = int(((trkrinfo%eastbd - glonmin + dx)  
     &               / dx) + 0.5) + imax

              goto 377

            endif
          endif

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: Error in first_ges_center.  There is a'
            print *,'!!!        problem with the user-supplied grid '
            print *,'!!!        boundaries.  Please check them and '
            print *,'!!!        resubmit the program.'
            print *,'!!!'
            print *,'!!!        Western boundary: ',trkrinfo%westbd
            print *,'!!!        Eastern boundary: ',trkrinfo%eastbd
            print *,'!!!        Northern boundary: ',trkrinfo%northbd
            print *,'!!!        Southern boundary: ',trkrinfo%southbd
            print *,' '
          endif

          ifgcret = 91
          return

 377      continue

        else
          ! Calculate the beginning and ending i and j points....
          jbeg = int(((glatmax + dy - trkrinfo%northbd) / dy)
     &              + 0.5)
          jend = int(((glatmax + dy - trkrinfo%southbd) / dy)
     &              + 0.5)
          ibeg = int(((trkrinfo%westbd - glonmin + dx)  / dx)
     &              + 0.5)
          iend = int(((trkrinfo%eastbd - glonmin + dx)  / dx)
     &              + 0.5)
        endif
      endif

c     Scan the requested portion of the grid and pick out the max and
c     min data values, figure out what the max and min contour levels
c     will be, and fill an array with the values of the various 
c     intermediate, incremental contour levels.

      if (trkrinfo%contint <= 0) then


        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR: Error in first_ges_center.  For a midlat'
          print *,'!!!        or tcgen run of the  tracker, the contour'
          print *,'!!!        interval supplied by the user is not '
          print *,'!!!        greater than 0.'
          print *,'!!! '
          print *,'!!! User-supplied contint = ',trkrinfo%contint
          print *,' '
        endif

        ifgcret = 91
        return
      endif

      dmin =  9.99e20
      dmax = -9.99e20

      do j = jbeg,jend
        do i = ibeg,iend
          if (i > imax) then
            itemp = i - imax   ! If wrapping past GM
          else
            itemp = i
          endif
          if (valid_pt(itemp,j)) then
            if (fxy(itemp,j) < dmin) dmin = fxy(itemp,j)    
            if (fxy(itemp,j) > dmax) dmax = fxy(itemp,j)    
          endif
        enddo
      enddo

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'*--------------------------------------------*'
        print *,'In first_ges_center, dmin= ',dmin,' dmax= ',dmax
      endif


c     We want to allow for storms moving out of the sub-region,
c     in which case we might hit slightly lower or higher 
c     contours than were found in the sub-region, so allow for 
c     an extra buffer and modify dmin and dmax....

      dbuffer = (dmax - dmin) / 2.0
      dmax = dmax + dbuffer
      dmin = dmin - dbuffer

      if ( verb .ge. 3 ) then
        print *,'after adjustment, dmin= ',dmin,' dmax= ',dmax
      endif

c      Next 2 lines changed for compiler compatibility on
c      other platforms....
c      contour_info%xmaxcont = dmax - amod(dmax,trkrinfo%contint)
c      contour_info%xmincont = dmin - amod(dmin,trkrinfo%contint)

      tmp = trkrinfo%contint
      contour_info%xmaxcont = dmax - mod(dmax,tmp)
      contour_info%xmincont = dmin - mod(dmin,tmp)

      if ( verb .ge. 3 ) then
        print *,'A1 contour_info%xmaxcont= ',contour_info%xmaxcont
        print *,'A1 contour_info%xmincont= ',contour_info%xmincont
      endif

      if (contour_info%xmincont > contour_info%xmaxcont) then
        contour_info%xmincont = contour_info%xmaxcont
      endif

c      if (dmin > contour_info%xmincont) then 
c        contour_info%xmincont=contour_info%xmincont + trkrinfo%contint
c      endif
c      if (dmax < contour_info%xmaxcont) then 
c        contour_info%xmaxcont=contour_info%xmaxcont - trkrinfo%contint
c      endif

      if ( verb .ge. 3 ) then
        print *,'A2 contour_info%xmaxcont= ',contour_info%xmaxcont
        print *,'A2 contour_info%xmincont= ',contour_info%xmincont
        print *,'maxconts= ',maxconts
      endif

c     NOTE: In the loop below, the contour_info%contvals array is now
c     (5/2003) no longer used in subsequent subroutines.  But we still
c     need to figure out the value of the contvals as we iterate the 
c     loop so we can know when we've surpassed dmax and can stop 
c     incrementing contour_info%numcont, which we do need in subsequent
c     subroutines.

      contour_info%numcont = 0
      do n = 1,maxconts
        contour_info%numcont = contour_info%numcont + 1
        contour_info%contvals(n) = contour_info%xmincont + 
     &                             float(n-1)*trkrinfo%contint
c        print *,'n= ',n,' contour_info%contvals(n)= '
c     &                 ,contour_info%contvals(n)
        if (contour_info%contvals(n) >= dmax) exit
      enddo
    
      oldstormct = stormct
      call find_all_maxmins (imax,jmax,ibeg,iend,jbeg,jend,fxy
     &        ,valid_pt,masked_out,contour_info,dx,dy
     &        ,trkrinfo,cmaxmin,maxstorm,stormct,maxmini
     &        ,maxminj,ifamret)

      if (stormct > 0) then
        continue
      else 

        if ( verb .ge. 3 ) then
          print *,' '
          print *,' '
          print *,'!!! ************************************************'
          print *,'!!! '
          print *,'!!! NOTE: In first_ges_center, the value of stormct'
          print *,'!!! returned from find_all_maxmins is not greater'
          print *,'!!! than 0.  This means there are no new centers'
          print *,'!!! to track, which is not likely.  Perhaps you are'
          print *,'!!! searching over too small of an area??'
          print *,'!!! '
          print *,'!!! ************************************************'
          print *,' '
        endif

      endif

      print *,'ifh= ',ifh,' oldstormct= ',oldstormct
      print *,  '           stormct= ',stormct

      do mm = 1,300
        print *,'mm= ',mm,' maxmini(mm)= ',maxmini(mm)
     &         ,' maxminj(mm)= ',maxminj(mm)
      enddo

      if (stormct > oldstormct .and. stormct > 0) then
        isstart = oldstormct + 1

        if ( verb .ge. 3 ) then
          write (6,*) ' '
          write (6,*) 'New search: '
          write (6,*) 'Possible new max/min locations at ifh= ',ifh
          write (6,*) '--------------------------------------------'
        endif

        do n = isstart,stormct
          if (trkrinfo%type == 'midlat') then
            storm(n)%tcv_center = 'MIDL'
          else if (trkrinfo%type == 'tcgen') then
            storm(n)%tcv_center = 'TCG '
          endif
          slonfg(n,ifh) = glonmin + (maxmini(n)-1)*dx
          slatfg(n,ifh) = glatmax - (maxminj(n)-1)*dy
          storm(n)%tcv_stspd = -99
          storm(n)%tcv_stdir = -99
          write (storm(n)%tcv_storm_id,'(i4.4)') n
          write (storm(n)%tcv_storm_name,'(i4.4)') n
          stormswitch(n) = 1
          if (cparm == 'mslp') then

            if ( verb .ge. 3 ) then
              write (6,71) maxmini(n),maxminj(n),slonfg(n,ifh)
     &             ,360.-slonfg(n,ifh),slatfg(n,ifh)
     &             ,slp(maxmini(n),maxminj(n))/100.0
            endif

          endif
        enddo
      else

        if ( verb .ge. 3 ) then
          print *,' '
          print *,' New search: '
          print *,'!!! NOTE: No new storms found in find_all_maxmins'
          print *,'!!! at ifh = ',ifh,'  stormct= ',stormct
          print *,'!!! oldstormct= ',oldstormct
          print *,' '
        endif

      endif

  71  format (1x,'i= ',i4,'  j= ',i4,'   lon: ',f7.2,'E  (',f6.2,'W)'
     &       ,2x,' lat: ',f6.2,'    mslp: ',f6.1,' mb')
c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine find_all_maxmins (imax,jmax,ibeg,iend,jbeg,jend,fxy
     &          ,valid_pt,masked_out,contour_info,dx,dy
     &          ,trkrinfo,cmaxmin,maxstorm,stormct,maxmini
     &          ,maxminj,ifamret)
c
c     ABSTRACT: This subroutine will search an area delineated by  
c     input i and j indeces in order to find all local maxes or mins 
c     in that area.  The (i,j) locations of the maxes/mins are returned
c     in the maxmini and maxminj arrays.  The input 3-character string
c     cmaxmin will tell the subroutine to look for a "max" or a "min".
c
c     INPUT:
c     imax     Number of gridpoints in i direction in input grid
c     jmax     Number of gridpoints in j direction in input grid
c     ibeg     i-index for upper left location of grid to search
c     iend     i-index for lower right location of grid to search
c     jbeg     j-index for upper left location of grid to search
c     jend     j-index for lower right location of grid to search
c     fxy      Real array of data values
c     valid_pt Logical bitmap masking non-valid grid points.  This is a
c              concern for the regional models, which are interpolated
c              from Lam-Conf or NPS grids onto lat/lon grids, leaving
c              grid points around the edges which have no valid data.
c     masked_out Logical. T = data point is already accounted for, under
c                the influence of another nearby max or min center,
c                F = data point is available to be scanned by this
c                subroutine for max or min centers.
c     contour_info Type cint_stuff from module contours containing the
c                  the following 4 variables:
c     1. xmincont Real value for min contour level in the fxy data array
c     2. xmaxcont Real value for max contour level in the fxy data array
c     3. contvals Real array holding values of cont levels at this time
c     4. numcont  Number of contour intervals found at this time
c     dx       Grid spacing in x-direction
c     dy       Grid spacing in y-direction
c     trkrinfo derived type containing various user-input tracker parms
c     cmaxmin  String that declares if "min" or "max" is being searched
c     maxstorm max # of storms that can be handled in this run
c
c     INPUT/OUTPUT:
c     stormct  Integer: keeps and increments a running tab of the number
c              of storms that have been tracked at any time across all 
c              forecast hours
c
c     OUTPUT:
c     maxmini  integer array containing i-indeces of the max/min points
c     maxminj  integer array containing j-indeces of the max/min points
c     ifamret  return code from this subroutine

      USE trkrparms; USE set_max_parms; USE contours
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo
      type (cint_stuff) contour_info
      integer    stormct,i,j,ibeg,iend,jbeg,jend,ix,jx,ixp1,ixm1
      integer    ip,jp,maxstorm,jxp1,jxm1,ifamret,isret,iaret,iclmret
      integer    isoiret,icccret,igicwret,imax,jmax
      character ccflag*1,get_last_isobar_flag*1,point_is_over_water*1
      character(*) cmaxmin
      logical(1) still_finding_valid_maxmins,rough_gradient_check_okay
      logical(1) valid_pt(imax,jmax),masked_out(imax,jmax)
      integer    maxmini(maxstorm),maxminj(maxstorm)
      real       fxy(imax,jmax)
      real       xavg,stdv,search_cutoff,dmin,dmax,sphere_cutoff
      real       plastbar,rlastbar,fract_land,dx,dy

c-----
      still_finding_valid_maxmins = .true.


c      print *,'ctm beg of find_all_maxmins, maxstorm= ',maxstorm


c     First, we want to get the mean and standard deviation of the input
c     field to be searched.  We can use the standard deviation info as
c     part of our guideline for when to stop searching for maxes & mins.
c     We will set the search cut-off threshold at 1/2 standard deviation
c     above the mean for min searches.  So, for the example of mslp, if
c     the mean pressure over the whole domain is 1010 mb and the 
c     standard deviation is 12 mb, then when we are searching, if the
c     lowest available (i.e., hasn't been found in a previous iteration
c     of this loop) pressure is 1016, then it's time to stop searching.

      call avgcalc   (fxy,imax*jmax,valid_pt,xavg,iaret)
      call stdevcalc (fxy,imax*jmax,valid_pt,xavg,stdv,isret)
      if (iaret /= 0 .or. isret /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR: In find_all_maxmins, the calls to avgcalc'
          print *,'!!!        and/or stdevcalc returned an error.'
          print *,'!!!    iaret= ',iaret,'  isret= ',iaret
          print *,' '
        endif

        ifamret = 98
        return
      endif

      if (cmaxmin == 'min') then
        search_cutoff = xavg + stdv*0.5
      else
        search_cutoff = xavg - stdv*0.5
      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'In find_all_maxmins, search_cutoff= ',search_cutoff
        print *,' '
      endif

c     Now begin to search the domain.  We do a simple gridpoint scan,
c     and once we find the max/min value, we pass the (i,j) coordinates
c     at that point to a routine to check for a closed contour.  Then
c     we mask out those points in the contour (or, if there is not a 
c     closed contour, just the 8 points immediately surrounding the low
c     center) and we do another iteration of search_loop to look for 
c     more lows.  We mask out points we've found so that on subsequent
c     iterations of search_loop, we don't find the same old center 
c     again and again and again.....

      search_loop: do while (still_finding_valid_maxmins)

        dmin =  9.99e20
        dmax = -9.99e20

        jloop: do j = jbeg,jend
          iloop: do i = ibeg,iend

            ip = i
            jp = j

            if (ip > imax) then 
              if (trkrinfo%gridtype == 'global') then
                ip = i - imax   ! If wrapping past GM
              else
                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'!!! WARNING: In find_all_maxmins, the '
                  print *,'!!!   user-requested eastern search boundary'
                  print *,'!!!   is beyond the eastern bounds of '
                  print *,'!!!   this regional grid.  The search'
                  print *,'!!!   will not extend to the user-requested'
                  print *,'!!!   grid boundary.'
                  print *,'!!!         '
                  print *,'!!!   imax of regional grid    = ',imax
                  print *,'!!!   User-requested eastern i = ',ip
                  print *,' '
                endif

                exit iloop

              endif
            endif

            if (valid_pt(ip,jp) .and..not. masked_out(ip,jp)) then
              if (cmaxmin == 'min') then
                if (fxy(ip,jp) < dmin) then
                  dmin = fxy(ip,jp)
                  ix = ip
                  jx = jp
                endif
              else
                if (fxy(ip,jp) > dmax) then
                  dmax = fxy(ip,jp)
                  ix = ip
                  jx = jp
                endif
              endif
            endif

          enddo iloop
        enddo jloop
 
        if (cmaxmin == 'min') then
          if (dmin < search_cutoff) then
            continue
          else
            still_finding_valid_maxmins = .false.
            exit search_loop
          endif
        else
          if (dmax > search_cutoff) then
            continue
          else
            still_finding_valid_maxmins = .false.
            exit search_loop
          endif
        endif

c       As a rough first check, see if the neighboring points on all
c       4 sides have a gradient sloping down into the found min point,
c       or at least that there is a flat field not having a gradient 
c       sloping away from the center point.

        call get_ijplus1_check_wrap (imax,jmax,ix,jx,ixp1,jxp1,ixm1
     &                              ,jxm1,trkrinfo,igicwret)

        if (igicwret /= 0) then
          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! NOTE: In find_all_maxmins, the center we found'
            print *,'!!!     is too close to the grid boundary and will'
            print *,'!!!     NOT be checked for a closed contour.'
            print *,'!!!  ix= ',ix,' jx= ',jx,'  fxy= ',fxy(ix,jx) 
            print *,'!!! '
            print *,' '
          endif

          masked_out(ix,jx) = .true. 
          cycle search_loop
        endif

        if (cmaxmin == 'min') then
          if (fxy(ix,jx) <= fxy(ixp1,jx) .and. 
     &        fxy(ix,jx) <= fxy(ix,jxm1) .and.
     &        fxy(ix,jx) <= fxy(ixm1,jx) .and.
     &        fxy(ix,jx) <= fxy(ix,jxp1)) then
            rough_gradient_check_okay = .true.
          else
            rough_gradient_check_okay = .false.
          endif
        else
          if (fxy(ix,jx) >= fxy(ixp1,jx) .and.
     &        fxy(ix,jx) >= fxy(ix,jxm1) .and.
     &        fxy(ix,jx) >= fxy(ixm1,jx) .and.
     &        fxy(ix,jx) >= fxy(ix,jxp1)) then
            rough_gradient_check_okay = .true.
          else
            rough_gradient_check_okay = .false.
          endif
        endif
 
        if (rough_gradient_check_okay) then

          if ( verb .ge. 3 ) then
            print *,'Found a possible max/min at ix= ',ix,' jx= ',jx
          endif


c         From this rough check, we appear to have a gradient sloping
c         in towards the center point.  Now call the subroutine to 
c         check whether or not there is in fact a closed contour
c         surrounding this local maximum or minimum.

          get_last_isobar_flag = 'n'
          ccflag = 'n'
          call check_closed_contour (imax,jmax,ix,jx,fxy,valid_pt
     &             ,masked_out,ccflag,cmaxmin,trkrinfo
     &             ,1,contour_info,get_last_isobar_flag,plastbar
     &             ,rlastbar,icccret)

          if (ccflag == 'y') then
            if (stormct < maxstorm) then
              stormct = stormct + 1

              if ( verb .ge. 3 ) then
                print *,'AAA stormct= ',stormct,'  ix= ',ix,' jx= ',jx
              endif

              ! For a tcgen case, we will add in one additional check,
              ! and that is to ensure the point is (mostly) over water.
              ! Only do this check if the user has requested it (some
              ! of the global models do not have a land-sea mask 
              ! included in the grib data files).

              point_is_over_water = 'u'

              if (trkrinfo%use_land_mask == 'y') then
                call check_land_mask (imax,jmax,ix,jx,fract_land
     &              ,valid_pt,dx,dy,point_is_over_water,iclmret)
                if (iclmret /= 0) then
                  print *,' '
                  print *,'!!! ERROR from check_land_mask for ix= ',ix
     &                   ,' jx= ',jx
                  print *,'!!! STOPPING PROGRAM'
                  stop 95
                endif
              endif
 
              if (point_is_over_water /= 'n') then
                maxmini(stormct) = ix
                maxminj(stormct) = jx
              endif

            else

              if ( verb .ge. 3 ) then
                print *,'---max stormct reached, stormct= ', stormct
              endif

            endif
          else

            if ( verb .ge. 3 ) then
              print *,'!!! contour check negative, ccflag= ',ccflag
            endif
          endif

          if ( verb .ge. 3 ) then
            print *,' '
            print *,'*-----------------------------------------------*'
            print *,'* After check_closed_contour...                 *'
            print *,'*-----------------------------------------------*'
            print *,' '
          endif

        endif

c       Regardless of whether or not the found point turns out to have
c       a closed contour, we don't want to find this local minimum or
c       its 8 surrounding points again in a search on a subsequent 
c       iteration of this loop.

        masked_out(ix,jx)     = .true.
        masked_out(ix,jxp1)   = .true.
        masked_out(ixp1,jxp1) = .true.
        masked_out(ixp1,jx)   = .true.
        masked_out(ixp1,jxm1) = .true.
        masked_out(ix,jxm1)   = .true.
        masked_out(ixm1,jxm1) = .true.
        masked_out(ixm1,jx)   = .true.
        masked_out(ixm1,jxp1) = .true.

      enddo search_loop

      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine mask_based_on_wind_circ (imax,jmax,dx,dy,level
     &                     ,valid_pt,masked_outc,trkrinfo
     &                     ,ctlon,ctlat,cmodel_type,imbowret)
c
c     ABSTRACT: This subroutine masks out grid points for a storm that
c     is currently being tracked.  It is called after a fix has been 
c     made at the current forecast hour.  It is only used as a backup,
c     that is, if the mslp data were not there and/or a fix position
c     for mslp could not be made, then that means that the mask would 
c     not be able to get updated using the routine in subroutine  
c     check_closed_contour.  But we still do need to update that mask,
c     so we will instead do it based on wind circulation.  We will go
c     out radially from the center, starting at 40 km, then every 
c     40 km from there on out.  When the mean cyclonic Vt drops below
c     3 m/s, stop searching, and then mask out all grid points within
c     that last-searched radius.
c
c     INPUT:
c     imax     Num pts in i-direction on grid
c     jmax     Num pts in j-direction on grid
c     ix       i index for location of local max or min
c     jx       j index for location of local max or min
c     fxy      input data array
c     valid_pt Logical; bitmap indicating if valid data at that pt
c     masked_outc Logical. T = data point is already accounted for, 
c                under the influence of another nearby max or min 
c                center; F = data point is available to be scanned by 
c                this subroutine for max or min centers.
c     ctlon    Fix longitude for the input parameter to this routine
c     ctlon    Fix latitude for the input parameter to this routine
c     cmodel_type  character, 'global' or 'regional'

      USE set_max_parms; USE trkrparms; USE grid_bounds 
      USE verbose_output; USE level_parms

      implicit none

      type (trackstuff) trkrinfo

      character(*)  cmodel_type
      integer, parameter :: numazim=24
      integer    imax,jmax,level,imbowret,nlev,iazim,i,j
      integer    ibiret1,ibiret2,azimuth_ct,igvtret
      integer    jnfix,jsfix,iefix,iwfix
      real       vr(numazim),vt(numazim)
      real       dx,dy,ctlon,ctlat,rdist,bear,targlat,targlon
      real       xintrp_u,xintrp_v,grid_buffer,xmax_rdist_reached
      real       vt_mean,vt_azim_sum,xbear,dist,degrees
      logical(1) valid_pt(imax,jmax),masked_outc(imax,jmax)
      logical(1) searching_valid_pts

      imbowret = 0

      select case (level)
        case (850);  nlev = nlev850  ! check module level_parms for
        case (700);  nlev = nlev700  ! the values of these....
        case (500);  nlev = nlev500
        case (1020); nlev = levsfc
      end select

      if (cmodel_type == 'regional') then
        grid_buffer = 0.30
      else
        grid_buffer = 0.0
      endif

      searching_valid_pts = .true.

      rdist = 40.0                 ! units in km
      xmax_rdist_reached = rdist   ! units in km

      radial_loop: do while (searching_valid_pts)

        azimuth_ct  = 0
        vt_azim_sum = 0.0
        vt = -999.0
        vr = -999.0

        azimloop: do iazim = 1,numazim

          bear = ((iazim-1) * 15.) + 7.5

          call distbear (ctlat,ctlon,rdist,bear,targlat,targlon)

          if (targlon >= glonmax) then
            if (trkrinfo%gridtype == 'global') then
              targlon = targlon - 360.  ! We just GM-wrapped for the 
                                        ! full, regular, global grid.
            else
              xmax_rdist_reached = rdist
              exit radial_loop
            endif
          endif

          if (targlon < glonmin) then
            if (trkrinfo%gridtype == 'global') then
              targlon = targlon + 360.  ! We just GM-wrapped for the
                                        ! full, regular, global grid.
            else
              xmax_rdist_reached = rdist
              exit radial_loop
            endif
          endif

          if (targlat > glatmax .or. targlat < glatmin) then
            xmax_rdist_reached = rdist
            exit radial_loop
          endif

          ! These calls to bilin_int_uneven pass a variable, level,
          ! that contains the vertical level to pull the wind data
          ! from, either 850, 700 or surface (which will be
          ! indicated by a value/code of 1020).

          call bilin_int_uneven (targlat,targlon
     &        ,dx,dy,imax,jmax,trkrinfo,level,'u',xintrp_u,ibiret1)

          call bilin_int_uneven (targlat,targlon
     &        ,dx,dy,imax,jmax,trkrinfo,level,'v',xintrp_v,ibiret2)
    
          if (ibiret1 == 0 .and. ibiret2 == 0) then
            call getvrvt (ctlon,ctlat,targlon,targlat
     &                   ,xintrp_u,xintrp_v,vr(iazim)
     &                   ,vt(iazim),igvtret)
            azimuth_ct = azimuth_ct + 1
            vt_azim_sum = vt_azim_sum + vt(iazim)
          else 
            xmax_rdist_reached = rdist
            exit radial_loop
          endif

        enddo azimloop

        if (azimuth_ct > 0) then
          ! Compute azimuthally-averaged Vt at this distance
          vt_mean = vt_azim_sum / float(azimuth_ct)
        else
          vt_mean = -999.0
        endif

        if ( verb .ge. 3 ) then
          print *,'mbow: rdist= ',rdist,' azimuth_ct= ',azimuth_ct
     &           ,'  vt_azim_sum= ',vt_azim_sum,' vt_mean= ',vt_mean
        endif

        if (ctlat >= 0.0) then
          if (vt_mean >= 3.0) then
            ! For a NH storm, if the cyclonic mean Vt >= 3.0, increment
            ! rdist and cycle through to the next iteration of 
            ! radial_loop.
            rdist = rdist + 40.0
          else
            xmax_rdist_reached = rdist
            exit radial_loop
          endif
        else
          if (vt_mean <= -3.0 .and. vt_mean > -998.0) then
            ! For a SH storm, if the cyclonic mean Vt <= -3.0, increment
            ! rdist and cycle through to the next iteration of
            ! radial_loop.
            rdist = rdist + 40.0
          else
            xmax_rdist_reached = rdist
            exit radial_loop
          endif
        endif

      enddo radial_loop

      if ( verb .ge. 3 ) then
        print *,'mbow: After radial_loop, rdist= ',rdist
     &         ,'    xmax_rdist_reached= ',xmax_rdist_reached
      endif

c     -----------------------------------------------------------------
c     At this point, we are done searching radially outwards away from
c     the storm center.  The max radial distance we reached is called
c     xmax_rdist_reached.  By getting to this spot in the subroutine, 
c     that means that we bumped out of radial_loop above because the 
c     rdist being used in that loop got to a radius at which the mean
c     cyclonic Vt no longer was strong enough to continue the search
c     outward, so we need to reduce it by 40 km here (back to the value
c     for the last successful search).  At a minimum, we will mask to a 
c     radius of 80 km.

      if (xmax_rdist_reached > 80.0) then
        xmax_rdist_reached = xmax_rdist_reached - 40.0
      else
        xmax_rdist_reached = 80.0
      endif

      if ( verb .ge. 3 ) then
         print *,'mbow: After adjustment of xmax_rdist_reached, rdist= '
     &          ,rdist,'    xmax_rdist_reached= ',xmax_rdist_reached
       endif

      bearloop: do i = 1,4

        ! Now find the values of the longitude for the farthest west
        ! and east points and find the values of the latitude for the
        ! farthest north and south points.  The i and j indices 
        ! associated with these lons and lats will be used to define
        ! the bounds of the grid over which we scan to find points 
        ! that will update the mask.

        select case (i)
          case (1); xbear =   0.0;
          case (2); xbear =  90.0;
          case (3); xbear = 180.0;
          case (4); xbear = 270.0;
        end select

        call distbear (ctlat,ctlon,xmax_rdist_reached,xbear
     &                ,targlat,targlon)

        if ( verb .ge. 3 ) then
           print *,'mbow: distbear for i= ',i,' targlon= ',targlon
     &            ,' targlat= ',targlat
        endif

        if (targlon >= glonmax) then
          if (trkrinfo%gridtype == 'global') then
            targlon = targlon - 360.  ! We just GM-wrapped for the
                                      ! full, regular, global grid.
          else
            print *,' '
            print *,'WARNING: In subroutine mask_based_on_wind_circ,'
            print *,'targlon > glonmax for a regional grid, so we '
            print *,'cannot update the mask.'
            print *,'targlon= ',targlon,'  glonmax= ',glonmax
            imbowret = 95
            return
          endif
        endif

        if (targlon < glonmin) then
          if (trkrinfo%gridtype == 'global') then
            targlon = targlon + 360.  ! We just GM-wrapped for the
                                      ! full, regular, global grid.
          else
            print *,' '
            print *,'WARNING: In subroutine mask_based_on_wind_circ,'
            print *,'targlon < glonmin for a regional grid, so we '
            print *,'cannot update the mask.'
            print *,'targlon= ',targlon,'  glonmin= ',glonmin
            imbowret = 95
            return
          endif
        endif

        if (targlat > glatmax .or. targlat < glatmin) then
            print *,' '
            print *,'WARNING: In subroutine mask_based_on_wind_circ,'
            print *,'either targlat > glatmx or targlat < glatmin, so'
            print *,'we cannot update the mask.'
            print *,'targlat= ',targlat,'  glatmin= ',glatmin
            print *,'                      glatmin= ',glatmin
            imbowret = 95
            return
          cycle bearloop
        endif

        ! Get the i & j starting and ending points for our loop where 
        ! we will update the mask....

        if (i == 1) then

          ! Get j for northern latitude.  Fix targlat to the *nearest*
          ! j-point (i.e., round it....)

          if (targlat >= 0.0) then    ! N. Hemisphere
            jnfix = int((glatmax - targlat)/dy + 1.0 + 0.5)
          else                        ! S. Hemisphere
            jnfix = ceiling((glatmax - targlat)/dy + 1.0 - 0.5)
          endif

        elseif (i == 2) then

          ! Get i for eastern longitude.  Fix targlon to the *nearest*
          ! i-point (i.e., round it....)

          iefix = int((targlon - glonmin)/dx + 1.0 + 0.5)

        elseif (i == 3) then

          ! Get i for southern latitude.  Fix targlat to the *nearest*
          ! j-point (i.e., round it....)

          if (targlat >= 0.0) then    ! N. Hemisphere
            jsfix = int((glatmax - targlat)/dy + 1.0 + 0.5)
          else                        ! S. Hemisphere
            jsfix = ceiling((glatmax - targlat)/dy + 1.0 - 0.5)
          endif

        elseif (i == 4) then

          ! Get i for western longitude.  Fix targlon to the *nearest*
          ! i-point (i.e., round it....)

          iwfix = int((targlon - glonmin)/dx + 1.0 + 0.5)

        endif

      enddo bearloop

      if ( verb .ge. 3 ) then
         print *,'mbow:  iwfix= ',iwfix,' iefix= ',iefix
     &          ,' jnfix= ',jnfix,' jsfix= ',jsfix
      endif

      do i = iwfix,iefix
        do j = jnfix,jsfix

          call calcdist (glon(i),glat(j),ctlon,ctlat,dist,degrees)

          if (dist < xmax_rdist_reached) then
            masked_outc(i,j) = .true.
          endif

        enddo
      enddo

      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine check_closed_contour (imax,jmax,ix,jx,fxy,valid_pt
     &           ,masked_out,closed_contour,cmaxmin,trkrinfo
     &           ,num_requested_contours,contour_info
     &           ,get_last_isobar_flag,plastbar,rlastbar,icccret)
c
c     ABSTRACT: This subroutine checks a field of data around an input
c     (ix,jx) data point to see if a closed contour exists around 
c     that data point.  It can check for a closed contour on a max or a 
c     min field, depending on the value of the input variable 'cmaxmin'.
c     The algorithm works by examining rings of the 8 data points 
c     surrounding a data point that is in the contour interval.  For
c     example, in the diagram below, the X represents the location of
c     the local minimum value which was passed into this routine with
c     the coordinates (ix,jx), let's say it's 985 mb.  And let's assume
c     that the data values at points A-I are all in the 4 mb contour 
c     interval of 985-989 mb, and that all the surrounding points have
c     data values >= 989.  To test for a closed contour, we first check
c     the ring of 8 points immediately around point X to see what their
c     data values are.  If a data value is found that is below the 
c     lower limit of this contour interval (985 mb) or lower than the
c     local minimum value at the X point that we initially targeted 
c     (985 mb), then we do NOT have a closed contour, and we exit this
c     subroutine.  But in our example, that's not the case, and we have
c     5 points (B,D,E,F,G) that are in the interval.  So in our next 
c     iteration of the loop, we set up 5 rings, each one set up around 
c     the points found in the first iteration (B,D,E,F,G), and we check 
c     the 8 points around each of those points.  A logical array is 
c     used so that as soon as a point is found, it is flagged as being 
c     found.  In this way, when we look at the ring around point D, for
c     example, we won't pick point X again and set up another ring 
c     around it in the next ring iteration and end up in an infinite 
c     loop, going back and forth between point X and point D.  While 
c     checking the 8 points in a ring, if a found data value is above 
c     our contour interval (i.e., >= 989 mb), we just ignore the 
c     point; we only mark points that are in our contour interval, 
c     and again, if we find a point below our contour interval, we 
c     exit the subroutine with a flag indicating a closed contour was
c     NOT found.  So in this method, we keep spreading out from the 
c     initial local minimum and creating and checking new rings until 
c     we either: (a) Hit the edge of the regional grid, in which case 
c     we consider a closed contour NOT found, (b) Run into a data 
c     point that has been marked as being under the influence of 
c     another nearby low, in which case we consider a closed contour 
c     NOT found, (c) Run into a point which is below (above) our 
c     contour interval for a min (max) check, in which case we 
c     consider a closed contour NOT found, or (d) we run out of 
c     points to keep searching, we have no rings left to create and 
c     check because all of the surrounding points are above (below) 
c     our contour interval for a min (max) check, and by default we 
c     consider this a closed contour and return to the calling 
c     subroutine a flag indicating such.
c
c               + + + + + + + + + + 
c               + + + + + + + + + + 
c               + + A B + + + + + + 
c               + + C D X E + + + + 
c               + + + + F G + + + + 
c               + + + + + H I + + + 
c               + + + + + + + + + + 
c               + + + + + + + + + + 
c
c     UPDATE: This subroutine was updated to keep searching for 
c     multiple closed contours until it can't find anymore.  The 
c     input parameter num_requested_contours dictates how many 
c     contours to search for.  In the case of just trying to roughly
c     locate new centers and establish that there is a closed 
c     circulation, num_requested_contours will = 1, and we will exit
c     after finding that 1 contour.  But for a check after making a
c     full center fix, we set num_requested_contours = 999 so that 
c     we can keep searching for all closed contours around the low.
c     In this 999 case, you will eventually get to a point where
c     there is no closed contour.  In that case, in the standard
c     output you will see a message telling you that you hit a point
c     that is not in the contour and that there is no closed contour,
c     but you will also notice that the ccflag = y, meaning there is
c     a closed contour (because you have found at least 1 closed 
c     contour along the way).  The reason to keep searching for more
c     closed contours is that we can then return the value of the 
c     outermost closed isobar.
c
c     INPUT:
c     imax     Num pts in i-direction on grid
c     jmax     Num pts in j-direction on grid
c     ix       i index for location of local max or min
c     jx       j index for location of local max or min
c     fxy      input data array
c     valid_pt Logical; bitmap indicating if valid data at that pt
c     masked_out Logical. T = data point is already accounted for, under
c                the influence of another nearby max or min center,
c                F = data point is available to be scanned by this
c                subroutine for max or min centers.
c     cmaxmin  character string ('max' or 'min') that tells this 
c              routine what we're looking for.
c     trkrinfo   derived type that holds/describes various tracker parms
c     contour_info Type cint_stuff from module contours.  Contains
c                  contour information
c     num_requested_contours  For the simple  first_ges_center check, 
c              this will be 1 (we just want to know if there's at
c              least 1 closed contour).  For the verifying check after
c              we've found a center, this will be 9999 (i.e., just keep
c              searching for more contours)
c     get_last_isobar_flag  character ('y' or 'n') to indicate whether
c              or not to report on the value of the last closed isobar
c              and the radius of the last closed isobar.
c
c     OUTPUT:
c     closed_contour character; A returned value of 'y' indicates that
c              this routine was able to find a closed contour. 
c     plastbar Contains the value of the last closed isobar (unrounded)
c     rlastbar Contains the mean radius of the last closed isobar 
c
c     LOCAL:
c     num_pts_in_all_contours Counter for the number of pts inside of 
c              the contour we're looking at
c     next_ring_ct Counter for the number of points that have been 
c              tagged to be used as center points for the next 
c              iteration of multiple_ring_loop.
c     next_contour_ct Counter for the number of points that have been
c              tagged to be used as center points in the first iteration
c              through single_contour_scan_loop as we begin to scan 
c              points in the *next* contour interval.  This counter gets
c              incremented when, for example, we are searching points 
c              around a current center point and we find one that is not
c              in our current interval, but rather is in the next 
c              interval.  We want to remember this point and store the 
c              location, so we increment this counter and store the 
c              location in next_contour_i and next_contour_j arrays.
c     beyond_contour_ct Counter for the number of points that have been
c              tagged to be used as center points for some subsequent 
c              iteration of successive_contours_loop.  This is 
c              different from next_contour_ct, which is used to hold 
c              the locations of points that are definitely in the 
c              *next* contour interval.  Here, we have points that we 
c              just store in a pool of potential points to be searched
c              in future iterations.  These points can come about in 
c              cases where there is a very intense, very compact low 
c              with a tight pressure gradient, such that multiple 
c              contour intervals could be spanned in between 2 adjacent
c              gridpoints (this is especially the case if the contour
c              interval you have chosen is small).  You need to be 
c              careful with how you handle this array.  Once you find 
c              that you have searchable points in next_contour_i or 
c              next_contour_j, do not just simply empty out this 
c              beyond_contour count and its i and j arrays.  The 
c              reason being that some of these "beyond" points may end
c              up being used and searched in subsequent iterations, but
c              not if we just delete them now.

   
      USE set_max_parms; USE trkrparms; USE contours; USE grid_bounds
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo
      type (cint_stuff) contour_info

      integer    i,j,ir,iria,irja,irx,jrx,ix,jx,imax,jmax
      integer    nb,ibx,jby,nct,iflip
      integer    mr,ringct,ixp1,ixm1,jxp1,jxm1,nring,iter
      integer    icenx,jcenx,icccret,next_ring_ct,igicwret
      integer    num_pts_in_all_contours,next_contour_ct
      integer    beyond_contour_ct
      integer    num_pts_in_one_contour
      integer    num_requested_contours,num_found_contours
      integer    nm,im,jm,inall,insingle,isc_count,rlast_distct
      character  found_a_point_in_our_contour*1,closed_contour*1
      character  found_a_point_below_contour*1
      character  found_a_point_above_contour*1,get_last_isobar_flag*1
      character(*) cmaxmin
      logical(1) still_scanning
      logical(1) valid_pt(imax,jmax),masked_out(imax,jmax)
      logical(1) point_is_already_in_our_contour(imax,jmax)
      logical(1) point_is_already_in_next_contour(imax,jmax)
      logical(1) point_is_already_in_beyond_pool(imax,jmax)
      integer    isni,isnj,inci,incj,ibci,ibcj,ihmi,ihmj,itmi,itmj
      integer, allocatable ::  search_next_i(:)
      integer, allocatable ::  search_next_j(:)
      integer, allocatable ::  next_contour_i(:)
      integer, allocatable ::  next_contour_j(:)
      integer, allocatable ::  beyond_contour_i(:)
      integer, allocatable ::  beyond_contour_j(:)
      integer, allocatable ::  hold_mask_i_loc(:)
      integer, allocatable ::  hold_mask_j_loc(:)
      integer, allocatable ::  temp_mask_i_loc(:)
      integer, allocatable ::  temp_mask_j_loc(:)
      integer, allocatable ::  ringposi(:),ringposj(:)
      real,allocatable :: ringpos(:,:)
      real       fxy(imax,jmax),contvals(maxconts)
      real       contlo,conthi,xcentval,contlo_next,conthi_next
      real       dist,degrees,rlast_distsum,plastbar,rlastbar
c
      if (allocated(search_next_i))    deallocate (search_next_i)
      if (allocated(search_next_j))    deallocate (search_next_j)
      if (allocated(next_contour_i))   deallocate (next_contour_i)
      if (allocated(next_contour_j))   deallocate (next_contour_j)
      if (allocated(beyond_contour_i)) deallocate (beyond_contour_i)
      if (allocated(beyond_contour_j)) deallocate (beyond_contour_j)
      if (allocated(hold_mask_i_loc))  deallocate (hold_mask_i_loc)
      if (allocated(hold_mask_j_loc))  deallocate (hold_mask_j_loc)
      if (allocated(temp_mask_i_loc))  deallocate (temp_mask_i_loc)
      if (allocated(temp_mask_j_loc))  deallocate (temp_mask_j_loc)
      allocate (search_next_i(imax*jmax),stat=isni)
      allocate (search_next_j(imax*jmax),stat=isnj)
      allocate (next_contour_i(imax*jmax),stat=inci)
      allocate (next_contour_j(imax*jmax),stat=incj)
      allocate (beyond_contour_i((imax*jmax)/2),stat=ibci)
      allocate (beyond_contour_j((imax*jmax)/2),stat=ibcj)
      allocate (hold_mask_i_loc(imax*jmax),stat=ihmi)
      allocate (hold_mask_j_loc(imax*jmax),stat=ihmj)
      allocate (temp_mask_i_loc(imax*jmax),stat=itmi)
      allocate (temp_mask_j_loc(imax*jmax),stat=itmj)
      if (isni /= 0 .or. isnj /= 0 .or. inci /= 0 .or. incj /= 0 .or.
     &    ibci /= 0 .or. ibcj /= 0 .or. ihmi /= 0 .or. ihmj /= 0 .or.
     &     itmi /= 0 .or. itmj /= 0) then
        
        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in check_closed_contour allocating'
          print *,'!!! various search, hold and temp arrays.'
          print *,'!!! isni = ',isni,' isnj= ',isnj
          print *,'!!! inci = ',inci,' incj= ',incj
          print *,'!!! ibci = ',ibci,' ibcj= ',ibcj
          print *,'!!! ihmi = ',ihmi,' ihmj= ',ihmj
          print *,'!!! itmi = ',itmi,' itmj= ',itmj
          print *,' '
        endif

        STOP 98
      endif

      closed_contour = 'n'
      xcentval = fxy(ix,jx)
      num_found_contours = 0
      next_contour_ct = 0
      beyond_contour_ct = 0
      num_pts_in_all_contours = 0
      hold_mask_i_loc = 0
      hold_mask_j_loc = 0
      beyond_contour_i = 0
      beyond_contour_j = 0
      point_is_already_in_our_contour  = .false.
      point_is_already_in_beyond_pool  = .false.
      icccret = 0
      isc_count = 0
      plastbar = -999.0
      rlastbar = -999.0

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'*-----------------------------------------------*'
        print *,'* Top of check_closed_contour, ix= ',ix,' jx= ',jx
        print *,'*-----------------------------------------------*'
        print *,' '
        print *,'fxy(ix,jx)= ',fxy(ix,jx),' xcentval= ',xcentval
      endif

c     First, set up the contour intervals that will be used.  In
c     the original version of this code, we used preset 
c     standard intervals (984,988,992,996,1000,1004....).  But upon
c     further review, it was decided that this was too arbitrary.
c     So instead, we consider the found min (max) value to be the 
c     bottom (top) of the list of contour intervals.  In this way,
c     we can clearly specify and screen storms based on the "depth" 
c     of the pressure field as compared to the surroundings.

      i = 1
      do while (i <= maxconts)
        if (cmaxmin == 'min') then
          contvals(i) = xcentval + float(i-1)*trkrinfo%contint 
          i = i + 1
        else
          iflip = maxconts - i + 1
          contvals(iflip) = xcentval - float(i-1)*trkrinfo%contint
          i = i + 1
        endif
      enddo

c     This successive_contours loop is the master loop....

      successive_contours_loop: do while (num_found_contours <
     &     num_requested_contours)

c       Find the contour interval in which the center value resides.
c       Note that the lower bound is included for a min check, while
c       the upper bound is included for a max check.  Note also that
c       this subroutine can be used to find the last closed contour,
c       and part of that functionality shows up in the next while 
c       statement where we reference "num_found_contours" in the 
c       array indeces for the contour values.  Basically, the way we
c       do this is, for example, if our central value is 990.4 mb and 
c       our contour interval is 4 mb, then in the first run through 
c       successive_contours_loop we see if we have a closed contour in
c       the interval 990.4-994.4.  If yes, then the next time through 
c       this loop, we see if we have a closed contour in the interval 
c       994.4-998.4.  If yes, then the next loop check is for 998.4-
c       1002.4, and so on....  We stop searching if we find a value 
c       that is either below the xcentval input into this subroutine
c       or below the lower value of the current contour interval (this
c       would mean a change in the gradient and would indicate that, 
c       in the case of mslp, we are heading down towards another,
c       different low).

        isc_count = isc_count + 1

        point_is_already_in_next_contour = .false.

        i = 1
        do while (i < maxconts)
          if (cmaxmin == 'min') then
            if (contvals(i) <= xcentval .and. xcentval < contvals(i+1)) 
     &      then

              if ( verb .ge. 3 ) then
                print *,'At A, num_found_contours= ',num_found_contours
              endif

              contlo = contvals(i+num_found_contours)
              conthi = contvals(i+1+num_found_contours)

              if ( verb .ge. 3 ) then
                print *,'At A, contlo= ',contlo,' conthi= ',conthi
              endif
              exit

            endif
          else
            if (contvals(i) < xcentval .and. xcentval <= contvals(i+1)) 
     &      then
              contlo = contvals(i-num_found_contours)
              conthi = contvals(i-num_found_contours+1)
              exit
            endif
          endif
          i = i + 1
        enddo

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'num_found_contours= ',num_found_contours
          print *,'contlo= ',contlo,' conthi= ',conthi
          print *,'xcentval= ',xcentval
        endif


c       This single_contour_scan_loop is the main loop for searching 
c       for one individual contour.  If it is determined that a contour
c       exists, control is returned to the successive_contours_loop,
c       and if more contours were requested to be found, then the 
c       search continues onward & outward....

        temp_mask_i_loc = 0
        temp_mask_j_loc = 0

        iter  = 1
        num_pts_in_one_contour = 0
        still_scanning = .true.

        rlast_distsum = 0.0
        rlast_distct  = 0

        single_contour_scan_loop: do while (still_scanning)

c          print *,' '
c          print *,'    top of single contour scan loop'
c          print *,'+++ iter= ',iter
c          print *,'    N1: next_contour_ct= ',next_contour_ct

          if (iter == 1 .and. num_found_contours == 0) then 
            ! For the first iteration, we have only the first ring, 
            ! which is centered on the input minimum/maximum point.
            ringct = 1
            search_next_i(1) = ix 
            search_next_j(1) = jx 

c            point_is_already_in_our_contour(ix,jx) = .true.
c            num_pts_in_one_contour = num_pts_in_one_contour + 1
c            temp_mask_i_loc(num_pts_in_one_contour) = ix
c            temp_mask_j_loc(num_pts_in_one_contour) = jx

          else if (iter == 1 .and. num_found_contours > 0) then
            ! This is the first iteration in a *new* contour.
            ! That is, we have already found 1 or more previous
            ! contours while in previous iterations of 
            ! successive_contours_loop and we are now beginning 
            ! to look for the next contour.

c            print *,'    N2: next_contour_ct= ',next_contour_ct

            if (next_contour_ct == 0) then
              ! This would be for the special case in which, for
              ! example, you've got a very intense, compact storm
              ! that "skips" a contour.  That is, suppose the 
              ! min pressure of a storm is 982 mb, and we are 
              ! utilizing a 4-mb contour interval, but all 
              ! surrounding data points are, say, 987 mb or 
              ! higher.  Then, next_contour_ct would be 0 since no
              ! data points were found in the next contour interval
              ! of 982-986 mb, but we can continue searching since the 
              ! gradient is still sloping the correct way.  The code in
              ! this if statement handles this special case.
              
              if ( verb .ge. 3 ) then
                print *,' '
                print *,'ALERT: next_contour_ct = 0 '
              endif

              if (cmaxmin == 'min') then
                contlo_next = conthi
                conthi_next = conthi + trkrinfo%contint

c                print *,'b4 ZZ, ringct= ',ringct
c                print *,'at ZZ, bcc= ',beyond_contour_ct
c     &                 ,'contlo_next= ',contlo_next
c     &                 ,'conthi_next= ',conthi_next

                bey_con_min_loop: do nb = 1,beyond_contour_ct

                  ibx = beyond_contour_i(nb)
                  jby = beyond_contour_j(nb)

                  if (.not. point_is_already_in_beyond_pool(ibx,jby))
     &            then
                    ! If this point is no longer in our pool of "beyond
                    ! contour" points, then just cycle out of this
                    ! iteration....
                    cycle bey_con_min_loop
                  endif

c                  print *,'-- ZZ, ibx= ',ibx,' jby= ',jby
c     &                   ,' fxy(ibx,jby)= ',fxy(ibx,jby)

                  if (fxy(ibx,jby) >= contlo_next .and.
     &                fxy(ibx,jby) <  conthi_next) then

c                    print *,'>> ZZ HIT!!, ibx= ',ibx,' jby= ',jby
c
c                    print *,' +++ BEYOND in NEXT: i= ',ibx,' j= ',jby
c     &                     ,' fxy= ',fxy(ibx,jby)

                    next_contour_ct = next_contour_ct + 1
                    next_contour_i(next_contour_ct) = ibx
                    next_contour_j(next_contour_ct) = jby

                    ! This point has now been identified as being in 
                    ! the "next" contour interval, i.e., no longer in
                    ! the "beyond" contour pool.  Therefore, set the 
                    ! logical flag to indicate that this point is no
                    ! longer in the "beyond" contour pool.

                    point_is_already_in_beyond_pool(ibx,jby) = .false.

                  endif

c                  print *,'.. ZZ, next_contour_ct= ',next_contour_ct

                enddo bey_con_min_loop
              else
                contlo_next = contlo - trkrinfo%contint
                conthi_next = contlo

c                print *,'At A, beyond_contour_ct= ',beyond_contour_ct
c                print *,'  contlo_next = ',contlo_next
c                print *,'  conthi_next = ',conthi_next

                bey_con_max_loop: do nb = 1,beyond_contour_ct

c                  print *,'in bey_con_max_loop, nb= ',nb

                  ibx = beyond_contour_i(nb)
                  jby = beyond_contour_j(nb)

                  if (.not. point_is_already_in_beyond_pool(ibx,jby))
     &            then     
                    ! If this point is no longer in our pool of "beyond
                    ! contour" points, then just cycle out of this
                    ! iteration....
                    cycle bey_con_max_loop
                  endif

c                  print *,'ibx= ',ibx,' jby= ',jby,' data= '
c     &                   ,fxy(ibx,jby)

                  if (fxy(ibx,jby) >  contlo_next .and.
     &                fxy(ibx,jby) <= conthi_next) then

                    next_contour_ct = next_contour_ct + 1
                    next_contour_i(next_contour_ct) = ibx
                    next_contour_j(next_contour_ct) = jby

c                    print *,' ++ HIT! ibx= ',ibx,' jby= ',jby

                    ! This point has now been identified as being in
                    ! the "next" contour interval, i.e., no longer in
                    ! the "beyond" contour pool.  Therefore, set the
                    ! logical flag to indicate that this point is no
                    ! longer in the "beyond" contour pool.

                    point_is_already_in_beyond_pool(ibx,jby) = .false.

                  endif
                enddo bey_con_max_loop
              endif

              if (next_contour_ct > 0) then
                ringct = next_contour_ct
              else

                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'!!! XXX next_contour_ct not > 0 !!!'
                  print *,'next_contour_ct= ',next_contour_ct
                  print *,'beyond_contour_ct= ',beyond_contour_ct
                  print *,'ringct= ',ringct
                  print *,'next_ring_ct= ',next_ring_ct
                  print *,'cycling to top of successive_contours_loop..'
                  print *,' '
                endif

                ! The number of rings that we have available to search
                ! in the next contour interval is 0, so cycle all the 
                ! way back to the top of the outer loop, which is
                ! successive_contours_loop, so that we can increase the
                ! contour bounds and search inside those new bounds.
                ! Again, this is for the case in which we have an 
                ! intense, compact storm and we are using a small 
                ! contour interval, such that we are essentially 
                ! "skipping" over one of these intervals in one of the
                ! loop iterations.   We need to bump up the
                ! num_found_contours by one in order to increase the
                ! array index in the contvals array at the top of the
                ! successive_contours_loop.  It is kosher to do this
                ! since the reason we are cycling back to the top of
                ! that loop is that we are skipping over a contour
                ! interval.

                num_found_contours = num_found_contours + 1
                cycle successive_contours_loop

              endif

            else

              ringct = next_contour_ct

            endif

            do nring = 1,ringct
              search_next_i(nring) = next_contour_i(nring)
              search_next_j(nring) = next_contour_j(nring)
c              print *,'at A, nring= ',nring,' next_contour_i(nring)= '
c     &               ,next_contour_i(nring),' next_contour_j(nring)= '
c     &               ,next_contour_j(nring)
            enddo

            next_contour_ct = 0

          else
            ringct = next_ring_ct 
          endif

          if (allocated(ringposi)) deallocate (ringposi)
          if (allocated(ringposj)) deallocate (ringposj)
          allocate (ringposi(ringct),stat=iria)
          allocate (ringposj(ringct),stat=irja)
          if (iria /= 0 .or. irja /= 0) then

            if ( verb .ge. 1 ) then
              print *,' '
              print *,'!!! ERROR in check_closed_contour allocating'
              print *,'!!! various ring arrays.  iria = ',iria
              print *,'!!! irja = ',irja
              print *,' '
            endif

            STOP 98
          endif

ctm
c          print *,' '
c          print *,'ringct= ',ringct

          do nring = 1,ringct
            ringposi(nring) = search_next_i(nring)
            ringposj(nring) = search_next_j(nring)
ctm
c            print *,'nring= ',nring,' ringposi= ',ringposi(nring)
c     &                             ,' ringposj= ',ringposj(nring)
          enddo

          next_ring_ct = 0

          ! This next loop reviews the points that have been 
          ! labelled for the "beyond_contour" pool.  As we get further
          ! into successive iterations of successive_contours_loop, 
          ! some of these previously "beyond" points are now within 
          ! the contour interval range that we are checking, so we 
          ! need to go through the list of "beyond" points and remove
          ! any that are no longer in that "beyond" category....

          check_beyond_loop: do nb = 1,beyond_contour_ct

            ibx = beyond_contour_i(nb)
            jby = beyond_contour_j(nb)

            if (.not. point_is_already_in_beyond_pool(ibx,jby))
     &      then
              ! This point may have been removed already in a 
              ! previous iteration of successive_contours_loop.
              ! If this point is no longer in our pool of "beyond
              ! contour" points, then just cycle out of this
              ! iteration....
              cycle check_beyond_loop
            endif

            ! Check to see if any of the points being searched in the
            ! upcoming multiple_ring_loop are points that had previously
            ! been saved as "beyond_contour" points.  If so, remove 
            ! their status as "beyond_contour" points by setting the 
            ! logical flag to false.

            do nring = 1,ringct

              if (ibx == ringposi(nring) .and. jby == ringposj(nring))
     &        then
c                print *,' '
c                print *,'!!! beyond remove: ibx= ',ibx,' jby= ',jby
                point_is_already_in_beyond_pool(ibx,jby) = .false.
              endif

            enddo

          enddo check_beyond_loop


c         In each iteration of single_contour_scan_loop, we can have a
c         different number of rings to analyze.  In the first
c         iteration, we only have 1 ring, the initial ring around the
c         local max/min that was input to this subroutine.  Subsequent
c         iterations will have a variable number of rings, depending on
c         how many new data points within our contour interval were 
c         found in the previous iteration.

          multiple_ring_loop: do mr = 1,ringct

            icenx = ringposi(mr)
            jcenx = ringposj(mr)

ctm
c            print *,'  --- iter= ',iter,' mr= ',mr,' icenx= ',icenx
c     &             ,' jcenx= ',jcenx,' imax= ',imax,' jmax= ',jmax

            call get_ijplus1_check_wrap (imax,jmax,icenx,jcenx,ixp1,jxp1
     &                                  ,ixm1,jxm1,trkrinfo,igicwret)

            if (igicwret /= 0) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'!!! NO CLOSED CONTOUR: The call to '
                print *,'!!! get_ijplus1_check_wrap indicates the'
                print *,'!!! max/min contour extends past the edge of'
                print *,'!!! our regional grid. '
                print *,' '
                print *,' '
              endif


              do nm = 1,num_pts_in_all_contours
                im = hold_mask_i_loc(nm)
                jm = hold_mask_j_loc(nm)
                masked_out(im,jm) = .true.
              enddo

              deallocate (ringposi); deallocate (ringposj)
              deallocate (search_next_i); deallocate (search_next_j)
              deallocate (next_contour_i); deallocate (next_contour_j)
              deallocate (beyond_contour_i) 
              deallocate (beyond_contour_j)
              deallocate (hold_mask_i_loc) 
              deallocate (hold_mask_j_loc)
              deallocate (temp_mask_i_loc) 
              deallocate (temp_mask_j_loc)
              icccret = 0
              return
            endif

c           For each individual ring, we check all 8 points surrounding
c           the center point.  The points are numbered for each ring as
c           shown in the diagram to the right of the "select case" 
c           statement just below.  REMEMBER: The j in our grids 
c           increases from north to south, so that for a global grid,
c           j=1 is at 90N and j=jmax is at 90S.

            individual_ring_loop: do ir = 1,9

              select case (ir)
                case (1); irx=ixm1; jrx=jcenx;!     2       3       4 
                case (2); irx=ixm1; jrx=jxm1; !                      
                case (3); irx=icenx;jrx=jxm1; !                     
                case (4); irx=ixp1; jrx=jxm1; !     1 (icenx,jcenx) 5
                case (5); irx=ixp1; jrx=jcenx;!                     
                case (6); irx=ixp1; jrx=jxp1; !                     
                case (7); irx=icenx;jrx=jxp1; !     8       7       6
                case (8); irx=ixm1; jrx=jxp1; !                     
                case (9); irx=icenx; jrx=jcenx; ! = center pt of ring
              end select

c             Make sure the point we are looking at has valid data.  
c             This is an issue only on regional grids, where we have a
c             buffer of bitmapped (null) data points surrounding the 
c             real grid.

c             print *,'ind ring loop: ir= ',ir,' irx= ',irx,' jrx= ',jrx

              if (.not. valid_pt(irx,jrx)) then
                
                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'!!! NOTE: In check_closed_contour, while '
                  print *,'!!!    checking points around (icenx,jcenx)='
                  print *,'!!!    (',icenx,',',jcenx,'), we hit a non-'
                  print *,'!!!    valid point, meaning we are near the'
                  print *,'!!!    bounds of the grid, or at least the '
                  print *,'!!!    bounds of the valid data for this '
                  print *,'!!!    grid.  We will skip the'
                  print *,'!!!    search for this center.'
                  print *,'!!! '
                  print *,'!!! (i,j) of non-valid pt = ('
     &                   ,irx,',',jrx,')'
                  print *,'!!! '
                endif

                do nm = 1,num_pts_in_all_contours
                  im = hold_mask_i_loc(nm)
                  jm = hold_mask_j_loc(nm)
                  masked_out(im,jm) = .true.
                enddo

                deallocate (ringposi); deallocate (ringposj)
                deallocate (search_next_i); deallocate (search_next_j)
                deallocate (next_contour_i); deallocate (next_contour_j)
                deallocate (beyond_contour_i)
                deallocate (beyond_contour_j)
                deallocate (hold_mask_i_loc)
                deallocate (hold_mask_j_loc)
                deallocate (temp_mask_i_loc)
                deallocate (temp_mask_j_loc)
                icccret = 0
                return
              endif

c             Check to make sure that the point we are looking at is
c             not considered under the influence of another nearby low.

              if (masked_out(irx,jrx)) then

                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'!!! NOTE: In check_closed_contour, while '
                  print *,'!!!    checking points around (icenx,jcenx)='
                  print *,'!!!    (',icenx,',',jcenx,'), we hit a point'
                  print *,'!!!    that has been masked out, meaning it'
                  print *,'!!!    belongs under the influence of '
                  print *,'!!!    another nearby low, so we will skip'
                  print *,'!!!    the search for this center....'
                  print *,'!!!  '
                  print *,'!!! Min central value      = ',xcentval
                  print *,'!!! (i,j) of central value = (',ix,',',jx,')'
                  print *,'!!!  '
                  print *,'!!! Masked-out value found = ',fxy(irx,jrx)
                  print *,'!!! (i,j) of masked value  = (',irx,','
     &                 ,jrx,')'
                  print *,'!!!  '
                  print *,'!!! Lower bound of contour interval = '
     &                   ,contlo
                  print *,'!!! Upper bound of contour interval = '
     &                   ,conthi
                  print *,'!!! Contour interval = ',trkrinfo%contint
                  print *,'!!!    '
                  print *,'!!! closed_contour flag = ',closed_contour
                  print *,'!!!    '
                endif

                do nm = 1,num_pts_in_all_contours
                  im = hold_mask_i_loc(nm)
                  jm = hold_mask_j_loc(nm)
                  masked_out(im,jm) = .true.
                enddo

                deallocate (ringposi); deallocate (ringposj)
                deallocate (search_next_i); deallocate (search_next_j)
                deallocate (next_contour_i); deallocate (next_contour_j)
                deallocate (beyond_contour_i)
                deallocate (beyond_contour_j)
                deallocate (hold_mask_i_loc)
                deallocate (hold_mask_j_loc)
                deallocate (temp_mask_i_loc)
                deallocate (temp_mask_j_loc)
                icccret = 0
                return
              endif

c             If we have already hit this point on a previous ring 
c             check, then just ignore this point and cycle past it.

              if (point_is_already_in_our_contour(irx,jrx)) then
ctm
c                print *,' '
c                print *,'Pt. AAA, already-in-contour.....'
c                print *,'irx= ',irx,' jrx= ',jrx
                cycle individual_ring_loop
              endif

c             For a MIN check, check to see if the data point is below 
c             the contour interval or is below the local minimum value 
c             passed into this subroutine.  In either case, exit and 
c             consider this to NOT be a closed contour.
c             For a MAX check, check to see if the data point is above 
c             the contour interval or is above the local maximum value 
c             passed into this subroutine.  In either case, exit and 
c             consider this to NOT be a closed contour.
c             
c             For example, for mslp, this would be as we're moving 
c             outward away from lower pressures to higher pressures,
c             and then all of a sudden we come upon a lower pressure.
c             This probably means we're heading toward another low
c             pressure area, so mark the point and return to the 
c             calling routine.

              found_a_point_below_contour = 'n'
              found_a_point_above_contour = 'n'
              if (cmaxmin == 'min') then
                if (fxy(irx,jrx) < xcentval .or. fxy(irx,jrx) < contlo)
     &          then
                  found_a_point_below_contour = 'y'
                endif
              else 
                if (fxy(irx,jrx) > xcentval .or. fxy(irx,jrx) > conthi)
     &          then
                  found_a_point_above_contour = 'y'
                endif
              endif

              if (found_a_point_below_contour == 'y' .or.
     &            found_a_point_above_contour == 'y') then

                if ( verb .ge. 3 ) then
                  print *,' '
                  print *,'!!! NOTE: In check_closed_contour, while '
                  print *,'!!!    checking points around (icenx,jcenx)='
                  print *,'!!!    (',icenx,',',jcenx,'), we hit a data'
                  print *,'!!!    value that is less (greater) than the'
                  print *,'!!!    current contour interval bound for a'
                  print *,'!!!    min (max) and/or is less (greater) '
                  print *,'!!!    than the minimum (maximum) central '
                  print *,'!!!    value that we are centering the '
                  print *,'!!!    search on.'
                  print *,'!!!    '
                  print *,'!!! Central value      = ',xcentval
                  print *,'!!! (i,j) of central value = (',ix,',',jx,')'
                  print *,'!!!  '
                  print *,'!!! Flagged value found    = ',fxy(irx,jrx)
                  print *,'!!! (i,j) of flagged value = (',irx,','
     &                 ,jrx,')'
                  print *,'!!!   '
                  print *,'!!! Lower bound of contour interval = '
     &                   ,contlo
                  print *,'!!! Upper bound of contour interval = '
     &                   ,conthi
                  print *,'!!! Contour interval = ',trkrinfo%contint
                  print *,'!!!    '
                  print *,'!!! closed_contour flag = ',closed_contour
                  print *,'!!! ' 
                endif

                do nm = 1,num_pts_in_all_contours
                  im = hold_mask_i_loc(nm)
                  jm = hold_mask_j_loc(nm)
                  masked_out(im,jm) = .true.
                enddo

                deallocate (ringposi); deallocate (ringposj)
                deallocate (search_next_i); deallocate (search_next_j)
                deallocate (next_contour_i); deallocate (next_contour_j)
                deallocate (beyond_contour_i)
                deallocate (beyond_contour_j)
                deallocate (hold_mask_i_loc)
                deallocate (hold_mask_j_loc)
                deallocate (temp_mask_i_loc)
                deallocate (temp_mask_j_loc)
                icccret = 0
                return
              endif 

c             If we've made it this far, then we at least know that the
c             gradient is still heading in the right direction.  Do the
c             check now to see if the value at this point is within our
c             specific contour interval (there is the possibility that
c             the value is beyond our interval, which will be checked
c             for just below, and if that's the case, then that point
c             will be processed in a subsequent iteration of this loop
c             that encompasses that correct contour interval).

              found_a_point_in_our_contour = 'n'
              if (cmaxmin == 'min') then
                if (fxy(irx,jrx) >= contlo .and. fxy(irx,jrx) < conthi)
     &          then
                  found_a_point_in_our_contour = 'y'
                endif
              else
                if (fxy(irx,jrx) > contlo .and. fxy(irx,jrx) <= conthi) 
     &          then
                  found_a_point_in_our_contour = 'y'
                endif
              endif

              if (found_a_point_in_our_contour == 'y') then
                ! We've found a data point in our interval, something 
                ! that is inside the closed contour, and it hasn't been
                ! marked as being found in a previous iteration of this 
                ! loop, so mark it now and store the (i,j) location so 
                ! that we can scan a ring around this point in a 
                ! successive iteration of this loop for more potential 
                ! points within this interval...

                point_is_already_in_our_contour(irx,jrx) = .true.

                next_ring_ct = next_ring_ct + 1
                search_next_i(next_ring_ct) = irx
                search_next_j(next_ring_ct) = jrx

c                print *,'at B, next_ring_ct= ',next_ring_ct
c     &               ,' search_next_i()= ',search_next_i(next_ring_ct)
c     &               ,' search_next_j()= ',search_next_j(next_ring_ct)

                num_pts_in_one_contour = num_pts_in_one_contour + 1
                temp_mask_i_loc(num_pts_in_one_contour) = irx
                temp_mask_j_loc(num_pts_in_one_contour) = jrx

                if (get_last_isobar_flag == 'y') then
                  call calcdist (glon(ix),glat(jx)
     &                          ,glon(irx),glat(jrx),dist,degrees)
                  rlast_distsum = rlast_distsum + dist
                  rlast_distct  = rlast_distct + 1
                endif

ctm
c                print *,' '
c                print *,' PT IN! irx= ',irx,' jrx= ',jrx,' xval= '
c     &                 ,fxy(irx,jrx)
c                print *,'next_ring_ct= ',next_ring_ct
c                print *,'num_pts_in_one_contour= '
c     &                 ,num_pts_in_one_contour
              endif

c             If we've made it this far AND the 
c             found_a_point_in_our_contour flag indicates that this
c             point is not in our contour interval, then by default that
c             means that this point is for a contour interval beyond 
c             what we're currently looking at.  E.g., if we're looking 
c             at the contours around a 972 mb low and we're moving 
c             outward and currently checking the 984-988 mb contour 
c             interval, it means that we found, say, a gridpoint with 
c             991 mb.  So we want to mark that point for a future 
c             iteration of this loop that would be checking the 
c             988-992 mb contour interval.

              if (found_a_point_in_our_contour /= 'y' .and. 
     &            .not. point_is_already_in_next_contour(irx,jrx)) then
                ! We've found a data point that is beyond our interval,
                ! so this is not a concern for finding the bounds of 
                ! our current contour interval, but we want to mark 
                ! these points and remember them for the next iteration
                ! of successive_scan_loop.  (For example, suppose we 
                ! are currently searching for points in the 984-988 mb
                ! range, and we find a point that is 990 -- mark it 
                ! here to be remembered when we scan for 988-992 mb).
                if (cmaxmin == 'min') then
                  contlo_next = conthi
                  conthi_next = conthi + trkrinfo%contint
                  if (fxy(irx,jrx) >= contlo_next .and. 
     &                fxy(irx,jrx) <  conthi_next) then
                    ! "NEXT_CONTOUR" Comment:
                    ! We've found a point that is in the very next
                    ! contour interval....
                    next_contour_ct = next_contour_ct + 1
                    next_contour_i(next_contour_ct) = irx
                    next_contour_j(next_contour_ct) = jrx
                    point_is_already_in_next_contour(irx,jrx) = .true.
                  else if (fxy(irx,jrx) >= conthi_next) then
                    ! "BEYOND_CONTOUR" Comment:
                    ! This point is at least 1 contour interval beyond
                    ! the next contour interval.  Dump the info into 
                    ! these i and j arrays.  This info will be used if
                    ! in the next iteration of single_contour_scan_loop,
                    ! next_contour_ct = 0.  That would mean that we 
                    ! have, e.g., an intensely deep low with a sharp
                    ! mslp gradient that essentially "skips" over a 
                    ! contour interval.  E.g., if using a 4 mb interval,
                    ! we go from 947 to 953 AND there are NO
                    ! intervening gridpoints in the 948-952 interval.
                    beyond_contour_ct = beyond_contour_ct + 1
                    beyond_contour_i(beyond_contour_ct) = irx
                    beyond_contour_j(beyond_contour_ct) = jrx
                    point_is_already_in_beyond_pool(irx,jrx) = .true.
c                    print *,'bcc= ',beyond_contour_ct
c     &                     ,'beyond_contour_i()= '
c     &                     ,beyond_contour_i(beyond_contour_ct)
c     &                     ,'beyond_contour_j()= '
c     &                     ,beyond_contour_j(beyond_contour_ct)
                  endif
                else
                  contlo_next = contlo - trkrinfo%contint
                  conthi_next = contlo
                  if (fxy(irx,jrx) >  contlo_next .and. 
     &                fxy(irx,jrx) <= conthi_next) then
                    ! See "NEXT_CONTOUR" comment just above....
                    next_contour_ct = next_contour_ct + 1
                    next_contour_i(next_contour_ct) = irx
                    next_contour_j(next_contour_ct) = jrx
                    point_is_already_in_next_contour(irx,jrx) = .true.
c                    print *,'NEXT ncc= ',next_contour_ct
c     &                     ,'next_contour_i()= '
c     &                     ,next_contour_i(next_contour_ct)
c     &                     ,'next_contour_j()= '
c     &                     ,next_contour_j(next_contour_ct)
c     &                     ,' fxy= ',fxy(irx,jrx)
                  else if (fxy(irx,jrx) <= contlo_next) then
                    ! See "BEYOND_CONTOUR" comment just above....
                    beyond_contour_ct = beyond_contour_ct + 1
                    beyond_contour_i(beyond_contour_ct) = irx
                    beyond_contour_j(beyond_contour_ct) = jrx
                    point_is_already_in_beyond_pool(irx,jrx) = .true.
c                    print *,'BEYOND bcc= ',beyond_contour_ct
c     &                     ,'beyond_contour_i()= '
c     &                     ,beyond_contour_i(beyond_contour_ct)
c     &                     ,'beyond_contour_j()= '
c     &                     ,beyond_contour_j(beyond_contour_ct)
c     &                     ,' fxy= ',fxy(irx,jrx)
                  endif
                endif
              endif 
               
            enddo individual_ring_loop

          enddo multiple_ring_loop

          if (next_ring_ct > 0) then
            iter = iter + 1
          else
            icccret = 0
            still_scanning = .false.
            if (allocated(ringposi)) deallocate (ringposi)
            if (allocated(ringposj)) deallocate (ringposj)
            num_found_contours = num_found_contours + 1
            closed_contour = 'y'
            if (num_found_contours == 1) then

              if ( verb .ge. 3 ) then
                print *,' '
                print *,'+++ Closed contour found '
              endif

            endif
          endif

        enddo single_contour_scan_loop

        do insingle = 1,num_pts_in_one_contour
          num_pts_in_all_contours = num_pts_in_all_contours + 1
          inall = num_pts_in_all_contours
          hold_mask_i_loc(inall) = temp_mask_i_loc(insingle) 
          hold_mask_j_loc(inall) = temp_mask_j_loc(insingle) 
        enddo

        if (get_last_isobar_flag == 'y') then
          if (cmaxmin == 'min') then
            plastbar = conthi
          else
            plastbar = contlo
          endif
          if (rlast_distct > 0) then
            rlastbar = rlast_distsum / float(rlast_distct)
            rlastbar = rlastbar * 0.539638  ! convert km to nm
          else            
            rlastbar = -999.0
          endif           
        endif

      enddo successive_contours_loop

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'END SUM: num of iterations = ',isc_count
      endif

      do nm = 1,num_pts_in_all_contours
        im = hold_mask_i_loc(nm)
        jm = hold_mask_j_loc(nm)
        masked_out(im,jm) = .true.
      enddo

      if (allocated(search_next_i))    deallocate (search_next_i)
      if (allocated(search_next_j))    deallocate (search_next_j)
      if (allocated(next_contour_i))   deallocate (next_contour_i)
      if (allocated(next_contour_j))   deallocate (next_contour_j)
      if (allocated(beyond_contour_i)) deallocate (beyond_contour_i)
      if (allocated(beyond_contour_j)) deallocate (beyond_contour_j)
      if (allocated(hold_mask_i_loc))  deallocate (hold_mask_i_loc)
      if (allocated(hold_mask_j_loc))  deallocate (hold_mask_j_loc)
      if (allocated(temp_mask_i_loc))  deallocate (temp_mask_i_loc)
      if (allocated(temp_mask_j_loc))  deallocate (temp_mask_j_loc)
      if (allocated(ringposi))         deallocate (ringposi)
      if (allocated(ringposj))         deallocate (ringposj)
c
      return
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine check_land_mask (imax,jmax,ix,jx,fract_land,valid_pt
     &                            ,dx,dy,point_is_over_water,iclmret)
c
c     ABSTRACT: This subroutine looks at the values for the land-sea 
c     mask surrounding an input (i,j) position to determine if less 
c     than 50% of the area surrounding the input (i,j) position within
c     75 km radius is land.
c
c     INPUT:
c     imax     Num pts in i-direction on grid
c     jmax     Num pts in j-direction on grid
c     ix       i index for location of local max or min
c     jx       j index for location of local max or min
c     valid_pt Logical; bitmap indicating if valid data at that pt
c     dx       Grid spacing in x-direction
c     dy       Grid spacing in y-direction
c
c     OUTPUT:
c     fract_land  Fraction of points/area that is covered by land
c     point_is_over_water  y/n: A value of 'y' is returned if <50%
c                          of the points/area is covered by land
c     iclmret  Return code from this routine
c
      USE grid_bounds; USE tracked_parms
      USE trkrparms; USE verbose_output

      implicit none

      type (trackstuff) trkrinfo

      integer date_time(8)
      character (len=10) big_ben(3)

      logical(1) valid_pt(imax,jmax)
      character  point_is_over_water*1
      integer, parameter :: numazim=8
      integer  iazim,ibiret1,imax,jmax,ix,jx,iclmret,imct
      real     bear,targlat,targlon,xplon,yplat,rdist,xintrp_mask
      real     fract_land,dx,dy,xmask_sum
c
      iclmret = 0

c     First, calculate the longitude and latitude of the input ix and
c     jx points.  If the xplon value ends up being >360.0 (this can 
c     happen for basin-scale HWRF), don't worry about it.  Just leave
c     it be, as the trigonometry will work out the same for lons >360.

      xplon = glonmin + (ix-1)*dx
      yplat = glatmax - (jx-1)*dy

      rdist = 75.0  ! (We will always look only 75 km radius out for 
                    !  this particular land-sea mask application)

      imct = 0

c     Now go around the storm via azimloop and get interpolated 
c     values of the land-sea mask at each azimuth at a radial 
c     distance of 75 km from the center point....

      xmask_sum = 0.0

      azimloop: do iazim = 1,numazim

        bear = ((iazim-1) * 15.) + 45.0

        call distbear (yplat,xplon,rdist,bear,targlat,targlon)

        ! These calls to bilin_int_uneven pass a variable, level,
        ! that is used for applications of interpolating wind 
        ! data.  Here, we are instead interpolating the land-sea
        ! mask data, so we don't care about the level, so just 
        ! pass a dummy value of 850, which never gets used.

        call bilin_int_uneven (targlat,targlon
     &      ,dx,dy,imax,jmax,trkrinfo,850,'m',xintrp_mask,ibiret1)

        if (ibiret1 == 0) then
          xmask_sum = xmask_sum + xintrp_mask
          imct = imct + 1
        else
          iclmret = 95
          return
        endif

      enddo azimloop

c     Now get the mask value directly at the point that was input to 
c     this routine....

      xmask_sum = xmask_sum + lsmask(ix,jx)
      imct = imct + 1

c     Now get the mean land fraction....

      if (imct > 0) then

        fract_land = xmask_sum / float(imct)
        if (fract_land < 0.50) then
          point_is_over_water = 'y'
          if ( verb .ge. 3 ) then
            print *,' '
            print *,'+++ Land check yes: Point is over water. '
            print *,'    Land check value: fract_land= ',fract_land
          endif
        else
          point_is_over_water = 'n'
          if ( verb .ge. 3 ) then
            print *,' '
            print *,'!!! Land check NO: Point is over land. '
            print *,'    Land check value: fract_land= ',fract_land
          endif
        endif

      else

        iclmret = 95
        return

      endif
c
      return 
      end
c
c---------------------------------------------------------------------
c
c---------------------------------------------------------------------
      subroutine get_ijplus1_check_wrap (imax,jmax,i,j,iplus1,jplus1
     &                            ,iminus1,jminus1,trkrinfo,igicwret)
c
c     ABSTRACT: This subroutine takes an (i,j) position input and 
c     returns the four neighboring (i,j) points to the east, south, 
c     west and north.  The routine checks for wrap around the GM, so 
c     that if, for example, you are on a global 360x181 grid and you
c     are at point i=360, then i+1 = 361, so you need something to 
c     adjust that back to i = 1.  Likewise, if you are at i=1 and 
c     looking for point i-1, it will adjust it to be point 360 
c     instead of the meaningless point 0 (i=0).

      USE trkrparms
      USE verbose_output

      implicit none

      type (trackstuff) trkrinfo
      integer   i,j,imax,jmax,iplus1,jplus1,iminus1,jminus1,igicwret

      igicwret = 0

      jplus1  = j + 1
      jminus1 = j - 1
      iplus1  = i + 1
      iminus1 = i - 1

      if (iplus1 > imax) then
        if (trkrinfo%gridtype == 'global') then
          iplus1 = iplus1 - imax   ! If wrapping east of GM
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: Error in get_ijplus1_check_wrap.  The'
            print *,'!!!        user-requested eastern search boundary'
            print *,'!!!        is too close to the eastern bounds of'
            print *,'!!!        this regional grid.  When we check '
            print *,'!!!        neighboring points, we are going past'
            print *,'!!!        the edge of the grid by one point. '
            print *,'!!!        Cut back your requested eastern  '
            print *,'!!!        boundary by a degree or 2 in the  '
            print *,'!!!        script and resubmit....'
            print *,'!!!         '
            print *,'!!!   imax of regional grid    = ',imax
            print *,'!!!   User-requested eastern i = ',iplus1
            print *,' '
          endif

          igicwret = 98
          return
        endif
      endif

      if (iminus1 < 1) then
        if (trkrinfo%gridtype == 'global') then
          iminus1 = imax + iminus1  ! If wrapping west of GM
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR: Error in get_ijplus1_check_wrap.  The'
            print *,'!!!        user-requested western search boundary'
            print *,'!!!        is too close to the western bounds of'
            print *,'!!!        this regional grid.  When we check '
            print *,'!!!        neighboring points, we are going past'
            print *,'!!!        the edge of the grid by one point. '
            print *,'!!!        Cut back your requested western  '
            print *,'!!!        boundary by a degree or 2 in the  '
            print *,'!!!        script and resubmit....'
            print *,'!!!         '
            print *,'!!!   User-requested western i = ',iminus1
            print *,' '
          endif

          igicwret = 98
          return
        endif
      endif

      if (jplus1 > jmax .or. jminus1 < 1) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR: Error in get_ijplus1_check_wrap.  The '
          print *,'!!!     user-requested northern or southern search'
          print *,'!!!     boundary is too close to the bounds of the'
          print *,'!!!     grid.  Cut back your requested northern or'
          print *,'!!!     southern boundary by a degree or 2 in the'
          print *,'!!!     script and resubmit....'
          print *,'!!! '
          print *,'!!!   User-requested northern j = ',jminus1
          print *,'!!!   User-requested southern j = ',jplus1
          print *,'!!!   jmax of grid              = ',jmax
          print *,'    '
        endif

        igicwret = 91
        return
      endif
    
      return
      end

c------------------------------------------------------------------
c
c------------------------------------------------------------------
      SUBROUTINE qsort(x,ind,n)
c
c     Code converted using TO_F90 by Alan Miller
c     Date: 2002-12-18  Time: 11:55:47

      IMPLICIT NONE
      INTEGER, PARAMETER  :: dp = SELECTED_REAL_KIND(12, 60)

      REAL (dp), INTENT(IN)  :: x(n)
      INTEGER, INTENT(OUT)   :: ind(n)
      INTEGER, INTENT(IN)    :: n

c     ***************************************************************************
c
c                                                              ROBERT RENKA
c                                                      OAK RIDGE NATL. LAB.
c
c        THIS SUBROUTINE USES AN ORDER N*LOG(N) QUICK SORT TO SORT A REAL (dp)
c      ARRAY X INTO INCREASING ORDER.  THE ALGORITHM IS AS FOLLOWS.  IND IS
c      INITIALIZED TO THE ORDERED SEQUENCE OF INDICES 1,...,N, AND ALL INTERCHANGES
c      ARE APPLIED TO IND.  X IS DIVIDED INTO TWO PORTIONS BY PICKING A CENTRAL
c      ELEMENT T.  THE FIRST AND LAST ELEMENTS ARE COMPARED WITH T, AND
c      INTERCHANGES ARE APPLIED AS NECESSARY SO THAT THE THREE VALUES ARE IN
c      ASCENDING ORDER.  INTERCHANGES ARE THEN APPLIED SO THAT ALL ELEMENTS
c      GREATER THAN T ARE IN THE UPPER PORTION OF THE ARRAY AND ALL ELEMENTS
c      LESS THAN T ARE IN THE LOWER PORTION.  THE UPPER AND LOWER INDICES OF ONE
c      OF THE PORTIONS ARE SAVED IN LOCAL ARRAYS, AND THE PROCESS IS REPEATED
c      ITERATIVELY ON THE OTHER PORTION.  WHEN A PORTION IS COMPLETELY SORTED,
c      THE PROCESS BEGINS AGAIN BY RETRIEVING THE INDICES BOUNDING ANOTHER
c      UNSORTED PORTION.
c
c      INPUT PARAMETERS -   N - LENGTH OF THE ARRAY X.
c
c                           X - VECTOR OF LENGTH N TO BE SORTED.
c
c                         IND - VECTOR OF LENGTH >= N.
c
c      N AND X ARE NOT ALTERED BY THIS ROUTINE.
c
c      OUTPUT PARAMETER - IND - SEQUENCE OF INDICES 1,...,N PERMUTED IN THE SAME
c                               FASHION AS X WOULD BE.  THUS, THE ORDERING ON
c                               X IS DEFINED BY Y(I) = X(IND(I)).
c
c     *********************************************************************

      ! NOTE -- IU AND IL MUST BE DIMENSIONED >= LOG(N) WHERE LOG HAS BASE 2.

      !*********************************************************************

      INTEGER   :: iu(21), il(21)
      INTEGER   :: m, i, j, k, l, ij, it, itt, indx
      REAL      :: r
      REAL (dp) :: t

      ! LOCAL PARAMETERS -

      ! IU,IL =  TEMPORARY STORAGE FOR THE UPPER AND LOWER
      !            INDICES OF PORTIONS OF THE ARRAY X
      ! M =      INDEX FOR IU AND IL
      ! I,J =    LOWER AND UPPER INDICES OF A PORTION OF X
      ! K,L =    INDICES IN THE RANGE I,...,J
      ! IJ =     RANDOMLY CHOSEN INDEX BETWEEN I AND J
      ! IT,ITT = TEMPORARY STORAGE FOR INTERCHANGES IN IND
      ! INDX =   TEMPORARY INDEX FOR X
      ! R =      PSEUDO RANDOM NUMBER FOR GENERATING IJ
      ! T =      CENTRAL ELEMENT OF X

      IF (n <= 0) RETURN

      ! INITIALIZE IND, M, I, J, AND R

      DO  i = 1, n
        ind(i) = i
      END DO
      m = 1
      i = 1
      j = n
      r = .375

      ! TOP OF LOOP

   20 IF (i >= j) GO TO 70
      IF (r <= .5898437) THEN
        r = r + .0390625
      ELSE
        r = r - .21875
      END IF

      ! INITIALIZE K

   30 k = i

      ! SELECT A CENTRAL ELEMENT OF X AND SAVE IT IN T

      ij = i + r*(j-i)
      it = ind(ij)
      t = x(it)

      ! IF THE FIRST ELEMENT OF THE ARRAY IS GREATER THAN T,
      !   INTERCHANGE IT WITH T

      indx = ind(i)
      IF (x(indx) > t) THEN
        ind(ij) = indx
        ind(i) = it
        it = indx
        t = x(it)
      END IF

      ! INITIALIZE L

      l = j

      ! IF THE LAST ELEMENT OF THE ARRAY IS LESS THAN T,
      !   INTERCHANGE IT WITH T
      indx = ind(j)
      IF (x(indx) >= t) GO TO 50
      ind(ij) = indx
      ind(j) = it
      it = indx
      t = x(it)

      ! IF THE FIRST ELEMENT OF THE ARRAY IS GREATER THAN T,
      !   INTERCHANGE IT WITH T

      indx = ind(i)
      IF (x(indx) <= t) GO TO 50
      ind(ij) = indx
      ind(i) = it
      it = indx
      t = x(it)
      GO TO 50

      ! INTERCHANGE ELEMENTS K AND L

   40 itt = ind(l)
      ind(l) = ind(k)
      ind(k) = itt

      ! FIND AN ELEMENT IN THE UPPER PART OF THE ARRAY WHICH IS
      !   NOT LARGER THAN T

   50 l = l - 1
      indx = ind(l)
      IF (x(indx) > t) GO TO 50

      ! FIND AN ELEMENT IN THE LOWER PART OF THE ARRAY WHCIH IS NOT SMALLER THAN T

   60 k = k + 1
      indx = ind(k)
      IF (x(indx) < t) GO TO 60

      ! IF K <= L, INTERCHANGE ELEMENTS K AND L

      IF (k <= l) GO TO 40

      ! SAVE THE UPPER AND LOWER SUBSCRIPTS OF THE PORTION OF THE
      !   ARRAY YET TO BE SORTED

      IF (l-i > j-k) THEN
        il(m) = i
        iu(m) = l
        i = k
        m = m + 1
        GO TO 80
      END IF

      il(m) = k
      iu(m) = j
      j = l
      m = m + 1
      GO TO 80


      ! BEGIN AGAIN ON ANOTHER UNSORTED PORTION OF THE ARRAY

   70 m = m - 1
      IF (m == 0) RETURN
      i = il(m)
      j = iu(m)

   80 IF (j-i >= 11) GO TO 30
      IF (i == 1) GO TO 20
      i = i - 1

      ! SORT ELEMENTS I+1,...,J.  NOTE THAT 1 <= I < J AND J-I < 11.

   90 i = i + 1
      IF (i == j) GO TO 70
      indx = ind(i+1)
      t = x(indx)
      it = indx
      indx = ind(i)
      IF (x(indx) <= t) GO TO 90
      k = i

  100 ind(k+1) = ind(k)
      k = k - 1
      indx = ind(k)
      IF (t < x(indx)) GO TO 100

      ind(k+1) = it
      GO TO 90
      END SUBROUTINE qsort

c
c-----------------------------------------------------------------------
c Added by JPENG 03/21/2018, regarding FTN compiler with FORT11/FORT31
      subroutine open_grib_files (inp,lugb,lugi,gfilename,ifilename
     &                           ,lout,iret)

C     ABSTRACT: This subroutine must be called before any attempt is
C     made to read from the input GRIB files.  The GRIB and index files
C     are  opened with a call to baopenr.  This call to baopenr was not
C     needed in the cray version of this program (the files could be
C     opened with a simple Cray assign statement), but the GRIB-reading
C     utilities on the SP do require calls to this subroutine (it has
C     something to do with the GRIB I/O being done in C on the SP, and
C     the C I/O package needs an explicit open statement).
C
C     INPUT:
c     inp      Contains user-input info on the date & data
C     lugb     The Fortran unit number for the GRIB data file
C     lugi     The Fortran unit number for the GRIB index file
c     ifh      integer index for lead time level
c     gfilename If using individual files for each tau, gfilename will
c              contain the grib data filename for this tau.  Otherwise,
c              if using one big file for all taus, this contains dummy
c              character data.
c     ifilename If using individual files for each tau, gfilename will
c              contain the grib index filename for this tau.  Otherwise,
c              if using one big file for all taus, this contains dummy
c              character data.
C     lout     The Fortran unit number for the  output grib file
C
C     OUTPUT:
C     iret     The return code from this subroutine

      USE inparms
      USE verbose_output

      implicit none
c
      type (datecard) inp

      logical(1)  output_file_open
      logical(1)  file_open
      character(*) gfilename,ifilename
      character(120) gopen_g_file,gopen_i_file
      character(2) lugb_c,lugi_c
      character(6) enameb,enamei
      integer  igoret,iioret,iooret,lugb,lugi,lout,iret,nlen1,nlen2

      iret=0

      if (inp%file_seq == 'onebig') then
        write(lugb_c,'(i2)')lugb
        write(lugi_c,'(i2)')lugi
        enameb='FORT'//adjustl(lugb_c)
        enamei='FORT'//adjustl(lugi_c)
        call get_environment_variable(enameb,gopen_g_file,status=igoret)
        call get_environment_variable(enamei,gopen_i_file,status=iioret)
        if (igoret /= 0 .or. iioret /= 0 .or. iooret /= 0) then
          gopen_g_file(1:5) = "fort."
          gopen_i_file(1:5) = "fort."
          write(gopen_g_file(6:7),'(I2)') lugb
          write(gopen_i_file(6:7),'(I2)') lugi
        endif
      else
        nlen1        = len_trim(gfilename)
        gopen_g_file = trim(gfilename(1:nlen1))
        nlen2        = len_trim(ifilename)
        gopen_i_file = trim(ifilename(1:nlen2))
      endif
      call baopenr (lugb,gopen_g_file,igoret)
      call baopenr (lugi,gopen_i_file,iioret)

c      print *,'gopen_g_file= ',gopen_g_file,'....'
c      print *,'gopen_i_file= ',gopen_i_file,'....'

      inquire (unit=lugb, opened=file_open)
      if (file_open) then
        print *,'TEST open_grib_files, unit lugb= ',lugb
     &        ,' is OPEN'
      else
        print *,'TEST open_grib_files, unit lugb= ',lugb
     &         ,' is CLOSED'
      endif

      inquire (unit=lugi, opened=file_open)
      if (file_open) then
        print *,'TEST open_grib_files, unit lugi= ',lugi
     &         ,' is OPEN'
      else
        print *,'TEST open_grib_files, unit lugi= ',lugi
     &         ,' is CLOSED'
      endif

      if ( verb .ge. 3 ) then
        print *,' '
        print *,'baopen: igoret= ',igoret,' iioret= ',iioret
     &       ,' iooret= ',iooret
      endif

      if (igoret /= 0 .or. iioret /= 0 .or. iooret /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in sub open_grib_files opening grib file'
          print *,'!!! or grib index file.  baopen return codes:'
          print *,'!!! grib  file return code = igoret = ',igoret
          print *,'!!! index file return code = iioret = ',iioret
          print *,'!!! output file return code = iooret = ',iooret
        endif

        iret = 113
        return
      endif

      return
      end

c-----------------------------------------------------------------------
c Added by JPENG 03/21/2018, regarding FTN compiler with FORT12
      subroutine read_tcv_card (lucard,maxstorm,trkrinfo,numtcv,iret)
c
c     ABSTRACT: This subroutine reads in the updated TC Vitals file
c               for the current time and prints out those cards (storms)
c               that have been selected to be processed.  It also
c               takes the initial positions from the tcv card for each
c               storm and puts them into the slonfg & slatfg arrays.
c               Note that this routine is reading in vitals in the
c               standard format for TCs only.  Any genesis vitals are
c               read in in subroutine  read_gen_vitals.
c
c     INPUT:
c     lucard    integer unit number for tcvitals card
c     trkrinfo  derived type that contains info on the type of
c               tracker run that we are performing.
c
c     OUTPUT:
c     maxstorm  max # of storms to be handled for this case
c     numtcv    number of storms read off of the input tcvitals file
c     iret      return code from this subroutine
c
c     OTHER:
c     stormswitch 1,2 or 3 (see more description under Main pgm section)
c     slonfg     first guess array for longitude
c     slatfg     first guess array for latitude
c     storm      contains the tcvitals info
c     (storm, stormswitch, slonfg and slatfg are allocatable and are
c      defined in module def_vitals)

      USE def_vitals; USE set_max_parms; USE trkrparms
      USE verbose_output

      implicit none

      type (tcvcard) tmpstorm(maxstorm_tc)
      type (trackstuff) trkrinfo
      integer    isa,issa,ioa,iaa,ita,iret,ict,maxstorm
      integer    i,ii,lucard,numtcv
c------
      ii=1
      do while (.true. .and. ii <= maxstorm_tc)
        read (lucard,21,END=801,ERR=891) tmpstorm(ii)
        ii = ii + 1
      enddo
   21 format (a4,1x,a3,1x,a9,1x,i8,1x,i4,1x,i3,a1,1x,i4,a1,1x,i3,1x
     &       ,i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)

  801 continue

      numtcv = ii - 1

      if (trkrinfo%type == 'midlat' .or. trkrinfo%type == 'tcgen') then
        ! For the mid-latitude or tc genesis cases, the max number
        ! of storms (maxstorm) allowed to be tracked throughout a
        ! forecast is defined in module set_max_parms.

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'In read_tcv_card, tracker type of "midlat" or '
          print *,'"tcgen" indicates that this run of the  tracker is'
          print *,'for a midlat or a tcgen case....'
        endif

        maxstorm = maxstorm_mg
        allocate (stormswitch(maxstorm),stat=isa)
        allocate (storm(maxstorm),stat=issa)
        allocate (slonfg(maxstorm,maxtime),stat=ioa)
        allocate (slatfg(maxstorm,maxtime),stat=iaa)
        allocate (stcvtype(maxstorm),stat=ita)
        if (isa /= 0 .or. ioa /= 0 .or. iaa /= 0 .or. issa /= 0 .or.
     &      ita /= 0) then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in read_tcv_card allocating stormswitch,'
            print *,'!!! slonfg, storm, slatfg or stcvtype arrays.  '
            print *,'!!! isa = ',isa,' ioa= ',ioa,' iaa= ',iaa,' issa= '
            print *,'!!! ',issa,' ita= ',ita
          endif

          iret = 97
          return
        endif
        slonfg = 0.0; slatfg = 0.0
        stcvtype = 'FOF' ! Found On the Fly by tracker (not on tcvitals)
        stormswitch = 3    ! Initialize whole array to case of '3'
        if (numtcv > 0) then
          if ( verb .ge. 3 ) then
            print *,' '
            print *,'Following are the already-existing storms that'
            print *,'were read in from the tc vitals file: '
            print *,' '
          endif

          ict = 0
          do i=1,numtcv
            stormswitch(i) = 1
            storm(i) = tmpstorm(i)
            ict = ict + 1

            if ( verb .ge. 3 ) then
              write (*,31) storm(i)
            endif

            if (storm(i)%tcv_lonew == 'W') then
              slonfg(i,1) =  360. - float(storm(i)%tcv_lon)/10.0
            else
              slonfg(i,1) = float(storm(i)%tcv_lon)/10.0
            endif
            if (storm(i)%tcv_latns == 'S') then
              slatfg(i,1) = -1. * float(storm(i)%tcv_lat)/10.0
            else
              slatfg(i,1) = float(storm(i)%tcv_lat)/10.0
            endif
            stcvtype(i) = 'TCV' ! Storm listed on tcvitals

c            if (trkrinfo%type == 'midlat') then
c              storm(i)%tcv_center = 'MIDL'
c            else if (trkrinfo%type == 'tcgen') then
c              storm(i)%tcv_center = 'TCG '
c            endif
c            write (storm(i)%tcv_storm_id,'(i4.4)') i
c            write (storm(i)%tcv_storm_name,'(i4.4)') i

          enddo
        endif
        iret=0
        return
      else
        ! For the  tracker cases, the max number of storms (maxstorm)
        ! allowed to be tracked throughout a forecast is defined by
        ! the number of vitals read in above.
        maxstorm = numtcv
        allocate (stormswitch(maxstorm),stat=isa)
        allocate (storm(maxstorm),stat=issa)
        allocate (slonfg(maxstorm,maxtime),stat=ioa)
        allocate (slatfg(maxstorm,maxtime),stat=iaa)
        allocate (stcvtype(maxstorm),stat=ita)
        if (isa /= 0 .or. ioa /= 0 .or. iaa /= 0 .or. issa /= 0 .or.
     &      ita /= 0) then

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in read_tcv_card allocating stormswitch,'
            print *,'!!! slonfg, storm, slatfg or stcvtype arrays.  '
            print *,'!!! isa = ',isa,' ioa= ',ioa,' iaa= ',iaa,' issa= '
            print *,'!!! ',issa,' ita= ',ita
          endif

          iret = 97
          return
        endif

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'Following are the storms to be processed: '
          print *,' '
        endif

        slonfg = 0.0; slatfg = 0.0
        stcvtype = '   '  ! Not needed for regular tracker run....
        ict=0
        do i=1,maxstorm
          stormswitch(i) = 1
          storm(i) = tmpstorm(i)
          ict = ict + 1

          if ( verb .ge. 3 ) then
            write (*,31) storm(i)
          endif

          if (storm(i)%tcv_lonew == 'W') then
            slonfg(i,1) =  360. - float(storm(i)%tcv_lon)/10.0
          else
            slonfg(i,1) = float(storm(i)%tcv_lon)/10.0
          endif
          if (storm(i)%tcv_latns == 'S') then
            slatfg(i,1) = -1. * float(storm(i)%tcv_lat)/10.0
          else
            slatfg(i,1) = float(storm(i)%tcv_lat)/10.0
          endif
        enddo

        if (ict.gt.0) then
          iret = 0
          return
        else

          if ( verb .ge. 1 ) then
            print *,' '
            print *,'!!! ERROR in read_tcv_card, num storms to be '
            print *,'!!! processed is not greater than 0 for a tracker'
            print *,'!!! case.  Check to see that you have the Fortran'
            print *,'!!! unit assigned right in your script.'
          endif

          iret = 99
          return
        endif

      endif

   31 format (a4,1x,a3,1x,a9,1x,i8.8,1x,i4.4,1x,i3,a1,1x,i4,a1,1x
     &       ,i3,1x,i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)

 891  continue

      if ( verb .ge. 1 ) then
        print *,'!!! ERROR in read_tcv_card reading unit ',lucard
      endif

      iret = 98
c
      return
      end
c-----------------------------------------------------------------------
c Added by JPENG 03/21/2018, regarding FTN compiler with FORT14
      subroutine read_gen_vitals (lgvcard,maxstorm,trkrinfo,numtcv,iret)
c
c     ABSTRACT: This subroutine reads in a modified TC Vitals file
c     for the current time and prints out those cards (storms) that
c     have been selected to be processed.  It also takes the initial
c     positions from the tcv card for each storm and puts them into
c     the slonfg & slatfg arrays.
c
c     The reason that these are referred to as modified tcvitals is
c     that the format is different from standard TC vitals format.
c     These vitals are created by a previous run of this tracker
c     executable, and the storm identifier is different than that
c     for a standard tcvitals.  The storm
c     identifier contains the date/time that the storm was first
c     identified, and the lat/lon position at which it was first
c     identified.
c
c     EXAMPLE:  The following is a standard TC Vitals record, split
c               up over 3 lines:
c
c       NHC  01L ALBERTO   20060614 1200 343N 0807W 035 093 1004 1012
c            0278 15 222 -999 -999 -999 -999 M -999 -999 -999 -999 72
c            520N  410W  -999 -999 -999 -999
c
c     EXAMPLE:  The following is the format for the "genesis" vitals,
c               split over 3 lines, for the same system:
c
c       2006061000_F000_210N_0853W_01L 20060614 1200 343N 0807W 035 093
c            1004 1012 0278 15 222 -999 -999 -999 -999 M -999 -999
c            -999 -999 72 520N  410W  -999 -999 -999 -999
c
c     EXAMPLE:  If the vitals record is for a non-officially numbered
c               system (i.e., any system that's not a TC being tracked
c               by NHC or JTWC), then the storm number is replaced
c               by the characters "FOF", for "Found On the Fly" by
c               the  tracker.
c
c       2006071500_F000_150N_0681W_FOF 20060718 1200 185N 0792W 035 093
c            1004 1012 0278 15 222 -999 -999 -999 -999 M -999 -999
c            -999 -999 72 520N  410W  -999 -999 -999 -999
c
c       NOTE: The "F000" in there at character positions 12-15 are to
c             indicate the forecast hour within that forecast cycle
c             that the storm was first detected.  For a vitals record,
c             this is always going to be 000 for fhr=0h, and really,
c             it's not even needed.  However, I'm keeping it in there
c             in order to keep the storm ID format exactly the same
c             as the  output_atcf_sink forecast track record, which
c             does have a use for that "FXXX" identifier in the
c             output.
c
c     INPUT:
c     lgvcard    integer unit number for tcgen-tcvitals card
c
c     OUTPUT:
c     maxstorm  max # of storms to be handled for this case
c     iret      return code from this subroutine
c
c     INPUT/OUTPUT:
c     numtcv    As an input, this variable contains the number of
c               *tropical* cyclone vitals (i.e., regular tcvitals) that
c               were read off of the input tcvitals file in subroutine
c               read_tcv_card.  This variable will be incremented for
c               each "modified" vitals record that is read in this
c               subroutine, and so as output, this variable will
c               contain the combined total of tcvitals and modified
c               vitals records.
c
c     OTHER:
c     stormswitch 1,2 or 3 (see more description under Main pgm section)
c     slonfg     first guess array for longitude
c     slatfg     first guess array for latitude
c     storm      contains the tcvitals info
c     (storm, stormswitch, slonfg and slatfg are allocatable and are
c      defined in module def_vitals)
c
      USE def_vitals; USE set_max_parms; USE trkrparms; USE gen_vitals
      USE verbose_output

      implicit none

      type (gencard) tmpstorm(maxstorm_mg)
      type (trackstuff) trkrinfo
      integer    iret,maxstorm
      integer    i,ii,lgvcard,numtcv,num_mod_vit,vitix,iga
c------
      ! Read in all of the "genesis vitals" into a temp array.  The
      ! index for the first array member is one past the number of
      ! tc vitals that were read in in subroutine  read_tcv_card.
      ii = numtcv + 1
      do while (.true. .and. ii <= maxstorm_mg)
        read (lgvcard,24,END=801,ERR=891) tmpstorm(ii)
        ii = ii + 1
      enddo

   24 format (i10,2x,i3,1x,i3,a1,1x,i4,a1,1x,a3,1x,i8,1x,i4,1x,i3,a1,1x
     &       ,i4,a1,1x,i3,1x,i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)

  801 continue

      num_mod_vit = ii - numtcv - 1

      allocate (gstorm(maxstorm_mg),stat=iga)
      if (iga /= 0) then

        if ( verb .ge. 1 ) then
          print *,' '
          print *,'!!! ERROR in read_gen_vitals allocating gstorm array'
          print *,'!!! iga = ',iga
        endif

        iret = 97
        return
      endif

      ! Initialize all "genesis dates" to 99999.  Any new genesis
      ! vitals that are read in below will bring in real dates, and
      ! then we can test the date in output_gen_vitals to know if a
      ! storm was already defined or not at the beginning of this
      ! executable or if it was a new storm that was found.

      do i = 1,maxstorm_mg
        gstorm(i)%gv_gen_date = 99999
      enddo

      ! If there are any TC vitals (i.e., officially named TCs
      ! that are being numbered/tracked by either NHC or JTWC), then
      ! we want to take the important information from those vitals
      ! and put that into genesis vitals.  This will enable us to
      ! output *all* of these systems in the "gen_vitals" or
      ! "gstorm" format.  The one difference here is that for the
      ! genesis date, we use the starting date of this forecast, not
      ! the time that the storm first formed.  Also, set the genesis
      ! forecast hour (gv_gen_fhr) to be 0 for TCs that have a
      ! TC vitals record.

      if (numtcv > 0) then
        do i = 1,numtcv
          gstorm(i)%gv_gen_date  = storm(i)%tcv_ymd * 100 +
     &                             storm(i)%tcv_hhmm / 100
          gstorm(i)%gv_gen_fhr   = 0
          gstorm(i)%gv_gen_lat   = storm(i)%tcv_lat
          gstorm(i)%gv_gen_latns = storm(i)%tcv_latns
          gstorm(i)%gv_gen_lon   = storm(i)%tcv_lon
          gstorm(i)%gv_gen_lonew = storm(i)%tcv_lonew
          gstorm(i)%gv_gen_type  = storm(i)%tcv_storm_id
          gstorm(i)%gv_obs_ymd   = storm(i)%tcv_ymd
          gstorm(i)%gv_obs_hhmm  = storm(i)%tcv_hhmm
          gstorm(i)%gv_obs_lat   = storm(i)%tcv_lat
          gstorm(i)%gv_obs_latns = storm(i)%tcv_latns
          gstorm(i)%gv_obs_lon   = storm(i)%tcv_lon
          gstorm(i)%gv_obs_lonew = storm(i)%tcv_lonew
          if ( verb .ge. 3 ) then
            write (*,34) gstorm(i)
          endif
        enddo
      endif

      if (num_mod_vit > 0) then

        if ( verb .ge. 3 ) then
          print *,' '
          print *,'Following are the vitals for storms that were'
          print *,'read in from the modified (genesis) tc vitals file: '
          print *,' '
        endif

        do i=1,num_mod_vit
          vitix = i + numtcv
          stormswitch(vitix) = 1
          ! On the following line we are filling the array gstorm,
          ! which is new in this subroutine.  Note, however, that we
          ! are not necessarily starting it at 1, but at the point in
          ! the array after any TC Vitals may have been read in.
          gstorm(vitix) = tmpstorm(vitix)

          if ( verb .ge. 3 ) then
            write (*,34) gstorm(vitix)
          endif

          ! For the sake of consistency (and sanity!!), we need to also
          ! use the same "storm" array as was used in read_tcv_card,
          ! since this "storm" array is used often throughout the rest
          ! of this executable.

          write (storm(vitix)%tcv_storm_id,'(i4.4)') vitix
          write (storm(vitix)%tcv_storm_name,'(i4.4)') vitix
          storm(vitix)%tcv_ymd   = gstorm(vitix)%gv_obs_ymd
          storm(vitix)%tcv_hhmm  = gstorm(vitix)%gv_obs_hhmm
          storm(vitix)%tcv_lat   = gstorm(vitix)%gv_obs_lat
          storm(vitix)%tcv_latns = gstorm(vitix)%gv_obs_latns
          storm(vitix)%tcv_lon   = gstorm(vitix)%gv_obs_lon
          storm(vitix)%tcv_lonew = gstorm(vitix)%gv_obs_lonew
          storm(vitix)%tcv_stdir = gstorm(vitix)%gv_stdir
          storm(vitix)%tcv_stspd = gstorm(vitix)%gv_stspd

          if (trkrinfo%type == 'midlat') then
            storm(vitix)%tcv_center = 'MIDL'
          else if (trkrinfo%type == 'tcgen') then
            storm(vitix)%tcv_center = 'TCG '
          endif

          if (gstorm(vitix)%gv_obs_lonew == 'W') then
            slonfg(vitix,1) =  360. - float(gstorm(vitix)%gv_obs_lon)
     &                         / 10.0
          else
            slonfg(vitix,1) = float(gstorm(vitix)%gv_obs_lon)/10.0
          endif
          if (gstorm(vitix)%gv_obs_latns == 'S') then
            slatfg(vitix,1) = -1. * float(gstorm(vitix)%gv_obs_lat)/10.0
          else
            slatfg(vitix,1) = float(gstorm(vitix)%gv_obs_lat)/10.0
          endif
          stcvtype(vitix) = 'FOF' ! Storm "Found On the Fly" by tracker

        enddo
      endif

   34 format (i10,1x,'F',i3.3,1x,i3.3,a1,1x,i4.4,a1,1x,a3,1x,i8,1x,i4.4
     &       ,1x,i3.3,a1,1x,i4.4,a1,1x,i3,1x,i3,3(1x,i4),1x,i2,1x,i3,1x
     &       ,4(i4,1x),a1)

c     Update the total number of vitals that have been read in

      numtcv = numtcv + num_mod_vit

      goto 895
c
 891  continue

      if ( verb .ge. 1 ) then
        print *,'!!! ERROR in read_gen_vitals reading unit ',lgvcard
      endif

      iret = 98

  895 continue
c
      return
      end