* support code for Ferret EF taken from "program ocn_obs"
* *sh* 12/00

* original documentation follows
* for the Ferret EF application the code has been reduced to two subroutines
*   INTEGER FUNCTION OPEN_OCN_OBS(filename,errmsg)
*   SUBROUTINE READ_OCN_OBS(result, nvars, nobs, errmsg)

*** START OF ORIGINAL DOCUMENTATION ***
c
c.............................START PROLOGUE............................
c
c SCCS IDENTIFICATION:  %W% %G%
c
c MODULE NAME:  ocn_obs
c
c DESCRIPTION:  simple driver for processing FNMOC ocean obs files
c                  altim - TOPEX and ERS altimeter SSHA
c                  mcsst - AVHRR SST retrievals
c                profile - subsurface measures of in situ T and S
c                   ship - in situ surface measures of T
c                   ssmi - DMSP sea ice concentration retrievals
c
c               documentation of the variables for each ocean obs
c               file is contained within the respective "rd" routines:
c                  rd_altim, rd_mcssst, rd_prof, rd_ship, rd_ssmi
c
c               the first record in all of the FNMOC ocean obs files
c               contains the number the observations in that file
c               and the maximum number of observation levels (can be
c               greater than 1 for the {dtg}.profile files).  as in
c               this simple driver routine, these variables can be
c               read and passed as automatic array dimensions to a
c               subroutine.
c
c               the code assumes that the ocean obs data files are
c               in a directory structure given by
c                  $data_dir/altim
c                           /mcsst
c                           /profile
c                           /ship
c                           /ssmi
c               where $data_dir is an environmental variable
c               defined by "OCEAN_OBS_DIR" that describes the
c               directory path to the top of ocean obs tree
c
c               all of the code required is concatentated in
c               the ocn_obs.f file.  a compilation can be
c               done using the following (for SGI)
c                  f90 -r4 -i4 -o ocn_obs obs_obs.f
c
c               the GETARG and GETENV routines may be different
c               on SUN SPARC workstations
c
c               to see what command line arguments are required,
c               execute ocn_obs with no command line arguments
c
c               temperature units are deg C, salinity units are
c               PSU, sea surface height units are meters, and
c               sea ice concentration units are per cent.
c
c               unless otherwise specified, missing values are
c               set to -999 in all of the ocean obs data files
c
c....................MAINTENANCE SECTION................................
c
c MODULES CALLED:
c        Name                    Description
c   --------------     -------------------------------------
c   error_exit         standard error processing
c   GETARG             retrieve command line argument
c   GETENV             retrieve environmental variable
c   rd_altim           read satellite altimeter SSHA observations
c   rd_mcsst           read AVHRR satellite SST retrievals
c   rd_prof            read profile temperatures and salinities
c   rd_ship            read surface temperature observations
c   rd_ssmi            read ssmi sea ice retrievals
c
c..............................END PROLOGUE.............................
c

*** END OF ORIGINAL DOCUMENTATION ***


      SUBROUTINE READ_OCN_OBS(file_dtg, result, nvars, nobs, errmsg)

      INTEGER nvars, nobs
      REAL*4 result(nobs, nvars)
      character file_dtg * 10
      CHARACTER*(*) errmsg

      integer    UNIT
      parameter (UNIT = 60)

      call rd_ship (UNIT, file_dtg, result, nvars, nobs)
      close (UNIT)
      errmsg = ' '
      RETURN
      END
  
*
**********************
*

      INTEGER FUNCTION OPEN_OCN_OBS(file_dtg,err_msg)


      implicit  none
c
c     ..set local data file fortran unit number
c
      integer    UNIT
      parameter (UNIT = 60)
c
      character*(*) err_msg
      character file_dtg * 10

      character arg * 80
      character data_dir * 256
      logical   exist
      character file_name * 256
      integer   len
      integer   n_arg
      integer*4 n_lvl
      integer*4 n_obs
      character obs_typ * 5

        INTEGER TM_LENSTR
c
c...............................executable..............................
c

c
c     ..retrieve file root directory
c
        obs_typ = 'ship'

c
c     ..retrieve file root directory
c
      call GETENV ('OCN_OBS_DIR', data_dir)
      len = TM_LENSTR (data_dir)
      if (len .eq. 0) then
         data_dir = '.'
         len = TM_LENSTR (data_dir)
      endif
c
c-----------------------------------------------------------------------
c
c     ..profile observations
c
#if 0
      if (obs_typ(1:4) .eq. 'prof') then
         open (45, file='report.profile', status='unknown',
     *             form='formatted')
         write (45, '(''   ****** Reading PROFILE Data ******'')')
         write (45, '(''   file date time group: '', a)') file_dtg
         write (45, '(''    data directory path: '', a)')
     *          data_dir(1:len)
         file_name = data_dir(1:len) // '/profile/' //
     *               file_dtg // '.profile'
         len = TM_LENSTR (file_name)
         inquire (file=file_name(1:len), exist=exist)
         if (exist) then
            open (UNIT, file=file_name(1:len), status='old',
     *                  form='unformatted')
            read (UNIT) n_obs, n_lvl
            write (45, '(''        number profiles: '', i10)') n_obs
            write (45, '(''      max number levels: '', i10)') n_lvl
            if (n_obs .gt. 0) then
               call rd_prof (UNIT, n_obs, n_lvl)
            endif
            close (UNIT)
         else
            write (err_msg, '(''file "'', a, ''" does not exist'')')
     *             file_name(1:len)
            call error_exit ('OCN_OBS', err_msg)
         endif
