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

module m_read_jpl_hice

contains

  subroutine read_jpl_hice(fname, obstype, variance, nx, ny, data)
    use mod_measurement
    use m_oldtonew
    use m_confmap
    use m_bilincoeff
    use m_pivotp
    implicit none

    character(*), intent(in) :: fname
    character(*), intent(in) :: obstype
    real(8), intent(in) :: variance
    integer, intent(in) :: nx, ny
    type(measurement), allocatable, intent(out) :: data(:)

    type(measurement), allocatable :: tmpdata(:)
    real(8), dimension(nx, ny) :: modlat, modlon
    real(8), dimension(nx, ny) :: depths

    integer :: npoints
    integer :: i
    integer :: nobs
    real(8) :: lat, lon, tmp1, tmp2, h
    real(8) :: latnew, lonnew
    integer :: ipiv, jpiv

    open(101, file = trim(fname))
    read(101, *) npoints
    print *, '  ',trim(fname), ': ', npoints, ' data points'

    allocate(tmpdata(npoints))
    call confmap_init(nx, ny)
    call grid_readxyz(nx, ny, modlat, modlon, depths)

    nobs = 0
    do i = 1, npoints
       read(101, *) lat, lon, tmp1, tmp2, h
       if (h > 0.0d0 .and. h < 9990.0d0) then
          call oldtonew(lat, lon, latnew, lonnew)
          call pivotp(lonnew, latnew, ipiv, jpiv)

          if (ipiv < 1 .or. jpiv < 1 .or. ipiv > nx - 1 .or. jpiv > ny - 1) then
             cycle
          end if
          if (depths(ipiv, jpiv) < 10) then
             cycle
          end if

          nobs = nobs + 1
          tmpdata(nobs) % d = h / 100.0d0
          tmpdata(nobs) % id = obstype
          tmpdata(nobs) % var = variance
          tmpdata(nobs) % lon = lon
          tmpdata(nobs) % lat = lat
          tmpdata(nobs) % ipiv = ipiv
          tmpdata(nobs) % jpiv = jpiv
          tmpdata(nobs) % ns = 0 ! for a point (not gridded) measurement
          tmpdata(nobs) % date = 0 ! assimilate synchronously

          call bilincoeff(modlon, modlat, nx, ny, lon, lat, ipiv,&
               jpiv, tmpdata(nobs) % a1, tmpdata(nobs) % a2, tmpdata(nobs) % a3,&
               tmpdata(nobs) % a4)

          tmpdata(nobs) % status = .true. ! (active)
          tmpdata(nobs) % i_orig_grid = -1 ! not used
          tmpdata(nobs) % j_orig_grid = -1 ! not used
       end if
    end do
    close(101)

    print *, '  ', nobs, ' valid observations'

    allocate(data(nobs))
    do i = 1, nobs
       data(i) = tmpdata(i)
    end do
    deallocate(tmpdata)

  end subroutine read_jpl_hice


  subroutine grid_readxyz(nx, ny, lat, lon, depth)
    integer, intent(in) :: nx, ny
    real(8), dimension(nx, ny), intent(inout) :: lat, lon, depth

    logical :: exists
    character(len = 128) :: fname
    
    fname = 'newpos.uf'
    inquire(file = fname, exist = exists)
    if (.not. exists) then
       print *, 'grid_readxyz(): ERROR: "', trim(fname), '" does not exist'
       stop
    end if
    open(10, file = fname, form = 'unformatted', status = 'old')
    print *, '  grid_readxyz(): reading "', trim(fname), '"...'
    read(10) lat, lon
    close(10)

    write(fname, '(a, i3.3, a, i3.3, a)') 'depths', nx, 'x', ny, '.uf'
    inquire(file = fname, exist = exists)
    if (.not. exists) then
       print*, 'grid_readxyz(): ERROR: "', trim(fname), '" does not exist'
       stop
    end if
    open (unit = 10, file = fname, status = 'old', form = 'unformatted')
    print *, '  grid_readxyz(): reading "', trim(fname), '"...'
    read(10) depth
    close(10)
  end subroutine grid_readxyz

end module m_read_jpl_hice