!******************************************************************************

      module covariance

!******************************************************************************

! English Name: Covariance

! -------------

!

! Purpose: Contains utilities for accumulating metrics for calculating

! -------- observation, background and analysis covariance from the VAM

!          observational data sets.

!

! Language: Fortran 90

! ---------

!

! Notes: 

! ------ 

!

! See Also:

! ---------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! makeStat()          function      PUB  Main driver for accumulating 

!                                        observational data metrics and

!                                        updating statistical sums on the

!                                        output metrics data set.

!

!  fname                string       IN  filename of output metrics data set.

!

!  os1                OBSYSTEM       IN  VAM observations collocated at

!                                        location-1.

!

!  os2                OBSYSTEM       IN  VAM observations collocated at

!                                        location-2.

!

!  type                integer   OPT,IN  observation identifier (ID). If

!                                        unspecified, all observations are

!                                        accepted. This is useful for isolating

!                                        ships and buoys or satellite

!                                        observation types.

!

!  makeStat            integer      OUT  function return value:

!

!                                        makeStat  = 0 (normal)

!                                                 != 0 (error creating output)

!

! openMetricsFile()   function      PUB  Opens or creates an output metrics 

!                                        file and initializes statistical

!                                        sums (set to zero for new files).

!

!  fname                string       IN  name of metrics file to be created or

!                                        accessed.

!

!  openMetricsFile     integer      OUT  function return value:

!

!                                        0: normal

!                                       -1: error opening file

!

! writeMetricsFile()  function      PUB  Writes statistical sums to an output

!                                        metrics file (see openMetricsFile()).

!

!  writeMetricsFile    integer      OUT  function return value:

!

!                                        0: success

!                                       -1: error writing data

!

! addMetricsFile()    function      PUB  Updates statistical sums with 

!                                        information from an existing

!                                        metrics file.

!

!  filename             string       IN  filename of metrics file to be

!                                        added to statistical sums.

!

!  addMetricsFile      integer      OUT  function return value:

!

!                                        0: normal

!                                       -1: error reading file

!

! combineSums()     subroutine      PUB  Combines sums over a rectangular area

!                                        centered at each grid point on the 

!                                        bytemap grid. This is the main driver

!                                        to initiate the summations for each 

!                                        statistical grid.

!

!  gridRadius           integer      IN  grid point radius. A rectangular area

!                                        is summed at each grid point by looping

!                                        over the grid points -gridRadius to

!                                        +gridRadius centered at (i,j). For

!                                        example, a grid radius of "1" will

!                                        combine 9 points:

! 

!                                                *   *   *

!                                                *   X   *

!                                                *   *   * 

!

! closeMetricsFile()  function      PUB  closes the output metrics file.

!

!  closeMetricsFile    integer      OUT  function return value:

!

!                                        0: normal

!                                       -1: error closing file

!

! IUOUT                integer     PRIV  fortran unit number reserved for

!                                        output metrics file.

!

! IUWORK               integer     PRIV  fortran unit number reserved for

!                                        reading in additional metrics files.

!

! RADIUS               integer     PRIV  Radius in grid points on the bytemap

!                                        grid to search for land. Observations

!                                        close to land are not collocated.

!

! covMaxTIme              real     PRIV  Maximum allowed temporal displacement.

!                                        All observations that are more than

!                                        covMaxTime minutes from a synoptic time

!                                        are rejected (see INCHRS).

!

! INCHRS               integer     PRIV  Temporal frequency of the VAM

!                                        analyses.

!

!

! covDelx              integer     PRIV  grid point offset in x-direction to

!                                        define location-2.

!

! covDely              integer     PRIV  grid point offset in y-direction to

!                                        define location-2.

!

! sumData(:,:)  StatisticalSums    PRIV  statistical sums

!

! sumWork(:,:)  StatisticalSums    PRIV  statistical sums (temporary space)

!

! FNMASK                 string    PRIV  filename of land mask data set. This

!                                        data set contains a single bytemap

!                                        grid from a polar orbiting satellite

!                                        retrieved from REMSS.

!

! LAND(:,:)           character    PRIV  land mask: ichar(land):

!

!                                        255: land point

!

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Synoptic Evaluation Group)

!

! Modified:       Date           Author  Description