# endif
c
c-----------------------------------------------------------------------
c
c     ..surface ship/buoy observations
c
!      else if (obs_typ(1:4) .eq. 'ship') then
      if (obs_typ(1:4) .eq. 'ship') then
         open (45, file='report.ship', status='unknown',
     *             form='formatted')
         write (45, '(''   ****** Reading SHIP Data ******'')')
         write (45, '(''   file date time group: '', a)') file_dtg
         write (45, '(''    data directory path: '', a)')
     *          data_dir(1:len)
         file_name = data_dir(1:len) // '/ship/' //
     *               file_dtg // '.ship'
         len = TM_LENSTR (file_name)
         inquire (file=file_name(1:len), exist=exist)
         if (exist) then
            open (UNIT, file=file_name(1:len), status='old',
     *                  form='unformatted')
            read (UNIT) n_obs
            write (45, '(''        number ship obs: '', i10)') n_obs

c
c   successfully opened the file
c
            err_msg = ' '
            OPEN_OCN_OBS = n_obs
            RETURN
         else
            err_msg = 'file "'//file_name(:len)//'" does not exist'
            OPEN_OCN_OBS = 0
         endif
c
c-----------------------------------------------------------------------
c
c     ..mcsst observations
c
#if 0
      else if (obs_typ(1:5) .eq. 'mcsst') then
         open (45, file='report.mcsst', status='unknown',
     *             form='formatted')
         write (45, '(''   ****** Reading MCSST Data ******'')')
         write (45, '(''   file date time group: '', a)') file_dtg
         write (45, '(''    data directory path: '', a)')
     *          data_dir(1:len)
         file_name = data_dir(1:len) // '/mcsst/' //
     *               file_dtg // '.mcsst'
         len = TM_LENSTR (file_name)
         inquire (file=file_name(1:len), exist=exist)
         if (exist) then
            open (UNIT, file=file_name(1:len), status='old',
     *                  form='unformatted')
            read (UNIT) n_obs
            write (45, '(''       number mcsst obs: '', i10)') n_obs
            if (n_obs .gt. 0) then
               call rd_mcsst (UNIT, n_obs)
            endif
            close (UNIT)
         else
            write (err_msg, '(''file "'', a, ''" does not exist'')')
     *             file_name(1:len)
            call error_exit ('OCN_OBS', err_msg)
         endif
# endif
c
c-----------------------------------------------------------------------
c
c     ..altimeter observations
c
#if 0
      else if (obs_typ(1:5) .eq. 'altim') then
         open (45, file='report.altim', status='unknown',
     *             form='formatted')
         write (45, '(''   ****** Reading ALTIM Data ******'')')
         write (45, '(''   file date time group: '', a)') file_dtg
         write (45, '(''    data directory path: '', a)')
     *          data_dir(1:len)
         file_name = data_dir(1:len) // '/altim/' //
     *               file_dtg // '.altim'
         len = TM_LENSTR (file_name)
         inquire (file=file_name(1:len), exist=exist)
         if (exist) then
            open (UNIT, file=file_name(1:len), status='old',
     *                  form='unformatted')
            read (UNIT) n_obs
            write (45, '(''       number altim obs: '', i10)') n_obs
            if (n_obs .gt. 0) then
               call rd_altim (UNIT, n_obs)
            endif
            close (UNIT)
         else
            write (err_msg, '(''file "'', a, ''" does not exist'')')
     *             file_name(1:len)
            call error_exit ('OCN_OBS', err_msg)
         endif
# endif
c
c-----------------------------------------------------------------------
c
c     ..SSM/I sea ice observations
c
#if 0
      else if (obs_typ(1:4) .eq. 'ssmi') then
         open (45, file='report.ssmi', status='unknown',
     *             form='formatted')
         write (45, '(''   ****** Reading SSMI Data ******'')')
         write (45, '(''   file date time group: '', a)') file_dtg
         write (45, '(''    data directory path: '', a)')
     *          data_dir(1:len)
         file_name = data_dir(1:len) // '/ssmi/' //
     *               file_dtg // '.ssmi'
         len = TM_LENSTR (file_name)
         inquire (file=file_name(1:len), exist=exist)
         if (exist) then
            open (UNIT, file=file_name(1:len), status='old',
     *                  form='unformatted')
            read (UNIT) n_obs
            write (45, '(''        number ssmi obs: '', i10)') n_obs
            if (n_obs .gt. 0) then
               call rd_ssmi (UNIT, n_obs)
            endif
            close (UNIT)
         else
            write (err_msg, '(''file "'', a, ''" does not exist'')')
     *             file_name(1:len)
            call error_exit ('OCN_OBS', err_msg)
         endif
# endif
c
c-----------------------------------------------------------------------
c
c     ..unknown obs data type 
c
      else
        err_msg = 'unknown obs TYPE'
        OPEN_OCN_OBS = 0
      endif
c
      stop
      end


      subroutine rd_altim (UNIT, n_obs)
