MAPL_TransposeRegridder.F90 Source File

#include "MAPL_Generic.h"

module MAPL_TransposeRegridderMod
  use MAPL_AbstractRegridderMod
  use mapl_KeywordEnforcerMod
  use mapl_RegridderSpec
  use mapl_RegridMethods
  use mapl_ErrorHandlingMod
  use, intrinsic :: iso_fortran_env, only: REAL32, REAL64
  use ESMF
  implicit none
  private

  public :: TransposeRegridder

  type, extends(AbstractRegridder) :: TransposeRegridder
     class (AbstractRegridder), pointer :: reference
  contains
      procedure :: initialize_subclass
      procedure :: regrid_scalar_2d_real32
      procedure :: regrid_scalar_2d_real64
      procedure :: regrid_scalar_3d_real32
      procedure :: regrid_scalar_3d_real64

      procedure :: regrid_vector_2d_real32
      procedure :: regrid_vector_2d_real64
      procedure :: regrid_vector_3d_real32
      procedure :: regrid_vector_3d_real64

      procedure :: regrid_esmf_fields_scalar
      procedure :: regrid_esmf_fields_vector

      procedure :: transpose_regrid_scalar_2d_real32
      procedure :: transpose_regrid_scalar_2d_real64
      procedure :: transpose_regrid_scalar_3d_real32
      procedure :: transpose_regrid_scalar_3d_real64

      procedure :: transpose_regrid_vector_2d_real32
      procedure :: transpose_regrid_vector_2d_real64
      procedure :: transpose_regrid_vector_3d_real32
      procedure :: transpose_regrid_vector_3d_real64

      procedure :: transpose_regrid_esmf_fields_scalar
      procedure :: transpose_regrid_esmf_fields_vector

      procedure :: get_spec
      procedure :: isTranspose
   end type TransposeRegridder

   interface TransposeRegridder
      module procedure new_TransposeRegridder
   end interface TransposeRegridder

   character(len=*), parameter :: MOD_NAME = 'MAPL_AbstractRegridder::'

