Skip to content

Commit

Permalink
Add quiet nan and signaling nan options to FieldFill. (#133)
Browse files Browse the repository at this point in the history 
* Add unit test for NaN in ESMF_FieldRegridUTest.F90
* Fix macro warning in ESMF_FieldRegridUTest.F90
  • Loading branch information
@danrosen25
danrosen25 authored May 15, 2023
1 parent c92093e commit 013f236
Show file tree
Hide file tree
Showing 2 changed files with 596 additions and 19 deletions.
134 changes: 132 additions & 2 deletions src/Infrastructure/Field/src/ESMF_FieldGather.cppF90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,8 @@ module ESMF_FieldGatherMod
use ESMF_FieldMod
use ESMF_FieldGetMod
use ESMF_ArrayMod
use, intrinsic :: ieee_arithmetic, only: ieee_value, ieee_support_nan, &
ieee_quiet_nan, ieee_signaling_nan
implicit none
private
!------------------------------------------------------------------------------
Expand Down Expand Up @@ -114,8 +116,8 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
! \item[field]
! The {\tt ESMF\_Field} object to fill with data.
! \item[{[dataFillScheme]}]
! The fill scheme. The available options are "sincos", "one", "const", and
! "random". Defaults to "sincos".
! The fill scheme. The available options are "sincos", "one", "const",
! "random", "nan", and "snan". Defaults to "sincos".
! \item[{[const1]}]
! Constant of real type. Defaults to 0.
! \item[{[member]}]
Expand Down Expand Up @@ -181,6 +183,8 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
real(ESMF_KIND_R8), pointer :: coord1PtrR8D3(:,:,:)
real(ESMF_KIND_R8), pointer :: coord2PtrR8D3(:,:,:)
real(ESMF_KIND_R8), pointer :: coord3PtrR8D3(:,:,:)
real(ESMF_KIND_R8) :: nanR8
real(ESMF_KIND_R4) :: nanR4
integer :: i, j, k
integer :: numOwnedPoints

Expand Down Expand Up @@ -963,6 +967,132 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
dataPtrR4D3 = 1._ESMF_KIND_R4
endif
enddo
else if (trim(l_dataFillScheme)=="nan") then
if (typekind==ESMF_TYPEKIND_R8 .and. ieee_support_nan(nanR8)) then
nanR8 = ieee_value(nanR8, ieee_quiet_nan)
elseif (typekind==ESMF_TYPEKIND_R4 .and. ieee_support_nan(nanR4)) then
nanR4 = ieee_value(nanR4, ieee_quiet_nan)
else
call ESMF_LogSetError(ESMF_RC_ARG_BAD, &
msg="Quiet NaN is unsupported.", &
ESMF_CONTEXT, &
rcToReturn=rc)
return ! bail out
endif
do lde=0, ldeCount-1
if (typekind==ESMF_TYPEKIND_R8 .and. rank==1) then
! 1D all qnan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR8D1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR8D1 = nanR8
elseif (typekind==ESMF_TYPEKIND_R4 .and. rank==1) then
! 1D all qnan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR4D1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR4D1 = nanR4
elseif (typekind==ESMF_TYPEKIND_R8 .and. rank==2) then
! 2D all qnan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR8D2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR8D2 = nanR8
elseif (typekind==ESMF_TYPEKIND_R4 .and. rank==2) then
! 2D all qnan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR4D2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR4D2 = nanR4
elseif (typekind==ESMF_TYPEKIND_R8 .and. rank==3) then
! 3D all qnan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR8D3, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR8D3 = nanR8
elseif (typekind==ESMF_TYPEKIND_R4 .and. rank==3) then
! 3D all qnan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR4D3, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR4D3 = nanR4
endif
enddo
else if (trim(l_dataFillScheme)=="snan") then
if (typekind==ESMF_TYPEKIND_R8 .and. ieee_support_nan(nanR8)) then
nanR8 = ieee_value(nanR8, ieee_signaling_nan)
elseif (typekind==ESMF_TYPEKIND_R4 .and. ieee_support_nan(nanR4)) then
nanR4 = ieee_value(nanR4, ieee_signaling_nan)
else
call ESMF_LogSetError(ESMF_RC_ARG_BAD, &
msg="Signaling NaN is unsupported", &
ESMF_CONTEXT, &
rcToReturn=rc)
return ! bail out
endif
do lde=0, ldeCount-1
if (typekind==ESMF_TYPEKIND_R8 .and. rank==1) then
! 1D all snan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR8D1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR8D1 = nanR8
elseif (typekind==ESMF_TYPEKIND_R4 .and. rank==1) then
! 1D all snan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR4D1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR4D1 = nanR4
elseif (typekind==ESMF_TYPEKIND_R8 .and. rank==2) then
! 2D all snan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR8D2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR8D2 = nanR8
elseif (typekind==ESMF_TYPEKIND_R4 .and. rank==2) then
! 2D all snan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR4D2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR4D2 = nanR4
elseif (typekind==ESMF_TYPEKIND_R8 .and. rank==3) then
! 3D all snan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR8D3, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR8D3 = nanR8
elseif (typekind==ESMF_TYPEKIND_R4 .and. rank==3) then
! 3D all snan.
call ESMF_FieldGet(field, localDe=lde, farrayPtr=dataPtrR4D3, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) &
return ! bail out
! initialize the entire array
dataPtrR4D3 = nanR4
endif
enddo
else if (trim(l_dataFillScheme)=="const") then
do lde=0, ldeCount-1
if (typekind==ESMF_TYPEKIND_R8 .and. rank==1) then
Expand Down
Loading

0 comments on commit 013f236

Please sign in to comment.