c
c.............................START PROLOGUE............................
c
c SCCS IDENTIFICATION:  %W% %G%
c
c MODULE NAME:  rd_altim
c
c DESCRIPTION:  reads the ALTIM ocean obs files and produces a report
c
c PARAMETERS:
c      Name          Type        Usage            Description
c   ----------     ---------     ------    ---------------------------
c   n_obs           integer      input     number altim obs
c   unit            integer      input     FORTRAN unit number
c
c ALTIMETER VARIABLES:
c     ame       Type                     Description
c   --------  --------    ----------------------------------------------
c   ob_age     real       age of the observation in hours since
c                         January 1, 1992.  provides a continuous
c                         time variable
c   ob_clim    real       SSHA climatological estimate at obs
c                         location and sampling time
c   ob_cycle   integer    satellite cycle number
c   ob_dtg     character  SSHA obs date time group in the form
c                         year, month, day, hour, minute,
c                         second (YYYYMMDDHHMMSS)
c   ob_glbl    real       SSHA global analysis estimate at obs
c                         location and receipt time at FNMOC
c   ob_lat     real       SSHA obs latitude (south negative)
c   ob_lon     real       SSHA obs longitude (west negative)
c   ob_qc      real       SSHA obs probability of a gross error
c                         (assumes normal pdf of SSHA errors)
c   ob_regn    real       SSHA regional analysis estimate at obs
c                         location and receipt time at FNMOC
c   ob_sat     integer    satellite ID (TOPEX, ERS, GFO) - see
c                         ocn_types.h for codes
c   ob_sgma    real       climatological variability of SSHA at
c                         obs location and time of year
c   ob_smpl    integer    sequential sample number along a
c                         satellite track
c   ob_ssh     real       SSHA observation (meters) in terms of
c                         deviation from a long term TOPEX mean
c   ob_track   integer    satellite track number for cycle
c
c..............................END PROLOGUE.............................
c
      implicit none
c
      include 'ocn_types.h'
c
c     ..local array dimensions
c
      integer*4 n_obs
c
      integer   i, k
      real*4    ob_age (n_obs)
      real*4    ob_clim (n_obs)
      integer*4 ob_cycle (n_obs)
      character ob_dtg (n_obs) * 14
      real*4    ob_glbl (n_obs)
      real*4    ob_lat (n_obs)
      real*4    ob_lon (n_obs)
      real*4    ob_qc (n_obs)
      real*4    ob_regn (n_obs)
      integer*4 ob_smpl (n_obs)
      integer*4 ob_sat (n_obs)
      real*4    ob_sgma (n_obs)
      real*4    ob_ssh (n_obs)
      integer*4 ob_track (n_obs)
      integer   UNIT
c
c...............................executable..............................
c
c     ..read altimeter variables
c
      read (UNIT) (ob_age(i), i = 1, n_obs)
      read (UNIT) (ob_clim(i), i = 1, n_obs)
      read (UNIT) (ob_cycle(i), i = 1, n_obs)
      read (UNIT) (ob_glbl(i), i = 1, n_obs)
      read (UNIT) (ob_lat(i), i = 1, n_obs)
      read (UNIT) (ob_lon(i), i = 1, n_obs)
      read (UNIT) (ob_qc(i), i = 1, n_obs)
      read (UNIT) (ob_regn(i), i = 1, n_obs)
      read (UNIT) (ob_smpl(i), i = 1, n_obs)
      read (UNIT) (ob_sat(i), i = 1, n_obs)
      read (UNIT) (ob_sgma(i), i = 1, n_obs)
      read (UNIT) (ob_ssh(i), i = 1, n_obs)
      read (UNIT) (ob_track(i), i = 1, n_obs)
      read (UNIT) (ob_dtg(i), i = 1, n_obs)
c
c     ..produce altimeter report
c
      k = 100
      write (45, '(''  reporting skip factor: '', i10)') k
      write (45, '(11x,''dtg'', 5x,''lat'', 5x,''lon'', 5x,''sat'',
     *             5x,''ssh'', 4x,''clim'', 4x,''glbl'', 4x,''regn'',
     *             6x,''qc'',  3x,''cycle'', 4x,''trak'', 4x,''smpl'',
     *             4x,''sgma'')')
      do i = 1, n_obs, k
         write (45, '(a,2f8.2,i8,f8.4,3f8.3,f8.4,3i8,f8.4,2x,a)')
     *          ob_dtg(i), ob_lat(i), ob_lon(i), ob_sat(i),
     *          ob_ssh(i), ob_clim(i), ob_glbl(i), ob_regn(i),
     *          ob_qc(i), ob_cycle(i), ob_track(i), ob_smpl(i),
     *          ob_sgma(i), data_lbl(ob_sat(i))
      enddo
c
      return
      end


      subroutine rd_mcsst (UNIT, n_obs)
c
c.............................START PROLOGUE............................
c
c SCCS IDENTIFICATION:  %W% %G%
c
c MODULE NAME:  rd_mcsst
c
c DESCRIPTION:  reads the MCSST ocean obs files and produces a report
c
c PARAMETERS:
c      Name          Type        Usage            Description
c   ----------     ---------     ------    ---------------------------
c   n_obs           integer      input     number mcsst obs
c   unit            integer      input     FORTRAN unit number
c
c MCSST VARIABLES:
c      Name      Type                      Description
c   ----------  -------     --------------------------------------------
c   ob_age      real        age of the observation in hours since
c                           January 1, 1992.  provides a continuous
c                           time variable
c   ob_aod      real        NESDIS aeorosol optical depth at SST 
c                           obs and sampling time (to within +/- 
c                           24 hrs).  missing AODs are set to -1.
c   ob_clim     real        NCEP SST climatological estimate at obs
c                           location and sampling time
c   ob_csgm     real        NCEP SST climatology variability estimate 
c                           at obs location and receipt time at FNMOC
c                           (not implemented yet)
c   ob_dtg      character   SST obs date time group in the form year,
c                           month, day, hour, minute (YYYYMMDDHHMM)
c   ob_glbl     real        SST global analysis estimate at obs
c                           location and receipt time at FNMOC
c   ob_gsgm     real        global SST analysis variability estimate at
c                           obs location and receipt time at FNMOC
c                           (not implemented yet)
c   ob_lat      real        SST obs latitude (south negative)
c   ob_lon      real        SST obs longitude (west negative)
c   ob_qc       real        SST obs probability of a gross error
c                           (assumes normal pdf of SST errors)
c   ob_regn                 SST regional analysis estimate at obs
c                           location and receipt time at FNMOC
c   ob_rsgm     real        regional SST analysis variability estimate
c                           at obs location and receipt time at
c                           FNMOC (not implemented yet)
c   ob_sst      real        SST observation
c   ob_type     integer     SST obseration data type; NOAA14 or NOAA15
c                           day, night, relaxed day retrievals (see 
c                           ocn_types.h for codes)
c   ob_wm       integer     SST water mass indicator from Bayesian
c                           classification scheme.  only valid in
c                           western North Pacific, western North
c                           Atlantic or GIN-Seas regions.  used to
c                           prevent averaging of SST observations
c                           from different water mass during the
c                           computation of SST super-obs; helps
c                           maintain SST fronts and eddies in the
c                           analysis of western boundary currents
c
c..............................END PROLOGUE.............................
c
      implicit none