! ---------   

!           09/01/2011      J.Ardizzone  created.

!******************************************************************************

      use obtypes

      use covTypes



      private

      public :: makeStat

      public :: openMetricsFile

      public :: writeMetricsFile

      public :: closeMetricsFile

      public :: addMetricsFile

      public :: combineSums

      public :: setCovOptions



      integer, parameter :: RADIUS = 4  !Radius in grid points on the bytemap

                                        !grid to search for land. Observations

                                        !close to land are not collocated.



      integer, parameter :: IUOUT   = 77

      integer, parameter :: IUWORK  = 78

      integer, parameter :: IULAND  = 88

      integer, parameter :: INCHRS = 6 !Synoptic increment (hours).



      character(len=1), dimension(IMAP,JMAP) :: LAND

      character (len=8) :: FNMASK = 'mask.dat'



      real, dimension(IMAP,JMAP) :: buf

      type (StatisticalSums), dimension(IMAP,JMAP) :: sumData

      type (StatisticalSums), dimension(IMAP,JMAP) :: sumWork



      integer :: ITYPE,WINDTYPE



      integer :: covDelx  = 0

      integer :: covDely  = 0

      integer :: covDelt  = 0

      real :: covMaxTime  = 60.0

      real :: covMinSpeed = 0.0

      real :: covMaxSpeed = 1000.0



      integer :: istart = 0

      integer :: jstart = 0

      integer :: iend  = 0

      integer :: jend  = 0



      contains



!******************************************************************************

      integer function makeStat(idate,itime,fname,os1,os2,sumFunc,type)

!******************************************************************************

! English Name: Make Statistics

! -------------

!

! Purpose: Main driver for accumulating observational data metrics and

! -------- updating statistical sums on the output metrics data set.

!

! Language: Fortran 90

! ---------

!

! Notes: 1. Currently, only "VAM OBS" type data is accepted as input

! ------    (see "type" argument).

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! idate                integer       IN  date as ccyymmdd.

!

! itime                integer       IN  time as hhmmss.

!

! fname                 string       IN  filename of output metrics data set. 

! os1                 OBSYSTEM       IN  VAM observations collocated at

!                                        location-1.

! os2                 OBSYSTEM       IN  VAM observations collocated at

!                                        location-2.

! type                 integer   OPT,IN  observation identifier (ID). If 

!                                        unspecified, all observations are

!                                        accepted. This is useful for isolating

!                                        ships and buoys or satellite 

!                                        observation types.

!

! makeStat             integer      OUT  function return value:

!

!                                        makeStat  = 0 (normal)

!                                                 != 0 (error creating output)

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Synoptic Evaluation Group)

!

! Modified:       Date           Author  Description

! ---------   

!           08/30/2011      J.Ardizzone  created.

!******************************************************************************

      use time

      implicit none



!     Argument List

!     -------------



      integer, intent(in) :: idate,itime

      character*(*), intent(in) :: fname

      type (OBSYSTEM), intent(in) :: os1

      type (OBSYSTEM), intent(in) :: os2

      integer, optional, intent(in) :: type

      integer, external :: sumFunc



      integer iret



      makeStat = -1



!     Open output metrics file.

!     =========================



      iret = openMetricsFile(fname)

      if (iret .ne. 0) return



!     Read in land/sea mask

!     =====================



      iret = readMask(FNMASK)

      if (iret .ne. 0) return



!     Identify data set and observation type

!     ======================================



      ITYPE = 99

      if (present(type)) ITYPE = type



      WINDTYPE = SPEED_ONLY

      if (trim(os1%name) .eq. 'convention' ) WINDTYPE = UNIQUE_VECTOR

      if (trim(os1%name) .eq. 'scatconv'   ) WINDTYPE = UNIQUE_VECTOR

      if (trim(os1%name) .eq. 'ambiguous'  ) WINDTYPE = UNIQUE_VECTOR



      makeStat = makeMetrics(idate,itime,os1,os2,sumFunc)



      return



      end function makeStat



!******************************************************************************

      integer function maskout(os,obmask)

!******************************************************************************

! English Name: Mask Out

! -------------

!

! Purpose: Maps observations passing the criteria for acceptable collocation

! -------- to a bytemap grid. This grid (or observation mask) is used to 

