Test_FieldArithmetic.pf Source File

#include "MAPL_Generic.h"

module Test_FieldArithmetic

   use field_utils_setup
   use MAPL_FieldUnaryFunctions
   use MAPL_FieldBinaryOperations
   use MAPL_FieldUtilities
   use MAPL_FieldPointerUtilities
   use ESMF
   use pfunit
   use MAPL_ExceptionHandling

   implicit none

   real(kind=ESMF_KIND_R4), parameter :: ADD_R4 = 100.0
   real(kind=ESMF_KIND_R8), parameter :: ADD_R8 = 100.0

contains

   ! Making the fields should be done in the tests themselves so because
   ! of the npes argument.
   @Before
   subroutine set_up_data(this)
      class(MpiTestMethod), intent(inout) :: this

      integer :: status, rc

      real(kind=ESMF_KIND_R4), parameter :: ADD_R4 = 100.0
      real(kind=ESMF_KIND_R8), parameter :: ADD_R8 = 100.0
      real(kind=ESMF_KIND_R4), allocatable :: y4array(:,:)
      real(kind=ESMF_KIND_R8), allocatable :: y8array(:,:)

      type(ESMF_Info) :: infoh

      allocate(y4array, source=R4_ARRAY_DEFAULT)
      allocate(y8array, source=R8_ARRAY_DEFAULT)
      y4array = y4array + ADD_R4
      y8array = y8array + ADD_R8
      XR4 = mk_field(R4_ARRAY_DEFAULT, name = 'XR4', _RC)
      YR4 = mk_field(y4array, name = 'YR4', _RC)
      XR8 = mk_field(R8_ARRAY_DEFAULT, name = 'XR8', _RC)
      YR8 = mk_field(y8array, name = 'YR8', _RC)
      call ESMF_InfoGetFromHost(xr4,infoh,_RC)
      call ESMF_InfoSet(infoh,key="missing_value",value=undef,_RC)
      call ESMF_InfoGetFromHost(xr8,infoh,_RC)
      call ESMF_InfoSet(infoh,key="missing_value",value=undef,_RC)
      call ESMF_InfoGetFromHost(yr4,infoh,_RC)
      call ESMF_InfoSet(infoh,key="missing_value",value=undef,_RC)
      call ESMF_InfoGetFromHost(yr8,infoh,_RC)
      call ESMF_InfoSet(infoh,key="missing_value",value=undef,_RC)

   end subroutine set_up_data

   @after
   subroutine teardown(this)
      class(MpiTestMethod), intent(inout) :: this
   end subroutine teardown

   @Test(npes=[4])
   subroutine test_FieldAddR4(this)
      class(MpiTestMethod), intent(inout) :: this
      type(ESMF_Field) :: x
      type(ESMF_Field) :: y
      real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:), y_ptr(:,:)
      real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:)
      integer :: status, rc
      real(kind=ESMF_KIND_R4), allocatable :: y4array(:,:)

      allocate(y4array, source=R4_ARRAY_DEFAULT)
      x = mk_r4field(R4_ARRAY_DEFAULT, 'XR4', _RC)
      y = mk_r4field(y4array, 'YR4', _RC)
      call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)
      call ESMF_FieldGet(y , farrayPtr = y_ptr, _RC)

      x_ptr = 2.0
      y_ptr = 3.0
      result_array = x_ptr
      result_array = 5.0
      call FieldAdd(y, x, y, _RC)
      @assertEqual(y_ptr, result_array)

   end subroutine test_FieldAddR4

   @Test(npes=[4])
   subroutine test_FieldAddR4_missing(this)
      class(MpiTestMethod), intent(inout) :: this
      type(ESMF_Field) :: x
      type(ESMF_Field) :: y
      real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:), y_ptr(:,:)
      real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:)
      integer :: status, rc

      x = XR4
      y = YR4
      call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)
      call ESMF_FieldGet(y , farrayPtr = y_ptr, _RC)

      x_ptr = reshape(source=[2.0,2.0,2.0,undef],shape=[2,2])
      y_ptr = reshape(source=[undef,3.0,3.0,undef],shape=[2,2])
      result_array = x_ptr
      result_array = reshape(source=[undef,5.0,5.0,undef],shape=[2,2])
      call FieldAdd(y, x, y, _RC)
      @assertEqual(y_ptr, result_array)
   end subroutine test_FieldAddR4_missing

   @Test(npes=[4])
   subroutine test_FieldAddR8(this)
      class(MpiTestMethod), intent(inout) :: this
      type(ESMF_Field) :: x
      type(ESMF_Field) :: y
      real(kind=ESMF_KIND_R8), pointer :: x_ptr(:,:), y_ptr(:,:)
      real(kind=ESMF_KIND_R8), allocatable :: result_array(:,:)
      integer :: status, rc
      real(kind=ESMF_KIND_R8), allocatable :: y8array(:,:)

      allocate(y8array, source=R8_ARRAY_DEFAULT)
      x = mk_r8field(R8_ARRAY_DEFAULT, 'XR8', _RC)
      y = mk_r8field(y8array, 'YR8', _RC)
      call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)
      call ESMF_FieldGet(y , farrayPtr = y_ptr, _RC)

      x_ptr = 2.d0
      y_ptr = 3.d0
      result_array = x_ptr
      result_array = 5.d0
      call FieldAdd(y, x, y, _RC)
      @assertEqual(y_ptr, result_array)
   end subroutine test_FieldAddR8

   @Test(npes=[4])
   subroutine test_FieldPowR4(this)
      class(MpiTestMethod), intent(inout) :: this
      type(ESMF_Field) :: x
      real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:)
      real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:)
      integer :: status, rc
      real :: expo

      x = XR4
      call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)

      x_ptr = 2.0
      expo = 4.0
      result_array = x_ptr
      result_array = 2.0**expo
      call FieldPow(x, x, expo, _RC)
      @assertEqual(x_ptr, result_array)
   end subroutine test_FieldPowR4

   @Test(npes=[4])
   subroutine test_FieldPowR8(this)
      class(MpiTestMethod), intent(inout) :: this
      type(ESMF_Field) :: x
      real(kind=ESMF_KIND_R8), pointer :: x_ptr(:,:)
      real(kind=ESMF_KIND_R8), allocatable :: result_array(:,:)
      integer :: status, rc
      real :: expo

      x = XR8
      call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)

      x_ptr = 2.d0
      expo = 4.0
      result_array = x_ptr
      result_array = 2.d0**expo
      call FieldPow(x, x, expo, _RC)
      @assertEqual(x_ptr, result_array)
   end subroutine test_FieldPowR8

   @Test(npes=[4])
   subroutine test_FieldSinR4(this)
      class(MpiTestMethod), intent(inout) :: this
      type(ESMF_Field) :: x
      real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:)
      real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:)
      integer :: status, rc

      x = XR4
      call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)

      x_ptr = 2.0
      result_array = x_ptr
      result_array = sin(2.0)
      call FieldSin(x, x, _RC)
      @assertEqual(x_ptr, result_array)
   end subroutine test_FieldSinR4

   @Test(npes=[4])
   subroutine test_FieldNegR4(this)
      class(MpiTestMethod), intent(inout) :: this
      type(ESMF_Field) :: x
      real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:)
      real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:)
      integer :: status, rc

      x = XR4
      call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)

      x_ptr = 2.0
      result_array = x_ptr
      result_array = -2.0
      call FieldNegate(x, _RC)
      @assertEqual(x_ptr, result_array)
   end subroutine test_FieldNegR4

end module Test_FieldArithmetic