c
      include 'ocn_types.h'
c
c     ..local array dimensions
c
      integer*4 n_obs
c
      integer   i, k
      real*4    ob_age (n_obs)
      real*4    ob_aod (n_obs)
      real*4    ob_clim (n_obs)
      real*4    ob_csgm (n_obs)
      character ob_dtg (n_obs) * 12
      real*4    ob_glbl (n_obs)
      real*4    ob_gsgm (n_obs)
      real*4    ob_lat (n_obs)
      real*4    ob_lon (n_obs)
      real*4    ob_qc (n_obs)
      real*4    ob_regn (n_obs)
      real*4    ob_rsgm (n_obs)
      real*4    ob_sst (n_obs)
      integer*4 ob_type (n_obs)
      integer*4 ob_wm (n_obs)
      integer   UNIT
c
c...............................executable..............................
c
c     ..read mcsst variables
c
      read (UNIT) (ob_wm(i), i = 1, n_obs)
      read (UNIT) (ob_glbl(i), i = 1, n_obs)
      read (UNIT) (ob_lat(i), i = 1, n_obs)
      read (UNIT) (ob_lon(i), i = 1, n_obs)
      read (UNIT) (ob_age(i), i = 1, n_obs)
      read (UNIT) (ob_clim(i), i = 1, n_obs)
      read (UNIT) (ob_qc(i), i = 1, n_obs)
      read (UNIT) (ob_type(i), i = 1, n_obs)
      read (UNIT) (ob_regn(i), i = 1, n_obs)
      read (UNIT) (ob_sst(i), i = 1, n_obs)
      read (UNIT) (ob_aod(i), i = 1, n_obs)
      read (UNIT) (ob_dtg(i), i = 1, n_obs)
c     read (UNIT) (ob_csgm(i), i = 1, n_obs)
c     read (UNIT) (ob_gsgm(i), i = 1, n_obs)
c     read (UNIT) (ob_rsgm(i), i = 1, n_obs)
      do i = 1, n_obs
         ob_csgm(i) = -999.
         ob_gsgm(i) = -999.
         ob_rsgm(i) = -999.
      enddo
c
c     ..produce mcsst report
c
      k = 100
      write (45, '(''  reporting skip factor: '', i10)') k
      write (45, '(9x,''dtg'', 5x,''lat'', 5x,''lon'', 4x,''type'',
     *             5x,''sst'', 4x,''clim'', 4x,''glbl'', 4x,''regn'',
     *             6x,''qc'',  5x,''aod'', 4x,''csgm'', 4x,''gsgm'',
     *             4x,''rsgm'', 2x,''wm'')')
      do i = 1, n_obs, k
         write (45, '(a,2f8.2,i8,4f8.2,2f8.4,3f8.2,i4,2x,a)')
     *          ob_dtg(i), ob_lat(i), ob_lon(i), ob_type(i),
     *          ob_sst(i), ob_clim(i), ob_glbl(i), ob_regn(i),
     *          ob_qc(i), ob_aod(i), ob_csgm(i), ob_gsgm(i),
     *          ob_rsgm(i), ob_wm(i), data_lbl(ob_type(i))
      enddo
c
      return
      end


      subroutine rd_prof (UNIT, n_obs, n_lvl)