!          resolve coincident observations by retaining only the designated

!          and/or closest observation in time and space.

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! os                  OBSYSTEM       IN  VAM observations collocated with

!                                        a gridded analysis.

!

! obmask(:,:)          integer      OUT  observation mask containing the

!                                        indices of those observations passing

!                                        the criteria for acceptance. A zero

!                                        indicates that no observation was

!                                        mapped and/or accepted at that location

!

! maskout              integer      OUT  function return value:

!                                        number of observations passing the

!                                        criteria for acceptance.

!

! ITYPE                integer       IN  desired observation type useful for

!                                        distinguishing between ships and buoys

!                                        or other observing types contained in

!                                        the VAM observations.

!

! covMaxTime           integer       IN  Maximum allowable time (in minutes)

!                                        that an observation can be from the

!                                        synoptic time and be considered for

!                                        inclusion.

!

! INCHRS               integer       IN  hourly increment used to determine the

!                                        synoptic time boundaries.

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------   

!           08/30/2011      J.Ardizzone  created.

!******************************************************************************

      use time

      use toolkit

      use SynopticBin

      implicit none



!     Argument List

!     -------------



      type (OBSYSTEM), intent(in) :: os

      integer, dimension(IMAP,JMAP), intent(out) :: obmask



!     Local Variables

!     ---------------



      real :: delta_t,t1,t2

      integer :: ndate,ntime

      integer :: i,j,k,n,iret



!     Create an observation mask that eliminates observations that failed

!     quality control or other collocation criteria. Also, eliminate duplicate

!     observations by keeping the one that is closest in time to a synoptic

!     time.

!     =====================================================================



      obmask = 0

      do n = 1,os%numobs !Loop over observations



!       Basic QC check

        if (os%obs(n)%wind%u(1) .ge. 100.0) cycle

        if (os%obs(n)%wind%qc(1) .ne. 0) cycle

        if (os%obs(n)%id .ne. ITYPE .and. ITYPE .ne. 99) cycle



!       Time check (don't want obs far away from background time)

!       Note: observation time is in minutes of day. For 00Z, minutes

!       will range from -180 to +180 for a 6-hour bin.



        ndate = os%date

        delta_t = gettime(os%obs(n)%time,INCHRS,ndate,ntime)

        if (abs(delta_t) .gt. covMaxTime) cycle



!       Determine closest grid point

        call remap(os%obs(n)%lat,os%obs(n)%lon,i,j)



!       Eliminate points that are close to land

        if (nearLand(i,j)) cycle



!       Only save the location of the observation that is closest

!       in time to the synoptic time.

        

        if (obmask(i,j) .ne. 0) then



          k = obmask(i,j)

          ndate = os%date

          t1 = gettime(os%obs(k)%time,INCHRS,ndate,ntime)

          t2 = delta_t

          if (abs(t2) .lt. abs(t1)) obmask(i,j) = n



        else



          obmask(i,j) = n



        endif



      end do



      maskout = count(obmask .ne. 0)



      end function maskout



!******************************************************************************

      integer function makeMetrics(idate,itime,os1,os2,sumFunc)

!******************************************************************************

! English Name: Make Metrics

! -------------

!

! Purpose: Updates statistical sums for calculating covariance used to estimate

! -------- uncertainty in the VAM analysis.

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! idate                integer       IN  date as ccyymmdd.

!

! itime                integer       IN  time as hhmmss.

!    

! os1                 OBSYSTEM       IN  VAM observations collocated at

!                                        location-1.

!

! os2                 OBSYSTEM       IN  VAM observations collocated at

!                                        location-2.

!

! makeMetrics           integer      OUT  function return value: not used

!

!                                         makeMetrics = 0 (normal)

! 

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Synoptic Evaluation Group)

!

! Modified:       Date           Author  Description

! ---------   

!           08/29/2011      J.Ardizzone  created.

!******************************************************************************

      use obtypes

      implicit none



!     Argument List

!     -------------



      integer, intent(in) :: idate,itime

      type (OBSYSTEM), intent(in) :: os1

      type (OBSYSTEM), intent(in) :: os2

      integer, external :: sumFunc



!     Local Variables

