EnKF/EnKF-MPI-TOPAZ/Prep_Routines/m_get_def_wet_point.F90

! Bilinear coeffisients are calculated witin this program for all the 
! observation points.
! Only wet points are stored in the observation.uf file

module m_get_def_wet_point

  implicit none

  integer, parameter, private :: STRLEN = 512
  character(STRLEN), parameter, private :: MEANSSHFNAME = "meanssh.uf"
  
  private read_mean_ssh
  private land_nearby

contains 

  subroutine get_def_wet_point(obs, data, gr, depths, modlat, modlon, nrobs, nx, ny)
    ! Program converts to a general format readable by ENKF (observations.uf)
    use mod_measurement
    use mod_grid
    ! Functions to be used
    use m_oldtonew
    use m_bilincoeff
    use m_pivotp
    use m_confmap
    use m_spherdist

    integer, intent(in) :: nx, ny
    type (measurement), intent(in) :: data(:)
    type (measurement), intent(inout)   :: obs(:)
    type (grid), intent(in) :: gr      ! observations grid
    real, dimension(nx, ny), intent(in)  ::  depths, modlat, modlon
    integer, intent(out) :: nrobs
    integer, parameter :: maxobs = 1441 * 722 !2*400*600 ! maximum number of observations

    real, dimension(nx, ny) :: mean_ssh
    integer k, imin, imax, jmin, jmax
    integer ipiv, jpiv, nsupport, nsmin, nsmax
    real :: x0, y0
    real wetsill, griddiag, mingridsize, minobssize

    logical wet

    ! gr = default_grid
    nrobs = 0; 
    nsmin = maxobs; 
    nsmax = 0
    mingridsize = 1.E+10; 
    minobssize = 1.E+10    ! in meters

    call confmap_init(nx,ny) ! Initialize conformal mapping before calling

    !Calculate pivot points
    !Find wet points (all neigbours in water)
    !Find the points with defined data value
    !Put the data into the obs data structture
    !Compute bilinear coefficients

    call read_mean_ssh(mean_ssh, nx, ny)

    do k = 1, gridpoints(gr)
       if (data(k) % id .eq. 'SLA' .or. data(k) % id .eq. 'sla' .or. &
            data(k) % id.eq. 'SSH' .or. data(k)%id .eq. 'ssh' .or.&
            data(k)%id.eq.'TSLA') then
          wetsill = 200.   ! Discarding data in shallow waters
       else
          wetsill=10.
       endif
       call oldtonew(data(k) % lat, data(k) % lon, y0, x0)
       call pivotp(x0, y0, ipiv, jpiv)
       ! Discard obs on model boundaries (TODO: cyclic domains) 
       ! Also valid if ns=0 
       imin = ipiv - data(k) % ns
       imax = ipiv + data(k) % ns + 1 
       jmin = jpiv - data(k) % ns
       jmax = jpiv + data(k) % ns + 1
       if ((imin .le. 0) .or. (jmin .le. 0) .or. (imax .ge. nx) .or. &
            (jmax .ge. ny)) cycle
       ! Is observation surrounded by wet grid points?
       if (any(depths(imin:imax, jmin:jmax) < wetsill .or. depths(imin:imax, jmin:jmax) == depths(imin:imax, jmin:jmax) + 1.0)) cycle
       wet = data(k) % status ! Discards inconsistent/Fill values
       if (data(k) % id .eq. 'SLA' .or. data(k) % id .eq. 'sla' .or.&
            data(k) % id .eq. 'TSLA') then
          wet = wet .and. (mean_ssh(ipiv, jpiv) < 990)
          wet = wet .and. .not. land_nearby(nx, ny, mean_ssh, modlon, modlat,&
               ipiv, jpiv, data(k) % lon, data(k) % lat)
       endif

       if(.not. undefined(data(k) % d, gr) .and. wet) then
          nrobs = nrobs + 1
          obs(nrobs) = data(k)
          obs(nrobs) % ipiv = ipiv
          obs(nrobs) % jpiv=  jpiv
          obs(nrobs) % status = .true. ! Wet obs
          if (data(k) % ns > 0) then   ! large support data: a1 is the obs support(m)
             griddiag = spherdist(modlon(ipiv, jpiv), modlat(ipiv, jpiv), &
                  modlon(ipiv + 1, jpiv + 1), modlat(ipiv + 1, jpiv + 1))
             !FC: 0.5 because m_Generate_element_Si runs from -ns to +ns 
             nsupport = floor(0.5 * data(k) % a1 / griddiag) ! both in meters
             obs(nrobs)%ns = nsupport  ! number of grid cells in the diagonal
             nsmin = min(nsmin, nsupport)
             nsmax = max(nsmax, nsupport)
             mingridsize = min(mingridsize, griddiag)
             minobssize = min(minobssize, data(k) % a1)
          else
             obs(nrobs) % ns = 0    ! point measurements have zero support
          endif
          call bilincoeff(modlon, modlat, nx, ny, obs(nrobs)%lon, &
               obs(nrobs) % lat, obs(nrobs) % ipiv, obs(nrobs) % jpiv, &
               obs(nrobs) % a1, obs(nrobs) % a2, obs(nrobs) % a3, &
               obs(nrobs) % a4)
       endif
    end do
    print*, 'Number of defined and wet observations: nrobs ', nrobs
    print*, 'Support (in nb of cells) between: ', nsmin, ' and ', nsmax
    print '(2(a,f8.3),a)', ' Minimum obs support: ', 0.001 * minobssize, &
         'km, min grid diagonal: ', 0.001 * mingridsize, ' km' 
  end subroutine get_def_wet_point


  subroutine read_mean_ssh(mean_ssh, nx, ny)
    integer, intent(in) :: nx, ny
    real, intent(out):: mean_ssh(nx, ny)
    logical :: exists

    inquire(file = trim(MEANSSHFNAME), exist = exists)
    if (.not. exists) then
       print *,'ERROR: read_mean_ssh(): file "', trim(MEANSSHFNAME), '" not found'
       stop
    end if
       
    open (10, file = trim(MEANSSHFNAME), status = 'unknown',form = 'unformatted')
    read (10) mean_ssh
    close (10)
  end subroutine read_mean_ssh


  logical function land_nearby(nx, ny, mean_ssh, modlon, modlat, ipiv, jpiv, obslon, obslat)
    use m_spherdist
    implicit none
    real, parameter :: Dis0 = 50.0d0
    integer, intent (in) :: nx, ny, ipiv, jpiv
    real, dimension(nx,ny), intent(in) :: mean_ssh, modlon, modlat
    real, intent (in) :: obslon,obslat 
    integer :: ii, jj, ncells
    real :: griddist

    land_nearby = .false.
    ncells = ceiling(Dis0 / spherdist(modlon(ipiv, jpiv), modlat(ipiv, jpiv),&
         modlon(ipiv, jpiv + 1), modlat(ipiv, jpiv + 1)))
    do jj = max(jpiv - ncells, 1), min(jpiv + ncells, ny)
       do ii = max(ipiv - ncells, 1), min(ipiv + ncells, nx)
          griddist = spherdist(modlon(ii, jj), modlat(ii, jj), obslon, obslat)
          if (mean_ssh(ipiv,jpiv) < 990 .and. griddist < Dis0) then
             land_nearby = .true.
             return
          end if
       enddo
    enddo
  end function land_nearby

end module m_get_def_wet_point