c
c.............................START PROLOGUE............................
c
c SCCS IDENTIFICATION:  %W% %G%
c
c MODULE NAME:  rd_prof
c
c DESCRIPTION:  reads the PROFILE ocean obs files and produces a report
c
c PARAMETERS:
c      Name          Type        Usage            Description
c   ----------     ---------     ------    ---------------------------
c   n_obs           integer      input     number profile obs 
c   n_lvl           integer      input     number profile levels
c   unit            integer      input     FORTRAN unit number
c
c PROFILE VARIABLES:
c     ame       Type                     Description
c   --------  --------    ----------------------------------------------
c   ob_btm     real       bottom depth in meters from DBDB5 data base
c                         at profile lat,lon
c   ob_clim    real       MODAS temperature climatology estimate at
c                         profile location, levels and sampling time
c   ob_dtg     character  profile observation sampling date time group
c                         in the form  year, month, day, hour, minute,
c                         second (YYYYMMDDHHMMSS)
c   ob_glbl    real       global analysis estimate of profile
c                         temperatures at profile obs location,
c                         levels, and sampling time
c   ob_lat     real       profile observation latitude (south negative)
c   ob_lon     real       profile observation longitude (west negative)
c   ob_ls      integer    number of observed profile salinity levels
c                         (a zero indicates temperature-only profile)
c   ob_lt      integer    number of observed profile temperature levels
c   ob_lvl     real       observed (and extended) profile levels
c   ob_modas   real       modas synthetic profile estimate at profile
c                         location, levels, and sampling time.  the
c                         predictor variables used in the generation
c                         of the modas synthetic profile are the
c                         ob_sst (SST) and ob_ssh (SSHA) variables.
c   ob_nd      integer    total number of levels for profile observation
c                         includes observed levels (ob_lt) plus levels
c                         to vertically extend the profile to the bottom
c   ob_rcpt    character  profile observation receipt time at FNMOC in
c                         the form year, month, day, hour, minute
c                         (YYYYMMDDHHMM); the difference between
c                         ob_rcpt and ob_dtg gives the timeliness 
c                         of the observation at FNMOC
c   ob_regn    real       regional analysis estimate of profile
c                         temperatures at profile obs location,
c                         levels, and sampling time
c   ob_sal     real       observed (and extended) profile salinities,
c                         if salinity has not been observed it has been
c                         estimated from climatological T/S regressions
c   ob_scr     character  profile obs security classification code; "U"
c                         for unclassified
c   ob_sign    character  profile observation call sign
c   ob_sprb    real       salinity profile level-by-level probability
c                         of a gross error
c   ob_sqc     real       salinity profile overall probability of gross
c                         error (integrates level-by-level errors taking
c                         into account layer thcknesses)
c   ob_ssh     real       SSHA of profile dynamic height from long-term
c                         hydrographic mean.  dynamic height has been
c                         calculated relative to 2000 m or the bottom
c                         whichever is shallower.  profile SSHA is
c                         directly comparable to satellite altimeter
c                         SSHA.  vertically extended levels may have
c                         been used in the dynamic height computation,
c                         so the profile SSHA values must be used with
c                         care for shallow observed profiles (ob_lt)
c   ob_sst     real       SST estimate (in order of high resoloution
c                         regional analysis if available, global
c                         analysis if available, profile SST if
c                         observed shallow enough or SST climatology
c                         (MODAS or GDEM)) valid at profile observation
c                         location and sampling time
c   ob_sstd    real       climatolgical estimates of variability of
c                         salinity at profile location, levels and
c                         sampling time (one standard deviation)
c   ob_tmp     real       observed (and extended) profile temperatures
c   ob_tqc     real       temperature profile overall probability of
c                         gross error (integrates level-by-level errors
c                         taking into account layer thcknesses)
c   ob_tprb    real       temperature profile level-by-level probability
c                         of a gross error
c   ob_tstd    real       climatolgical estimates of variability of
c                         temperature at profile location, levels and
c                         sampling time (one standard deviation)
c   ob_typ     integer    profile data type (see ocean_types.h for
c                         codes)
c 
c..............................END PROLOGUE.............................
c
      implicit none         
c
      include 'ocn_types.h'
c
c     ..local array dimensions
c
      integer*4 n_obs
      integer*4 n_lvl
c
      integer   i, j
      real*4    ob_btm (n_obs)
      real*4    ob_clim (n_lvl, n_obs)
      character ob_dtg (n_obs) * 12
      real*4    ob_glbl (n_lvl, n_obs)
      real*4    ob_lat (n_obs)
      real*4    ob_lon (n_obs)
      real*4    ob_lvl (n_lvl, n_obs)
      integer*4 ob_ls (n_obs)
      integer*4 ob_lt (n_obs)
      real*4    ob_modas (n_lvl, n_obs)
      integer*4 ob_nd (n_obs)
      real*4    ob_sprb (n_lvl, n_obs)
      real*4    ob_sqc (n_obs)
      real*4    ob_tprb (n_lvl, n_obs)
      real*4    ob_tqc (n_obs)
      character ob_rcpt (n_obs) * 12
      real*4    ob_regn (n_lvl, n_obs)
      character ob_scr (n_obs) * 1
      character ob_sign (n_obs) * 7
      real*4    ob_sal (n_lvl, n_obs)
      real*4    ob_ssh (n_obs)
      real*4    ob_sst (n_obs)
      real*4    ob_sstd (n_lvl, n_obs)
      real*4    ob_tmp (n_lvl, n_obs)
      real*4    ob_tstd (n_lvl, n_obs)
      integer*4 ob_typ (n_obs)
      integer   UNIT