!     ---------------



      real :: u,v,bkgSpeed

      integer :: i,j,i2,j2,n1,n2,iret

      integer, dimension(IMAP,JMAP) :: obmask1

      integer, dimension(IMAP,JMAP) :: obmask2

      type (OBSERVATION) :: obs1,obs2



!     Maskout observations based on collocation criteria.

!     ===================================================



      makeMetrics = 0



      if (maskout(os1,obmask1) .eq. 0) return

      if (maskout(os2,obmask2) .eq. 0) return



!     Update statistical sums

!     =======================

      

      do j = 1,JMAP

        do i = 1,IMAP



!         "n" is the observation index closest in time and space to the

!         current grid point (passing QC mark and within time window).



!         Define Location-1



          n1 = obmask1(i,j)

          if (n1 .eq. 0) cycle



!         Speed check (background speed must be within specified speed bin.



          u = os1%obs(n1)%wind%u(3)

          v = os1%obs(n1)%wind%v(3)

          bkgSpeed = sqrt(u*u + v*v)

          if (bkgSpeed .lt. covMinSpeed) cycle

          if (bkgSpeed .ge. covMaxSpeed) cycle



!         Define Location-2



          i2 = i + covDelx

          if (i2 .gt. IMAP) i2 = i2 - IMAP



          j2 = j + covDely

          if (j2 .gt. JMAP) cycle

          if (j2 .lt. 1) cycle



          n2 = obmask2(i2,j2)

          if (n2 .eq. 0) cycle



          obs1 = os1%obs(n1)

          obs2 = os2%obs(n2)



!         Update statistical sums



          iret = sumFunc(obs1,obs2,sumData(i,j))



          if (i .lt. istart) cycle

          if (i .gt. iend) cycle

          if (j .lt. jstart) cycle

          if (j .gt. jend) cycle



          call covPrint(idate,itime,obs1)



        end do

      end do



      makeMetrics = 0



      end function makeMetrics



!******************************************************************************

      integer function readMetricsFile()

!******************************************************************************

! English Name: Read Metrics File

! -------------

!

! Purpose: Reads in statistical sums from a metrics file.

! -------- 

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! readMetricsFile      integer      OUT  function return value:

!

!                                        0: success

!                                       -1: error reading data

!

! sumSpeed(:,:) StatisticalSums     OUT  statistical sums for wind speed

! sumUwind(:,:) StatisticalSums     OUT  statistical sums for U-wind

! sumVwind(:,:) StatisticalSums     OUT  statistical sums for V-wind

! sumDir  (:,:) StatisticalSums     OUT  statistical sums for wind direction

!

! IREC                 integer      OUT  i/o record pointer.

! IUOUT                integer       IN  unit number for metrics data file. 

!

!

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------

!           08/29/2011      J.Ardizzone  created.

!******************************************************************************

                                                                                

      implicit none

                                                                                

      integer iret



      readMetricsFile = -1



      iret = readSums(IUOUT,sumData)

      if (iret .ne. 0) return



      readMetricsFile = 0

                                                                                

      end function readMetricsFile



!******************************************************************************

      integer function readSums(iu,sums)

!******************************************************************************

! English Name: Read Sums

! -------------

!

! Purpose: Reads in statistical sums for a single instantiation of the 

! -------- derived data type.

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! iu                   integer       IN  fortran unit number for input data

!                                        stream.

!

! sums(:,:)    StatisticalSums      OUT  returned data structure containing

!                                        input statistical sums.

!

! readSums             integer      OUT  function return value:

!

!                                        0: success

!                                       -1: error reading data 

!

! IREC                 integer    INOUT  i/o record pointer.

!

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------   

!           08/26/2011      J.Ardizzone  created.

!******************************************************************************

      implicit none



      integer, intent(in) :: iu

      type (StatisticalSums), dimension(:,:), intent(out) :: sums



      integer :: iret, irec=0



      readSums = -1



!     Read in covariance sums for derived data structure.

!     ===================================================



      read(iu,rec=irec+1,iostat=iret) sums%count

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a1b1o2b2 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%o1a1o2b2 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a1b1o2a2 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a1b1o1b1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a2b2o2b2 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%o1a1o1b1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%o2a2o2b2 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a1b1o1a1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a2b2o2a2 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%b1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%o1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a1a1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%b1b1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%o1o1 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%o2a2 = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%o2b2 = buf

      if (iret .ne. 0) return

      irec=irec+1



! Additional kludge sums

      read(iu,rec=irec+1,iostat=iret) buf

      sums%a1b1o2b2sq = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%o1a1o2b2sq = buf

      if (iret .ne. 0) return

      irec=irec+1



      read(iu,rec=irec+1,iostat=iret) buf

      sums%a1b1o2a2sq = buf

      if (iret .ne. 0) return

      irec=irec+1



      readSums = 0



      end function readSums

!******************************************************************************

      integer function writeMetricsFile()

!******************************************************************************

! English Name: Write Metrics File

! -------------

!

! Purpose: Writes statistical sums to an output metrics file.

! -------- 

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! writeMetricsFile     integer      OUT  function return value:

!

!                                        0: success

!                                       -1: error writing data

!

! sumSpeed(:,:) StatisticalSums      IN  Statistical sums for wind speed

! sumUwind(:,:) StatisticalSums      IN  Statistical sums for U-wind

! sumVwind(:,:) StatisticalSums      IN  Statistical sums for V-wind

! sumDir  (:,:) StatisticalSums      IN  Statistical sums for wind direction

!

! IREC                 integer      OUT  i/o record pointer.

! IUOUT                integer       IN  unit number for metrics data file. 

!

!

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------

!           08/30/2011      J.Ardizzone  created.

!******************************************************************************

                                                                                

      implicit none

                                                                                

      integer iret



      writeMetricsFile = -1



      iret = writeSums(IUOUT,sumData)

      if (iret .ne. 0) return



      writeMetricsFile = 0

                                                                                

      end function writeMetricsFile



!******************************************************************************

      integer function writeSums(iu,sums)

!******************************************************************************

! English Name: Write Sums

! -------------

!

! Purpose: Writes out statistical sums for a single instantiation of the 

! -------- derived data type.

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! iu                   integer       IN  fortran unit number for input data

!                                        stream.

!

! sums(:,:)    StatisticalSums       IN  data structure containing statistical

!                                        sums.

!

! writeSums            integer      OUT  function return value:

!

!                                        0: success

!                                       -1: error writing data 

!

! IREC                 integer    INOUT  i/o record pointer.

!

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------   

!           08/26/2011      J.Ardizzone  created.

!******************************************************************************

      implicit none



      integer, intent(in) :: iu

      type (StatisticalSums), dimension(:,:), intent(in) :: sums



      integer :: iret, irec



      writeSums = -1

      irec = 0



!     Write out covariance sums for derived data structure.

!     =====================================================



      write(iu,rec=irec+1,iostat=iret) sums%count

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a1b1o2b2

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%o1a1o2b2

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a1b1o2a2

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a1b1o1b1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a2b2o2b2

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%o1a1o1b1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%o2a2o2b2

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a1b1o1a1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a2b2o2a2

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%b1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%o1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a1a1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%b1b1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%o1o1

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%o2a2

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%o2b2

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



! Additional kludge sums

      buf = sums%a1b1o2b2sq

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%o1a1o2b2sq

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      buf = sums%a1b1o2a2sq

      write(iu,rec=irec+1,iostat=iret) buf

      if (iret .ne. 0) return

      irec=irec+1



      writeSums = 0



      end function writeSums



!******************************************************************************

      subroutine remap(lat,lon,i,j)

!******************************************************************************

! English Name: Re-map

! -------------

!

! Purpose: Converts lat/lon into bytemap grid indices for mapping the obs

! -------- to the grid locations.

!

! Language: Fortran 90

! ---------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! lat                     real       IN  latitude in degrees north of eq.

! lon                     real       IN  longitude in degrees south of eq.

! i                    integer      OUT  longitude index of the nearest grid

!                                        point.

! j                    integer      OUT  latitude index of the nearest grid

!                                        point.

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Synoptic Evaluation Group)

