ufo_basis_tlad_mod.F90

Go to the documentation of this file.

! (C) Copyright 2017-2018 UCAR
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.

module ufo_basis_tlad_mod

  use iso_c_binding
  use ufo_geovals_mod
  use ufo_geovals_mod_c,   only: ufo_geovals_registry

  type, abstract :: ufo_basis_tlad
    private
      logical, public :: ltraj = .false. !< trajectory set?
  contains
    procedure, non_overridable    :: opr_delete  => opr_delete_
    procedure, non_overridable    :: opr_settraj => opr_settraj_
    procedure, non_overridable    :: opr_simobs_tl  => opr_simobs_tl_
    procedure, non_overridable    :: opr_simobs_ad  => opr_simobs_ad_
    procedure(delete_),  deferred :: delete
    procedure(settraj_), deferred :: settraj
    procedure(simobs_tl_),  deferred :: simobs_tl
    procedure(simobs_ad_),  deferred :: simobs_ad
  end type ufo_basis_tlad

  abstract interface

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

    subroutine delete_(self)
      import ufo_basis_tlad
      implicit none
      class(ufo_basis_tlad), intent(inout) :: self
    end subroutine

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

    subroutine settraj_(self, geovals, obss)
      import ufo_basis_tlad, ufo_geovals, c_ptr
      implicit none
      class(ufo_basis_tlad), intent(inout) :: self
      type(ufo_geovals),    intent(in) :: geovals
      type(c_ptr), value,   intent(in) :: obss
    end subroutine

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

    subroutine simobs_tl_(self, geovals, hofx, obss)
      use iso_c_binding
      import ufo_basis_tlad, ufo_geovals
      implicit none
      class(ufo_basis_tlad), intent(in) :: self
      type(ufo_geovals),     intent(in)    :: geovals
      real(c_double),        intent(inout) :: hofx(:)
      type(c_ptr), value,    intent(in)    :: obss
    end subroutine

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

    subroutine simobs_ad_(self, geovals, hofx, obss)
      use iso_c_binding
      import ufo_basis_tlad, ufo_geovals
      implicit none
      class(ufo_basis_tlad), intent(in)    :: self
      type(ufo_geovals),     intent(inout) :: geovals
      real(c_double),        intent(in)    :: hofx(:)
      type(c_ptr), value,    intent(in)    :: obss
    end subroutine

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

  end interface

contains
! ------------------------------------------------------------------------------

    subroutine opr_delete_(self)
      implicit none
      class(ufo_basis_tlad), intent(inout)  :: self

      call self%delete()

    end subroutine opr_delete_

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

    subroutine opr_settraj_(self, c_key_geovals, c_obsspace)
      implicit none

      class(ufo_basis_tlad), intent(inout) :: self
      integer(c_int), intent(in) :: c_key_geovals
      type(c_ptr), value, intent(in) :: c_obsspace

      type(ufo_geovals),    pointer :: geovals

      call ufo_geovals_registry%get(c_key_geovals,geovals)

      call self%settraj(geovals, c_obsspace)
    end subroutine opr_settraj_

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

    subroutine opr_simobs_tl_(self, c_key_geovals, c_obsspace, c_hofx)
      implicit none

      class(ufo_basis_tlad), intent(in) :: self
      integer(c_int), intent(in) :: c_key_geovals
      real(c_double), intent(inout) :: c_hofx(:)
      type(c_ptr), value, intent(in) :: c_obsspace

      type(ufo_geovals),    pointer :: geovals

      call ufo_geovals_registry%get(c_key_geovals,geovals)

      call self%simobs_tl(geovals, c_hofx, c_obsspace)
    end subroutine opr_simobs_tl_

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

    subroutine opr_simobs_ad_(self, c_key_geovals, c_obsspace, c_hofx)
      implicit none

      class(ufo_basis_tlad), intent(in) :: self
      integer(c_int), intent(in) :: c_key_geovals
      real(c_double), intent(in) :: c_hofx(:)
      type(c_ptr), value, intent(in) :: c_obsspace

      type(ufo_geovals),    pointer :: geovals

      call ufo_geovals_registry%get(c_key_geovals,geovals)

      call self%simobs_ad(geovals, c_hofx, c_obsspace)
    end subroutine opr_simobs_ad_

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

end module ufo_basis_tlad_mod