c
c...............................executable..............................
c
c     ..read profile variables
c
      read (UNIT) (ob_lt(i),  i = 1, n_obs)
      read (UNIT) (ob_ssh(i), i = 1, n_obs)
      read (UNIT) (ob_btm(i), i = 1, n_obs)
      read (UNIT) (ob_lat(i), i = 1, n_obs)
      read (UNIT) (ob_lon(i), i = 1, n_obs)
      read (UNIT) (ob_nd(i),  i = 1, n_obs)
      read (UNIT) (ob_sqc(i), i = 1, n_obs)
      read (UNIT) (ob_tqc(i), i = 1, n_obs)
      read (UNIT) (ob_typ(i), i = 1, n_obs)
      do i = 1, n_obs
         read (UNIT) (ob_lvl(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_modas(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_clim(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_glbl(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_regn(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_sprb(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_tprb(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_sal(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_tmp(j,i), j = 1, ob_nd(i))
      enddo
      read (UNIT) (ob_dtg(i), i = 1, n_obs)
      read (UNIT) (ob_rcpt(i), i = 1, n_obs)
      read (UNIT) (ob_scr(i), i = 1, n_obs)
      read (UNIT) (ob_sign(i), i = 1, n_obs)
      read (UNIT) (ob_ls(i), i = 1, n_obs)
      read (UNIT) (ob_sst(i), i = 1, n_obs)
      do i = 1, n_obs
         read (UNIT) (ob_sstd(j,i), j = 1, ob_nd(i))
         read (UNIT) (ob_tstd(j,i), j = 1, ob_nd(i))
      enddo
c
c     ..produce profile report
c
      do i = 1, n_obs
         write (45, '(110(''-''))')
         write (45, '(''profile call sign           : "'', a, ''"'')')
     *          ob_sign(i)
         write (45, '(''profile latitude            : '', f12.2)')
     *          ob_lat(i)
         write (45, '(''profile longitude           : '', f12.2)')
     *          ob_lon(i)
         write (45, '(''profile observed DTG        : "'', a, ''"'')')
     *          ob_dtg(i)
         write (45, '(''profile received DTG        : "'', a, ''"'')')
     *          ob_rcpt(i)
         write (45, '(''DBDB5 bottom depth          : '', f12.1)')
     *          ob_btm(i)
         write (45, '(''profile data type code      : '', i12)')
     *          ob_typ(i)
         write (45, '(''profile data type           : "'', a, ''"'')')
     *          data_lbl(ob_typ(i))
         write (45, '(''total number levels         : '', i12)')
     *          ob_nd(i)
         write (45, '(''observed temperature levels : '', i12)')
     *          ob_lt(i)
         write (45, '(''observed salinity levels    : '', i12)')
     *          ob_ls(i)
         write (45, '(''temperature gross error     : '', f12.4)')
     *          ob_tqc(i)
         write (45, '(''salinity gross error        : '', f12.4)')
     *          ob_sqc(i)
         write (45, '(''sea surface height anomaly  : '', f12.4)')
     *          ob_ssh(i)
         write (45, '(''sea surface temperature     : '', f12.2)')
     *          ob_sst(i)
         write (45, '(''security classification     : '', 9x,
     *          ''"'', a, ''"'')') ob_scr(i)
         write (45, '(5x,''depth'', 6x,''temp'', 6x,''salt'',
     *               3x,''tmp_std'', 3x,''sal_std'',
     *               2x,''tmp_prob'', 2x,''sal_prob'',
     *               6x,''clim'', 5x,''modas'',
     *               6x,''glbl'', 6x,''regn'')')
         do j = 1, ob_nd(i)
            write (45, '(f10.1, 4f10.2, 2f10.4, 4f10.2)')
     *             ob_lvl(j,i), ob_tmp(j,i), ob_sal(j,i),
     *             ob_tstd(j,i), ob_sstd(j,i), ob_tprb(j,i),
     *             ob_sprb(j,i), ob_clim(j,i), ob_modas(j,i),
     *             ob_glbl(j,i), ob_regn(j,i)
            if (ob_nd(i) .gt. ob_lt(i)) then
               if (j .eq. ob_lt(i)) then
                  write (45, '(10x, 100(''-''))') 
               endif
            endif
         enddo
      enddo
c
      return
      end


      subroutine rd_ship (UNIT, file_dtg, result, nvars, n_obs)
c
c.............................START PROLOGUE............................
c
c SCCS IDENTIFICATION:  %W% %G%
c
c MODULE NAME:  rd_ship
c
c DESCRIPTION:  reads the SHIP ocean obs files and produces a report
c
c PARAMETERS:
c      Name          Type        Usage            Description
c   ----------     ---------     ------    ---------------------------
c   n_obs           integer      input     number ship obs
c   unit            integer      input     FORTRAN unit number
c
c MCSST VARIABLES:
c      Name      Type                     Description
c   ----------  -------     -------------------------------------------
c   ob_age      real        age of the observation in hours since
c                           January 1, 1992.  provides a continuous
c                           time variable
c   ob_clim     real        NCEP SST climatological estimate at obs
c                           location and sampling time
c   ob_csgm     real        NCEP SST climatology variability estimate
c                           at obs location and receipt time at FNMOC
c                           (not implemented yet)
c   ob_dtg      character   SST obs date time group in the form year,
c                           month, day, hour, minute (YYYYMMDDHHMM)
c   ob_glbl     real        SST global analysis estimate at obs
c                           location and receipt time at FNMOC
c   ob_gsgm     real        global SST analysis variability estimate
c                           at obs location and receipt time at FNMOC
c                           (not implemented yet)
c   ob_lat      real        SST obs latitude (south negative)
c   ob_lon      real        SST obs longitude (west negative)
c   ob_qc       real        SST obs probability of a gross error
c                           (assumes normal pdf of SST errors)
c   ob_rcpt     character   SST observation receipt time at FNMOC in
c                           the form year, month, day, hour, minute
c                           (YYYYMMDDHHMM); the difference between
c                           ob_rcpt and ob_dtg gives the timeliness 
c                           of the observation and the validity of
c                           ob_glbl and ob_regn background estimates 
c   ob_regn                 SST regional analysis estimate at obs
c                           location and receipt time at FNMOC
c   ob_rsgm     real        regional SST analysis variability estimate
c                           at obs location and receipt time at FNMOC
c                           (not implemented yet)
c   ob_scr      character   SST obs security classification code; "U"
c                           for unclassified
c   ob_sign     character   SST observation call sign
c   ob_sst      real        SST observation
c   ob_type     integer     SST obseration data type; ship (ERI, bucket,
c                           hull contact), buoy (fixed, drifting), CMAN
c                           (see ocn_types.h for codes)
c   ob_wm       integer     SST water mass indicator from Bayesian
c                           classification scheme.  only valid in
c                           western North Pacific, western North
c                           Atlantic or GIN-Seas regions.  used to
c                           prevent averaging of SST observations
c                           from different water mass during the
c                           computation of SST super-obs; helps
c                           maintain SST fronts and eddies in the
c                           analysis of western boundary currents
c
c..............................END PROLOGUE.............................
c
      implicit none
c
      include 'ocn_types.h'
c
c     ..local array dimensions
c
      integer*4 n_obs
      integer*4 nvars
      character file_dtg * 10
      REAL*4 result(n_obs, nvars)
c
      integer   i
      real*4    ob_age (n_obs)
      real*4    ob_clim (n_obs)
      real*4    ob_csgm (n_obs)
      character ob_dtg (n_obs) * 12
      real*4    ob_glbl (n_obs)
      real*4    ob_gsgm (n_obs)
      real*4    ob_lat (n_obs)
      real*4    ob_lon (n_obs)
      real*4    ob_qc (n_obs)
      character ob_rcpt (n_obs) * 12
      real*4    ob_regn (n_obs)
      real*4    ob_rsgm (n_obs)
      character ob_scr (n_obs) * 1
      character ob_sign (n_obs) * 6
      real*4    ob_sst (n_obs)
      integer*4 ob_type (n_obs)
      integer*4 ob_wm (n_obs)
      integer   UNIT

      integer iyr ,imo ,idy ,ihr ,imn,
     .        iyr0,imo0,idy0,ihr0,imn0
      REAL*8          TM_SECS_FROM_BC

      integer
     .  POB_WM,
     .  POB_GLBL,
     .  POB_LAT,
     .  POB_LON,
     .  POB_AGE,
     .  POB_CLIM,
     .  POB_QC,
     .  POB_REGN,
     .  POB_SST,
     .  POB_TYPE,
     .  POB_DTG,
     .  POB_RCPT,
     .  POB_SCR,
     .  POB_SIGN

      PARAMETER (
     .  POB_WM = 2,
     .  POB_GLBL = 3,
     .  POB_LAT = 4,
     .  POB_LON = 5,
     .  POB_AGE = 6,
     .  POB_CLIM = 7,
     .  POB_QC = 8,
     .  POB_REGN = 9,
     .  POB_SST = 10,
     .  POB_TYPE = 11,
     .  POB_DTG = 12,
     .  POB_RCPT = 13,
     .  POB_SCR = 14,
     .  POB_SIGN = 15 )

c
c...............................executable..............................
c
c     ..read ship variables
c
      read (UNIT) (ob_wm(i), i = 1, n_obs)
      read (UNIT) (ob_glbl(i), i = 1, n_obs)
      read (UNIT) (ob_lat(i), i = 1, n_obs)
      read (UNIT) (ob_lon(i), i = 1, n_obs)
      read (UNIT) (ob_age(i), i = 1, n_obs)
      read (UNIT) (ob_clim(i), i = 1, n_obs)
      read (UNIT) (ob_qc(i), i = 1, n_obs)
      read (UNIT) (ob_regn(i), i = 1, n_obs)
      read (UNIT) (ob_sst(i), i = 1, n_obs)
      read (UNIT) (ob_type(i), i = 1, n_obs)
      read (UNIT) (ob_dtg(i), i = 1, n_obs)
      read (UNIT) (ob_rcpt(i), i = 1, n_obs)
      read (UNIT) (ob_scr(i), i = 1, n_obs)
      read (UNIT) (ob_sign(i), i = 1, n_obs)
c     read (UNIT) (ob_csgm(i), i = 1, n_obs)
c     read (UNIT) (ob_gsgm(i), i = 1, n_obs)
c     read (UNIT) (ob_rsgm(i), i = 1, n_obs)
      do i = 1, n_obs
         ob_csgm(i) = -999.
         ob_gsgm(i) = -999.
         ob_rsgm(i) = -999.
      enddo

* RETURN THE RESULTS TO FERRET
      do  i = 1, n_obs
        result(i,1) = -999.
        result(i,POB_WM)   = ob_wm(i)
        result(i,POB_GLBL) = ob_glbl(i)
        result(i,POB_LAT)  = ob_lat(i)
        result(i,POB_LON)  = ob_lon(i)
        result(i,POB_AGE)  = ob_age(i)
        result(i,POB_CLIM) = ob_clim(i)
        result(i,POB_QC)   = ob_qc(i)
        result(i,POB_REGN) = ob_regn(i)
        result(i,POB_SST)  = ob_sst(i)
        result(i,POB_TYPE) = ob_type(i)
* compute lag from observation to receipt of observation
        READ ( ob_rcpt(i),'(I4,4I2)') iyr ,imo ,idy ,ihr ,imn
        READ ( ob_dtg (i),'(I4,4I2)') iyr0,imo0,idy0,ihr0,imn0
        result(i,POB_DTG)  =
     .          (TM_SECS_FROM_BC(iyr,imo,idy,ihr,imn,0)
     .        -  TM_SECS_FROM_BC(iyr0,imo0,idy0,ihr0,imn0,0)) / 3600.

        result(i,POB_RCPT) = -999.   ! not needed
        result(i,POB_SCR)  = -999.   ! ob_scr(i)
        result(i,POB_SIGN) = -999.   ! ob_sign(i) -- useful?
      enddo

* return the number of obs in result(1,1)
      result(1,1) = n_obs

* return the numerical-encoded filename in result(2,1)
      READ (file_dtg,'(I4,4I2)') iyr,imo,idy,ihr,imn
      result(2,1) = (TM_SECS_FROM_BC(iyr,imo,idy,ihr,imn,0)
     .            -  TM_SECS_FROM_BC(1992,1,1,0,0,0)) / 3600.

c
c     ..produce ship report
c
#ifdef DEBUG
      write (45, '(9x,''dtg'', 3x,''sign '', 5x,''lat'', 5x,''lon'',
     *             4x,''type'', 5x,''sst'', 4x,''clim'', 4x,''glbl'',
     *             4x,''regn'', 6x,''qc'', 4x,''csgm'', 4x,''gsgm'',
     *             4x,''rsgm'', 2x,''wm'', 2x,''sc'')')
      do i = 1, n_obs
         write (45, '(a,2x,a,2f8.2,i8,4f8.2,f8.4,3f8.2,i4,3x,a,2x,a)')
     *          ob_dtg(i), ob_sign(i), ob_lat(i), ob_lon(i),
     *          ob_type(i), ob_sst(i), ob_clim(i), ob_glbl(i),
     *          ob_regn(i), ob_qc(i), ob_csgm(i), ob_gsgm(i),
     *          ob_rsgm(i), ob_wm(i), ob_scr(i), data_lbl(ob_type(i))
      enddo
#endif
c
      return
      end


      subroutine rd_ssmi (UNIT, n_obs)
c
c.............................START PROLOGUE............................
c
c SCCS IDENTIFICATION:  %W% %G%
c
c MODULE NAME:  rd_ssmi
c
c DESCRIPTION:  reads the SSMI sea ice ocean obs files and produces a
c               report whether you want one or not
c
c PARAMETERS:
c      Name          Type        Usage            Description
c   ----------     ---------     ------    ---------------------------
c   n_obs           integer      input     number ssmi obs
c   unit            integer      input     FORTRAN unit number
c
c SSMI VARIABLES:
c     ame       Type                     Description
c   --------  --------    ----------------------------------------------
c   ob_age     real       age of the observation in hours since
c                         January 1, 1992.  provides a continuous
c                         time variable
c   ob_clim    real       ECMWF sea ice climatological estimate at
c                         SSM/I sea ice location and sampling time
c   ob_dtg     character  SSM/I sea ice retrieval date time group in
c                         the form  year, month, day, hour, minute,
c                         second (YYYYMMDDHHMMSS)
c   ob_glbl    real       SSM/I sea ice global analysis estimate at
c                         obs location and receipt time at FNMOC
c   ob_ice     real       SSM/I sea ice concentration (per cent) 
c   ob_lat     real       SSM/I sea ice latitude (south negative)
c   ob_lon     real       SSM/I sea ice longitude (west negative)
c   ob_mean    real       SSM/I 30 day mean sea ice concentration at
c                         obs location and samping time
c   ob_qc      real       SSM/I sea ice probability of a gross error
c                         (assumes normal pdf of sea ice retrieval
c                         errors)
c   ob_regn    real       SSM/I sea ice regional analysis estimate at
c                         obs location and receipt time at FNMOC
c   ob_sat     integer    satellite ID (DMSP F11, F13, F14, F15);
c                         see ocn_types.h for codes
c
c..............................END PROLOGUE.............................
c
      implicit none
c
      include 'ocn_types.h'
c
c     ..local array dimensions
c
      integer*4 n_obs
c
      integer   i, k
      real*4    ob_age (n_obs)
      real*4    ob_clim (n_obs)
      character ob_dtg (n_obs) * 12
      real*4    ob_glbl (n_obs)
      real*4    ob_ice (n_obs)
      real*4    ob_lat (n_obs)
      real*4    ob_lon (n_obs)
      real*4    ob_qc (n_obs)
      real*4    ob_regn (n_obs)
      integer*4 ob_sat (n_obs)
      real*4    ob_mean (n_obs)
      integer   UNIT
c
c...............................executable..............................
c
c     ..read ssmi variables
c
      read (UNIT) (ob_glbl(i), i = 1, n_obs)
      read (UNIT) (ob_ice(i), i = 1, n_obs)
      read (UNIT) (ob_lat(i), i = 1, n_obs)
      read (UNIT) (ob_lon(i), i = 1, n_obs)
      read (UNIT) (ob_qc(i), i = 1, n_obs)
      read (UNIT) (ob_age(i), i = 1, n_obs)
      read (UNIT) (ob_regn(i), i = 1, n_obs)
      read (UNIT) (ob_sat(i), i = 1, n_obs)
      read (UNIT) (ob_clim(i), i = 1, n_obs)
      read (UNIT) (ob_mean(i), i = 1, n_obs)
      read (UNIT) (ob_dtg(i), i = 1, n_obs)
c
c     ..produce ssmi report
c
      k = 1000
      write (45, '(''  reporting skip factor: '', i10)') k
      write (45, '(9x,''dtg'', 5x,''lat'', 5x,''lon'', 5x,''sat'',
     *             5x,''ice'', 4x,''clim'', 4x,''glbl'', 4x,''regn'',
     *             4x,''mean'', 6x,''qc'')')
      do i = 1, n_obs, k
         write (45, '(a,2f8.2,i8,5f8.2,f8.4,2x,a)')
     *          ob_dtg(i), ob_lat(i), ob_lon(i), ob_sat(i),
     *          ob_ice(i), ob_clim(i), ob_glbl(i), ob_regn(i),
     *          ob_mean(i), ob_qc(i), data_lbl(ob_sat(i))
      enddo
c
      return
      end


      subroutine error_exit (routine, message)
c
c.............................START PROLOGUE............................
c
c SCCS IDENTIFICATION:  %W% %G%
c
c MODULE NAME:  error_exit
c
c DESCRIPTION:  prints a fatal error message and terminates the program.
c
c PARAMETERS:
c    Name          Type       Usage            Description
c   -------     ----------    ------    ---------------------------
c   routine     char * (*)    input     name of routine
c   message     char * (*)    input     user supplied error message
c
c..............................END PROLOGUE.............................
c
      implicit  none
c
      integer   ln
      character message * (*)
      character routine * (*)

        INTEGER TM_LENSTR1

c
c..............................executable...............................
c
c     ..determine message string length
c
      ln = TM_LENSTR1 (message)
c
      write (*, '(//, ''*** FATAL ERROR ('', a, '') ***'')') routine
      write (*, '(/, a)') message(1:ln)
      write (*, '(/, ''*** PROGRAM TERMINATED ***'', /)')
c
c     ..exit with non zero completion code
c
      stop 15
      end