!

! Modified:       Date           Author  Description

! ---------   

!            12/03/2007     J.Ardizzone  documented.

!******************************************************************************



      implicit none



!     Argument List

!     -------------



      integer, intent(out) :: i,j

      real, intent(in) :: lat,lon



      real :: rlon



!     Calculate nearest grid point

!     ============================



      rlon = lon

      if (rlon .lt. 0) rlon = rlon + 360.0



      i = nint( (rlon - STLON) / LONINC + 1.0)

      j = nint( (lat - STLAT) / LATINC + 1.0)



      if (j .lt. 1) j = 1

      if (j .gt. JMAP) j = JMAP



      if (i .lt. 1) i = IMAP

      if (i .gt. IMAP) i = 1



      end subroutine remap



!******************************************************************************

      logical function nearLand(i,j)

!******************************************************************************

! English Name: Near Land

! -------------

!

! Purpose: Performs a radial search in grid point space for land points.

! --------

!

! Language: Fortran 90

! ---------

!

! See Also: readMask()

! ---------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! i                    integer       IN  longitude index of center point on

!                                        bytemap grid.

!

! j                    integer       IN  latitude index of center point on

!                                        bytemap grid.

!

! nearLand             logical      OUT  function return value:

!

!                                        T: center point is near land

!                                        F: center point is not near land