contains

  function new_TransposeRegridder(reference) result(regridder)
     type (TransposeRegridder) :: regridder
     class (AbstractRegridder), target, intent(in) :: reference

     regridder%reference => reference

   end function new_TransposeRegridder


   subroutine initialize_subclass(this, unusable, rc)
     use MAPL_KeywordEnforcerMod
     class (TransposeRegridder), intent(inout) :: this
     class (KeywordEnforcer), optional, intent(in) :: unusable
     integer, optional, intent(out) :: rc

     _UNUSED_DUMMY(this)
     _UNUSED_DUMMY(unusable)

     ! This is a wrapper class and should not be directly
     ! initialized.
     _RETURN(_FAILURE)
   end subroutine initialize_subclass
         



   subroutine regrid_scalar_2d_real32(this, q_in, q_out, rc)
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL32), intent(in) :: q_in(:,:)
      real(kind=REAL32), intent(out) :: q_out(:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_2d_real32'

      integer :: status
      call this%reference%transpose_regrid(q_in, q_out, rc=status)
      _RETURN(status)

   end subroutine regrid_scalar_2d_real32


   subroutine regrid_scalar_2d_real64(this, q_in, q_out, rc)
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL64), intent(in) :: q_in(:,:)
      real(kind=REAL64), intent(out) :: q_out(:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_2d_real64'

      integer :: status
      call this%reference%transpose_regrid(q_in, q_out, rc=status)
      _RETURN(status)

   end subroutine regrid_scalar_2d_real64


   subroutine regrid_scalar_3d_real32(this, q_in, q_out, rc)
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL32), intent(in) :: q_in(:,:,:)
      real(kind=REAL32), intent(out) :: q_out(:,:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_3d_real32'

      integer :: status
      call this%reference%transpose_regrid(q_in, q_out, rc=status)
      _RETURN(status)

   end subroutine regrid_scalar_3d_real32


   subroutine regrid_scalar_3d_real64(this, q_in, q_out, rc)
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL64), intent(in) :: q_in(:,:,:)
      real(kind=REAL64), intent(out) :: q_out(:,:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_3d_real64'

      integer :: status
      call this%reference%transpose_regrid(q_in, q_out, rc=status)
      _RETURN(status)

   end subroutine regrid_scalar_3d_real64


   subroutine regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rotate, rc)
      use, intrinsic :: iso_fortran_env, only: REAL32
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL32), intent(in) :: u_in(:,:)
      real(kind=REAL32), intent(in) :: v_in(:,:)
      real(kind=REAL32), intent(out) :: u_out(:,:)
      real(kind=REAL32), intent(out) :: v_out(:,:)
      logical, optional, intent(in) :: rotate
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_2d_real32'

      integer :: status

      _UNUSED_DUMMY(rotate)

      call this%reference%transpose_regrid(u_in, v_in, u_out, v_out, rc=status)
      _RETURN(status)

   end subroutine regrid_vector_2d_real32


   subroutine regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rotate, rc)
      use, intrinsic :: iso_fortran_env, only: REAL64
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL64), intent(in) :: u_in(:,:)
      real(kind=REAL64), intent(in) :: v_in(:,:)
      real(kind=REAL64), intent(out) :: u_out(:,:)
      real(kind=REAL64), intent(out) :: v_out(:,:)
      logical, optional, intent(in) :: rotate
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_2d_real64'

      integer :: status

      _UNUSED_DUMMY(rotate)

      call this%reference%transpose_regrid(u_in, v_in, u_out, v_out, rc=status)
      _RETURN(status)

   end subroutine regrid_vector_2d_real64

   subroutine regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rotate, rc)
      use, intrinsic :: iso_fortran_env, only: REAL32
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL32), intent(in) :: u_in(:,:,:)
      real(kind=REAL32), intent(in) :: v_in(:,:,:)
      real(kind=REAL32), intent(out) :: u_out(:,:,:)
      real(kind=REAL32), intent(out) :: v_out(:,:,:)
      logical, optional, intent(in) :: rotate
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real32'

      integer :: status

      _UNUSED_DUMMY(rotate)

      call this%reference%transpose_regrid(u_in, v_in, u_out, v_out, rotate=rotate, rc=status)
      _RETURN(status)

   end subroutine regrid_vector_3d_real32


   subroutine regrid_vector_3d_real64(this, u_in, v_in, u_out, v_out, rc)
      use, intrinsic :: iso_fortran_env, only: REAL64
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL64), intent(in) :: u_in(:,:,:)
      real(kind=REAL64), intent(in) :: v_in(:,:,:)
      real(kind=REAL64), intent(out) :: u_out(:,:,:)
      real(kind=REAL64), intent(out) :: v_out(:,:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real64'

      integer :: status
      call this%reference%transpose_regrid(u_in, v_in, u_out, v_out, rc=status)
      _RETURN(status)

   end subroutine regrid_vector_3d_real64


   subroutine regrid_esmf_fields_scalar(this, f_in, f_out, rc)
      use esmf, only: ESMF_TypeKind_Flag
      use esmf, only: ESMF_TYPEKIND_R4
      use esmf, only: ESMF_TYPEKIND_R8
      use esmf, only: ESMF_Field
      use esmf, only: ESMF_FieldGet
      class (TransposeRegridder), intent(in) :: this
      type (ESMF_Field), intent(in) :: f_in
      type (ESMF_Field), intent(in) :: f_out
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_esmf_fields'

      integer :: status
      call this%reference%transpose_regrid(f_in, f_out, rc=status)
      _RETURN(status)
      
   end subroutine regrid_esmf_fields_scalar


   subroutine regrid_esmf_fields_vector(this, f_in, f_out, rc)
      use esmf, only: ESMF_TypeKind_Flag
      use esmf, only: ESMF_TYPEKIND_R4
      use esmf, only: ESMF_TYPEKIND_R8
      use esmf, only: ESMF_Field
      use esmf, only: ESMF_FieldGet
      integer, parameter :: NUM_DIM = 2
      class (TransposeRegridder), intent(in) :: this
      type (ESMF_Field), intent(in) :: f_in(NUM_DIM)
      type (ESMF_Field), intent(in) :: f_out(NUM_DIM)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'regrid_esmf_fields'

      integer :: status
      call this%reference%transpose_regrid(f_in, f_out, rc=status)
      _RETURN(status)

   end subroutine regrid_esmf_fields_vector


   ! Begin - transpose interfaces
   
   subroutine transpose_regrid_scalar_2d_real32(this, q_in, q_out, rc)
      use, intrinsic :: iso_fortran_env, only: REAL32
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL32), intent(in) :: q_in(:,:)
      real(kind=REAL32), intent(out) :: q_out(:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_2d_real32'

      integer :: status
      call this%reference%regrid(q_in, q_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_scalar_2d_real32


   subroutine transpose_regrid_scalar_2d_real64(this, q_in, q_out, rc)
      use, intrinsic :: iso_fortran_env, only: REAL64
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL64), intent(in) :: q_in(:,:)
      real(kind=REAL64), intent(out) :: q_out(:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_2d_real64'

      integer :: status
      call this%reference%regrid(q_in, q_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_scalar_2d_real64

   
   subroutine transpose_regrid_scalar_3d_real32(this, q_in, q_out, rc)
      use, intrinsic :: iso_fortran_env, only: REAL32
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL32), intent(in) :: q_in(:,:,:)
      real(kind=REAL32), intent(out) :: q_out(:,:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_3d_real32'

      integer :: status
      call this%reference%regrid(q_in, q_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_scalar_3d_real32


   subroutine transpose_regrid_scalar_3d_real64(this, q_in, q_out, rc)
      use, intrinsic :: iso_fortran_env, only: REAL64
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL64), intent(in) :: q_in(:,:,:)
      real(kind=REAL64), intent(out) :: q_out(:,:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_3d_real64'

      integer :: status
      call this%reference%regrid(q_in, q_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_scalar_3d_real64

   
   subroutine transpose_regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rotate, rc)
      use, intrinsic :: iso_fortran_env, only: REAL32
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL32), intent(in) :: u_in(:,:)
      real(kind=REAL32), intent(in) :: v_in(:,:)
      real(kind=REAL32), intent(out) :: u_out(:,:)
      real(kind=REAL32), intent(out) :: v_out(:,:)
      logical, optional, intent(in) :: rotate
      integer, optional, intent(out) :: rc

      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_2d_real32'

      integer :: status

      _UNUSED_DUMMY(rotate)

      call this%reference%regrid(u_in, v_in, u_out, v_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_vector_2d_real32


   subroutine transpose_regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rotate, rc)
      use, intrinsic :: iso_fortran_env, only: REAL64
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL64), intent(in) :: u_in(:,:)
      real(kind=REAL64), intent(in) :: v_in(:,:)
      real(kind=REAL64), intent(out) :: u_out(:,:)
      real(kind=REAL64), intent(out) :: v_out(:,:)
      logical, optional, intent(in) :: rotate
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_2d_real64'

      integer :: status

      _UNUSED_DUMMY(rotate)

      call this%reference%regrid(u_in, v_in, u_out, v_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_vector_2d_real64


   subroutine transpose_regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rotate, rc)
      use, intrinsic :: iso_fortran_env, only: REAL32
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL32), intent(in) :: u_in(:,:,:)
      real(kind=REAL32), intent(in) :: v_in(:,:,:)
      real(kind=REAL32), intent(out) :: u_out(:,:,:)
      real(kind=REAL32), intent(out) :: v_out(:,:,:)
      logical, optional, intent(in) :: rotate
      integer, optional, intent(out) :: rc

      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_3d_real32'

      integer :: status

      _UNUSED_DUMMY(rotate)

      call this%reference%regrid(u_in, v_in, u_out, v_out, rotate=rotate, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_vector_3d_real32


   subroutine transpose_regrid_vector_3d_real64(this, u_in, v_in, u_out, v_out, rc)
      use, intrinsic :: iso_fortran_env, only: REAL64
      class (TransposeRegridder), intent(in) :: this
      real(kind=REAL64), intent(in) :: u_in(:,:,:)
      real(kind=REAL64), intent(in) :: v_in(:,:,:)
      real(kind=REAL64), intent(out) :: u_out(:,:,:)
      real(kind=REAL64), intent(out) :: v_out(:,:,:)
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_3d_real64'

      integer :: status
      call this%reference%regrid(u_in, v_in, u_out, v_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_vector_3d_real64


   subroutine transpose_regrid_esmf_fields_scalar(this, f_in, f_out, rc)
      use esmf, only: ESMF_TypeKind_Flag
      use esmf, only: ESMF_TYPEKIND_R4
      use esmf, only: ESMF_TYPEKIND_R8
      use esmf, only: ESMF_Field
      use esmf, only: ESMF_FieldGet
      class (TransposeRegridder), intent(in) :: this
      type (ESMF_Field), intent(in) :: f_in
      type (ESMF_Field), intent(in) :: f_out
      integer, optional, intent(out) :: rc
      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_esmf_fields'

      integer :: status
      call this%reference%regrid(f_in, f_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_esmf_fields_scalar


   subroutine transpose_regrid_esmf_fields_vector(this, f_in, f_out, rc)
      use esmf, only: ESMF_TypeKind_Flag
      use esmf, only: ESMF_TYPEKIND_R4
      use esmf, only: ESMF_TYPEKIND_R8
      use esmf, only: ESMF_Field
      use esmf, only: ESMF_FieldGet
      integer, parameter :: NUM_DIM = 2
      class (TransposeRegridder), intent(in) :: this
      type (ESMF_Field), intent(in) :: f_in(NUM_DIM)
      type (ESMF_Field), intent(in) :: f_out(NUM_DIM)
      integer, optional, intent(out) :: rc
      
      character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_esmf_fields'

      integer :: status
      call this%reference%regrid(f_in, f_out, rc=status)
      _RETURN(status)

   end subroutine transpose_regrid_esmf_fields_vector

   function get_spec(this) result(spec)
      type (RegridderSpec) :: spec
      class (TransposeRegridder), intent(in) :: this
      spec = this%reference%get_spec()
   end function get_spec

   function isTranspose(this) result(amTranspose)
      logical :: amTranspose
      class (TransposeRegridder), intent(in) :: this
      _UNUSED_DUMMY(this)
      amTranspose = .true.
   end function isTranspose
  
end module MAPL_TransposeRegridderMod