EnKF/src_conversion/TMP/mod_measurement.f90

# 0 "<stdin>"
# 0 "<built-in>"
# 0 "<command-line>"


# 1 "/usr/include/stdc-predef.h" 1 3 4

# 17 "/usr/include/stdc-predef.h" 3 4











































# 2 "<command-line>" 2
# 1 "<stdin>"
# 9 "<stdin>"
module mod_measurement

  integer, parameter, public :: OBSTYPESTRLEN = 8
  integer, parameter, private :: MAXNUOBS = 9

  integer, public :: nuobs
  character(OBSTYPESTRLEN), public :: unique_obs(MAXNUOBS)
  integer, public :: nobseach(MAXNUOBS)
  integer :: uobs_begin(MAXNUOBS), uobs_end(MAXNUOBS)

  type measurement
     real d                       ! Measurement value
     real var                     ! Error variance of measurement
     character(OBSTYPESTRLEN) id  ! Type of measurement ('a_i_htc1', 'a_i_tot ', 'u_ice   ', 'v_ice   ')
     real lon                     ! Longitude position
     real lat                     ! Latitude position
     real depths                  ! depths of position 
     integer ipiv                 ! i-pivot point in grid
     integer jpiv                 ! j-pivot point in grid
     integer ns                   ! representativity in mod cells (meas. support)
                                  ! ns=0 means: point measurements
                                  ! used in m_Generate_element_Sij.F90
     real a1                      ! bilinear coeffisients (if ni=0)
     real a2                      ! bilinear coeffisients
     real a3                      ! bilinear coeffisients
     real a4                      ! bilinear coeffisients
     logical status               ! active or not
     integer i_orig_grid          ! KAL - ice drift needs orig grid index as well
     integer j_orig_grid          ! KAL - ice drift needs orig grid index as well
     real h                       ! PS - layer thickness, sorry for that
     integer date                 ! FanF- age of the data 
     integer orig_id              ! PS used in superobing
  end type measurement

contains

  subroutine get_unique_obs(tags, nrobs, master)
    implicit none
    integer , intent(in) :: nrobs
    logical , intent(in) :: master
    character(OBSTYPESTRLEN), intent(in) :: tags(nrobs)

    logical :: obsmatch
    integer :: o, uo

    nobseach = 0

    ! check for unique obs
    if (master) then
       print *
       print *, '(get_unique_obs) Getting unique obs '
    end if
    nuobs = 0
    unique_obs = ''
    do o = 1, nrobs
       obsmatch = .false.
       do uo = 1, MAXNUOBS
          if (trim(tags(o)) == trim(unique_obs(uo))) then
             obsmatch = .true.
             nobseach(uo) = nobseach(uo) + 1
             exit
          end if
       end do
       if (.not. obsmatch) then
          nuobs = nuobs + 1
          nobseach(nuobs) = 1
          if (nuobs > MAXNUOBS) then
             if (master) then
                print *, '(get_unique_obs) ERROR: # of unique obs > MAXNUOBS'
             end if
             stop
          end if
          unique_obs(nuobs) = trim(tags(o))
       end if
    end do
    if (master) then
       do uo = 1, nuobs
          print *, '(get_unique_obs) obs variable  ', uo, ' -- ', trim(unique_obs(uo)),&
                  ',', nobseach(uo), ' observations'
       end do
    end if
    uobs_begin(1) = 1
    uobs_end(1) = nobseach(1)
    do uo = 2, nuobs
       uobs_begin(uo) = uobs_end(uo - 1) + 1
       uobs_end(uo) = uobs_begin(uo) + nobseach(uo) - 1
    end do
    if (master) then
       do uo = 1, nuobs
          do o = uobs_begin(uo), uobs_end(uo)
             if (trim(tags(o)) /= trim(unique_obs(uo))) then
                print *, '(get_unique_obs) ERROR: unique observations not ',&
                     'continuous in observation array'
                stop
             end if
          end do
       end do
    end if
  end subroutine get_unique_obs

end module mod_measurement