!

! RADIUS               integer       IN  search radius in grid points

!

! LAND(:,:)          character       IN  bytemap land mask: ichar(land) =

!

!                                        255: land point

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------   

!           09/01/2011      J.Ardizzone  created.

!******************************************************************************



      integer, intent(in) :: i,j

      integer :: ir,jr,irad,jrad



      nearLand = .true.



      do jrad = -RADIUS,RADIUS



        jr = j + jrad

        if (jr .gt. JMAP) jr = JMAP

        if (jr .lt. 1) jr = 1



        do irad = -RADIUS,RADIUS



          ir = i + irad

          if (ir .gt. IMAP) ir = ir - IMAP

          if (ir .lt. 1) ir = ir + IMAP



          if (ichar(land(ir,jr)) .eq. 255) return



        end do



      end do



      nearLand = .false.



      end function nearLand



!******************************************************************************

      integer function openMetricsFile(fname)

!******************************************************************************

! English Name: Open Metrics

! -------------

!

! Purpose: Opens or creates an output metrics file and initializes upon

! -------- creation of the file.

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! fname                 string       IN  name of metrics file to be created

!

! openMetricsFile      integer      OUT  function return value:

!

!                                        0: normal

!                                       -1: error opening file

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------   

!           08/10/2011      J.Ardizzone  created.

!******************************************************************************

      implicit none

 

!     Argument List

!     -------------



      character (len=*), intent(in) :: fname



!     Local Variables

!     ---------------

    

      integer :: iret

      logical :: isThere,fileOpen



      openMetricsFile = -1



!     Open output file.

!     =================



      inquire(file=fname,exist=isThere)

      inquire(unit=IUOUT,opened=fileOpen)



      if (.not. isThere) then



        open(unit=IUOUT,file=fname,form='unformatted',access='direct',

     &                     recl=RECSIZE*4,status='new',iostat=iret)

        if (iret .ne. 0) return



        sumData = 0.0



      elseif (.not. fileOpen) then 



        open(unit=IUOUT,file=fname,form='unformatted',access='direct',

     &                     recl=RECSIZE*4,status='old',iostat=iret)

        if (iret .ne. 0) return



        if (readMetricsFile() .ne. 0) return



      endif



      openMetricsFile = 0



      end function openMetricsFile



!******************************************************************************

      integer function closeMetricsFile()

!******************************************************************************

! English Name: Close Metrics File

! -------------

!

! Purpose: Closes the metrics file.

! -------- 

!

! Language: Fortran 90

! ---------

!

! See Also: openMetricsFile()

! ---------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! closeMetricsFile     integer      OUT  function return value:

!

!                                        0: normal

!                                       -1: error closing file

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------   

!           09/01/2011      J.Ardizzone  created.

!******************************************************************************

      implicit none

 

!     Local Variables

!     ---------------

    

      integer :: iret

      logical :: fileOpen



      iret = 0

      closeMetricsFile = -1



      inquire(unit=IUOUT,opened=fileOpen)



      if (fileOpen) close(unit=IUOUT,iostat=iret)

      if (iret .ne. 0) return



      closeMetricsFile = 0



      end function closeMetricsFile



!******************************************************************************

      integer function addMetricsFile(filename)

!******************************************************************************

! English Name: Add Metrics File

! -------------

!

! Purpose: Updates statistical sums with information from an existing

! -------- metrics file.

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! filename              string       IN  filename of metrics file to be

!                                        added to statistical sums.

!

! addMetricsFile       integer      OUT  function return value:

!

!                                        0: normal

!                                       -1: error reading file

!

! sumSpeed(:,:) StatisticalSums     OUT  updated statistical sums for wind speed

! sumUwind(:,:) StatisticalSums     OUT  updated statistical sums for U-wind

! sumVwind(:,:) StatisticalSums     OUT  updated statistical sums for V-wind

! sumDir  (:,:) StatisticalSums     OUT  updated statistical sums for wind dir

!

! IREC                 integer      OUT  i/o record pointer.

! IUWORK               integer       IN  unit number for new metrics data file.

! sumWork(:,:) StatisticalSums      OUT  temporary work space.

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------   

!           09/06/2011      J.Ardizzone  created.

!******************************************************************************



      implicit none



      character(len=*), intent(in) :: filename

      integer :: iret



      addMetricsFile = -1



!     Open metrics file



      open(unit=IUWORK,file=filename,form='unformatted',access='direct',

     &                     recl=RECSIZE*4,status='old',iostat=iret)

      if (iret .ne. 0) return



!     Read and add file to statistical sums



      iret = readSums(IUWORK,sumWork)

      if (iret .ne. 0) return

      sumData = sumData + sumWork



      close (unit=IUWORK)



      addMetricsFile = 0



      end function addMetricsFile



!******************************************************************************

      subroutine combineSums(gridRadius)

!******************************************************************************

! English Name: Combine Sums

! -------------

!     

! Purpose: Combines sums over a rectangular area centered at each grid point

! -------- on the bytemap grid. This is the main driver to initiate the

!          summations for each statistical grid.

!

! Language: Fortran 90

! ---------

!

! See Also: sumSums()

! ---------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! gridRadius           integer       IN  grid point radius. A rectangular area

!                                        is summed at each grid point by looping

!                                        over the grid points -gridRadius to

!                                        +gridRadius centered at (i,j). For

!                                        example, a grid radius of "1" will

!                                        combine 9 points:

!

!                                                *   *   *

!                                                *   X   *

!                                                *   *   *

!

!                                  

! sumSpeed(:,:) StatisticalSums   INOUT  combined statistical sums for wind spd

! sumUwind(:,:) StatisticalSums   INOUT  combined statistical sums for U-wind

! sumVwind(:,:) StatisticalSums   INOUT  combined statistical sums for V-wind

! sumDir  (:,:) StatisticalSums   INOUT  combined statistical sums for wind dir

!

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------

!           09/09/2011      J.Ardizzone  created.

!******************************************************************************



      implicit none



      integer :: gridRadius



      call sumSums(gridRadius,sumData)



      end subroutine combineSums



!******************************************************************************

      subroutine sumSums(gridRadius,sums)

!******************************************************************************

! English Name: Sum Sums

! -------------

!

! Purpose: Combines sums over a rectangular area centered at each grid point

! -------- on the bytemap grid.

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! gridRadius           integer       IN  grid point radius. A rectangular area

!                                        is summed at each grid point by looping

!                                        over the grid points -gridRadius to

!                                        +gridRadius centered at (i,j). For

!                                        example, a grid radius of "1" will

!                                        combine 9 points:

!

!                                                *   *   *

!                                                *   X   *

!                                                *   *   *

!

! sums(:,:)    StatisticalSums    INOUT  On input, sums at each grid point. On

!                                        output, combined sums over the grid

!                                        point radius at each (i,j). Note: 

!                                        summation is always performed on the

!                                        original input grid (i.e. no nested

!                                        propagation of the sums).

!

! sumWork(:,:) StatisticalSums      OUT  temporary work space.

!    

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------   

!           09/09/2011      J.Ardizzone  created.

!******************************************************************************



      implicit none



!     Argument List

!     -------------

      integer, intent(in) :: gridRadius

      type (StatisticalSums), dimension(:,:), intent(inout) :: sums



!     Local Variables

!     ---------------



      integer :: i,j,ir,jr,irad,jrad



      sumWork = 0.0



!     Combine sums at each grid point.



      do j = 1,JMAP



        do i = 1,IMAP



          if (sums(i,j)%count .eq. 0) cycle ! Do not create data where none

                                            ! exists.



          do jrad = -gridRadius,gridRadius



            jr = j + jrad

            if (jr .gt. JMAP) cycle 

            if (jr .lt. 1) cycle



            do irad = -gridRadius,gridRadius



              ir = i + irad

              if (ir .gt. IMAP) ir = ir - IMAP

              if (ir .lt. 1) ir = ir + IMAP



              sumWork(i,j) = sumWork(i,j) + sums(ir,jr)



            end do



          end do



        end do



      end do



!     Save combined sums and return



      sums = sumWork



      end subroutine sumSums



!******************************************************************************

      integer function readMask(fname)

!******************************************************************************

! English Name: Read Mask

! -------------

!

! Purpose: Reads in a masking file containing land/ice/water information

! -------- on a bytemap grid.

!

! Language: Fortran 90

! ---------

!

! Notes:

! ------

!

! Interface:              Type   Access  Description

! ----------                     Intent

!

! fname                 string       IN  name of masking file.

!

! readMask             integer      OUT  function return value:

!

!                                        0: normal

!                                       -1: error opening file

!

! LAND(:,:)          character      OUT  land mask. ichar(land):

!

!                                        255: land

!

! Programmer: Joseph V. Ardizzone

! ----------- (NASA Goddard Space Flight Center)

!             (Software Integration and Visualization Office - SIVO)

!

! Modified:       Date           Author  Description

! ---------

!           08/10/2011      J.Ardizzone  created.

!******************************************************************************

      implicit none



!     Argument List

!     -------------



      character (len=*), intent(in) :: fname



!     Local Variables

!     ---------------



      integer :: iret

      logical :: fileOpen



      readMask = 0



      inquire(unit=IULAND,opened=fileOpen)

      if (fileOpen) return



      readMask = -1



      open (unit=IULAND,form='unformatted',access='direct',recl=IMAP*JMAP*1,

     &      file=fname,status='old',iostat=iret)



      if (iret .ne. 0) return



      read(IULAND,rec=1,iostat=iret) LAND

      if (iret .ne. 0) return



      readMask = 0



      end function readMask



      integer function setCovOptions(maxTime,minSpeed,maxSpeed,delx,dely,delt,

     &                                        startLat,startLon,endLat,endLon)



      real, optional, intent(in) :: maxTime

      real, optional, intent(in) :: minSpeed

      real, optional, intent(in) :: maxSpeed

      real, optional, intent(in) :: startLat 

      real, optional, intent(in) :: startLon

      real, optional, intent(in) :: endLat

      real, optional, intent(in) :: endLon

      integer, optional, intent(in) :: delx

      integer, optional, intent(in) :: dely

      integer, optional, intent(in) :: delt



      integer :: i,j



      if (present(maxTime)) covMaxTime = maxtime

      if (present(maxSpeed)) covMaxSpeed = maxSpeed

      if (present(minSpeed)) covMinSpeed = minSpeed

      if (present(delx)) covDelx = delx

      if (present(dely)) covDely = dely

      if (present(delt)) covDelt = delt

      if (present(startLat)) call remap(startLat,0.0,i,jstart)

      if (present(startLon)) call remap(0.0,startLon,istart,j)

      if (present(endLat)) call remap(endLat,0.0,i,jend)

      if (present(endLon)) call remap(0.0,endLon,iend,j)



      setCovOptions = 0



      end function setCovOptions

!******************************************************************************

      subroutine covPrint(idate,itime,obs)

!******************************************************************************

      use time

      use toolkit

      use SynopticBin

      implicit none



!     Argument List

!     -------------



      integer, intent(in) :: idate,itime

      type (OBSERVATION), intent(in) :: obs



!     Local Variables

!     ---------------



      real :: delta_t

      integer :: ndate,ntime



!     Print observation information



      ndate = 19870101

      delta_t = gettime(obs%time,INCHRS,ndate,ntime)



      write(6,100) idate,itime,delta_t,obs%lat,obs%lon,abo%A1,abo%B1,abo%O1

 100  format(1x,'covPrint','|',2(i10,'|'),6(f10.3,'|'))



      end subroutine covPrint



      end module covariance