program ESMF_FieldIOUTest
!------------------------------------------------------------------------------
#include "ESMF.h"
!==============================================================================
!BOP
! !PROGRAM: ESMF_FieldIOUTest - Tests FieldWrite()
!
! !DESCRIPTION:
!
!-----------------------------------------------------------------------------
! !USES:
use ESMF_TestMod ! test methods
use ESMF
#if defined ESMF_NETCDF
use netcdf
#endif
implicit none
!-------------------------------------------------------------------------
!=========================================================================
! individual test failure message
character(ESMF_MAXSTR) :: failMsg
character(ESMF_MAXSTR) :: name
! local variables
type(ESMF_VM):: vm
type(ESMF_ArraySpec):: arrayspec, arrayspec_nd
type(ESMF_Field) :: field_w, field_r, field_t, field_s, field_tr, field_sr, field
type(ESMF_Field) :: field_w_nohalo, field_multi
type(ESMF_Field) :: field_gw, field_gr, field_gr2, field_gr3
type(ESMF_Field) :: field_r2de, field_w2de
type(ESMF_Field) :: field_md
real(ESMF_KIND_R8), pointer :: Farray_w(:,:) => null (), Farray_r(:,:) => null ()
real(ESMF_KIND_R8), pointer :: Farray_tw(:,:) => null (), Farray_sw(:,:) => null ()
real(ESMF_KIND_R8), pointer :: Farray_tr(:,:,:) => null (), Farray_sr(:,:,:) => null ()
real(ESMF_KIND_R4), pointer :: fptr(:,:) => null ()
real(ESMF_KIND_R8), pointer :: t_ptr(:,:,:) => null (), t_ptr2(:,:,:) => null ()
real(ESMF_KIND_R8), pointer :: Farray_md(:,:) => null ()
! Note:
! field_w---Farray_w; field_r---Farray_r;
! field_t---Farray_tw; field_tr---Farray_tr
! field_s---Farray_sw; field_sr---Farray_sr
type(ESMF_Grid) :: grid, grid_g, grid_2DE, grid_gblind, grid_md
type(ESMF_Field) :: elem_field
type(ESMF_DistGrid) :: elem_dg
type(ESMF_Mesh) :: elem_mesh
type(ESMF_Field) :: field_att, field_ugd_att
type(ESMF_Field) :: field_ug, field_ug2
type(ESMF_Field) :: field_ug_w2DE, field_ug_r2DE
type(ESMF_DistGrid) :: dg_debl
type(ESMF_DistGridConnection), allocatable :: connectionList(:)
type(ESMF_Grid) :: grid_debl
type(ESMF_Field) :: field_debl
integer, allocatable :: deBlockList(:,:,:)
integer :: idim_size, jdim_size
real(ESMF_KIND_R8), pointer :: Farray_DE0_w(:,:) => null (), Farray_DE0_r(:,:) => null ()
real(ESMF_KIND_R8), pointer :: Farray_DE1_w(:,:) => null (), Farray_DE1_r(:,:) => null ()
real(ESMF_KIND_R8), pointer :: Farray_ug_DE0_w(:,:,:) => null(), Farray_ug_DE0_r(:,:,:) => null()
real(ESMF_KIND_R8), pointer :: Farray_ug_DE1_w(:,:,:) => null(), Farray_ug_DE1_r(:,:,:) => null()
integer :: rc, ncstat, ncid
integer, allocatable :: computationalLBound(:),computationalUBound(:)
integer, allocatable :: exclusiveLBound(:), exclusiveUBound(:)
integer, allocatable :: arbseqlist(:)
integer :: localPet, petCount, tlb(2), tub(2)
integer :: elem_tlb(1), elem_tub(1), elem_tc(1)
integer :: tlb3(3), tub3(3), tlb4(3), tub4(3)
integer :: i, j, t, endtime, k
logical :: failed, allEqual
real(ESMF_KIND_R8) :: Maxvalue, diff
#if defined ESMF_NETCDF
integer :: dim1id, dim2id, dim1len, dim2len, varid, ndims
integer, dimension(nf90_max_var_dims) :: dimids
real(ESMF_KIND_R8), pointer :: ncdata(:,:) => null()
#endif
character(16), parameter :: apConv = 'Attribute_IO'
character(16), parameter :: apPurp = 'attributes'
#if !defined (ESMF_PNETCDF)
character(*), parameter :: attrNames(6) = (/ &
"long_name ", &
"units ", &
"valid_range ", &
"missing_value", &
"_FillValue ", &
"cell_methods " &
/)
#else
character(*), parameter :: attrNames(5) = (/ &
"long_name ", &
"units ", &
"valid_range ", &
"missing_value", &
"cell_methods " &
/)
#endif
! cumulative result: count failures; no failures equals "all pass"
integer :: result = 0
integer :: countfail = 0
! Changing status for writing file in loop
type(ESMF_FileStatus_Flag) :: statusFlag = ESMF_FILESTATUS_UNKNOWN
!-----------------------------------------------------------------------------
call ESMF_TestStart(ESMF_SRCLINE, rc=rc) ! calls ESMF_Initialize() internally
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (.not. ESMF_TestMinPETs(4, ESMF_SRCLINE)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
!-----------------------------------------------------------------------------
! Set up
! *******
call ESMF_VMGetGlobal(vm, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create a ArraySpec
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, &
rank=2, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Array Spec Set "
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verifying that a Grid can be created
grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/10,20/), &
regDecomp=(/2,2/), gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,0/), &
name="landgrid", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Creating a Grid to use in Field Tests"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Allocate array
! allocate(Farray_w(5,10)) ! it is done automatically with halo
! allocate(Farray_tw(5,10)) ! it is done automatically with halo
allocate(Farray_sw(5,10)) ! do it by hand for without halo case
allocate(exclusiveLBound(2)) ! dimCount=2
allocate(exclusiveUBound(2)) ! dimCount=2
allocate(computationalLBound(2))
allocate(computationalUBound(2))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_w=ESMF_FieldCreate(grid, arrayspec=arrayspec, &
totalLWidth=(/1,1/), totalUWidth=(/1,2/), &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a field from grid and fortran dummy array"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Get Array pointer from Field
call ESMF_FieldGet(field_w, localDe=0, farrayPtr=Farray_w, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get Farray_w from field"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!print '(a,2(a,i0.1,a,i0.1),a)', 'field_w Farray_w bounds = ', &
! '(', lbound (Farray_w,1), ':', ubound (Farray_w,1), &
! ',', lbound (Farray_w,2), ':', ubound (Farray_w,2),')'
!print '(a,2(a,i0.1,a,i0.1),a)', 'field_w exclusive bounds = ', &
! '(', exclusiveLBound(1), ':', exclusiveUBound(1), &
! ',', exclusiveLBound(2), ':', exclusiveUBound(2),')'
! Set values of fortran array
Farray_w = 0.02 ! halo points will have value 0.02
do j=exclusiveLBound(2),exclusiveUBound(2)
do i=exclusiveLBound(1),exclusiveUBound(1)
Farray_w(i,j) = sin(dble(i)/5.0)*tan(dble(j)/5.0)
enddo
enddo
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Write Fortran array in Field
call ESMF_FieldWrite(field_w, fileName="field.nc", &
iofmt=ESMF_IOFMT_NETCDF_64BIT_OFFSET, &
overwrite=.true., &
status=ESMF_FILESTATUS_UNKNOWN, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Fortran array in Field"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field without halo region
field_w_nohalo=ESMF_FieldCreate(grid, arrayspec=arrayspec, &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a field from grid and fortran dummy array without halo"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Get Array pointer from nohalo Field
call ESMF_FieldGet(field_w_nohalo, localDe=0, farrayPtr=Farray_w, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get Farray_w from nohalo field"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!print '(a,2(a,i0.1,a,i0.1),a)', 'field_w_nohalo Farray_w bounds = ', &
! '(', lbound (Farray_w,1), ':', ubound (Farray_w,1), &
! ',', lbound (Farray_w,2), ':', ubound (Farray_w,2),')'
!print '(a,2(a,i0.1,a,i0.1),a)', 'field_w_nohalo exclusive bounds = ', &
! '(', exclusiveLBound(1), ':', exclusiveUBound(1), &
! ',', exclusiveLBound(2), ':', exclusiveUBound(2),')'
! Set values of fortran array
do j=exclusiveLBound(2),exclusiveUBound(2)
do i=exclusiveLBound(1),exclusiveUBound(1)
Farray_w(i,j) = sin(i/5.0d0)*tan(j/5.0d0)
enddo
enddo
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Write Fortran array in nohalo Field
call ESMF_FieldWrite(field_w_nohalo, fileName="fieldNoHalo.nc", &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Fortran array in nohalo Field"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field without halo region
field_multi=ESMF_FieldCreate(grid, arrayspec=arrayspec, &
name="temperature2", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a field from grid and fortran dummy array without halo"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Write multiple Fields with same dimensions to a file
call ESMF_FieldWrite(field_w, fileName="field2.nc", rc=rc)
call ESMF_FieldWrite(field_multi, fileName="field2.nc", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write multiple Fields with same dimensions to a file"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!
! Test field metadata in output NetCDF files
!
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
grid_md = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/15,30/), &
regDecomp=(/2,2/), name="mygrid", indexflag=ESMF_INDEX_GLOBAL, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create grid for field metadata test"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create field with global indices"
write(failMsg, *) "Did not return ESMF_SUCCESS"
field_md = ESMF_FieldCreate(grid_md, arrayspec=arrayspec, &
name="bananas", indexflag=ESMF_INDEX_GLOBAL, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!NEX_UTest_Multi_Proc_Only
call ESMF_FieldGet(field_md, localDe=0, farrayPtr=Farray_md, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(name, *) "Get Farray_md from field"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!print '(a,2(a,i0.1,a,i0.1),a)', 'field_md Farray_md bounds = ', &
! '(', lbound (Farray_md,1), ':', ubound (Farray_md,1), &
! ',', lbound (Farray_md,2), ':', ubound (Farray_md,2),')'
!print '(a,2(a,i0.1,a,i0.1),a)', 'field_md exclusive bounds = ', &
! '(', exclusiveLBound(1), ':', exclusiveUBound(1), &
! ',', exclusiveLBound(2), ':', exclusiveUBound(2),')'
Farray_md = -1.0
do j = exclusiveLBound(2), exclusiveUBound(2)
do i = exclusiveLBound(1), exclusiveUBound(1)
Farray_md(i,j) = i*100 + j
enddo
enddo
!NEX_UTest_Multi_Proc_Only
call ESMF_FieldWrite(field_md, fileName="field_md.nc", &
iofmt=ESMF_IOFMT_NETCDF_64BIT_OFFSET, &
overwrite=.true., &
status=ESMF_FILESTATUS_UNKNOWN, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Field to NetCDF file"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF metadata - open file"
write(failMsg, *) "Failed to open netcdf file"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
ncstat = nf90_open("field_md.nc", NF90_NOWRITE, ncid)
call ESMF_Test((.not.ESMF_LogFoundNetCDFError(ncstat)), name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF metadata - check dim 1"
write(failMsg, *) "dim 1 not found"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
ncstat = nf90_inq_dimid(ncid, "bananas_dim001", dim1id)
call ESMF_Test((.not.ESMF_LogFoundNetCDFError(ncstat)), name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF metadata - check dim 1 len"
write(failMsg, *) "dim 1 has unexpected length"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
ncstat = nf90_inquire_dimension(ncid, dim1id, len=dim1len)
call ESMF_Test((dim1len==15), name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF metadata - check dim 2"
write(failMsg, *) "dim 2 not found"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
ncstat = nf90_inq_dimid(ncid, "bananas_dim002", dim2id)
call ESMF_Test((.not.ESMF_LogFoundNetCDFError(ncstat)), name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF metadata - check dim 2 len"
write(failMsg, *) "dim 2 has unexpected length"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
ncstat = nf90_inquire_dimension(ncid, dim2id, len=dim2len)
call ESMF_Test((dim2len==30), name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF metadata - variable exists"
write(failMsg, *) "failed to find variable"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
ncstat = nf90_inq_varid(ncid, "bananas", varid)
call ESMF_Test((.not.ESMF_LogFoundNetCDFError(ncstat)), name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF metadata - variable has expected dims"
write(failMsg, *) "unexpected dimensions for field"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
ncstat = nf90_inquire_variable(ncid, varid, ndims=ndims, dimids=dimids)
call ESMF_Test((.not.ESMF_LogFoundNetCDFError(ncstat) .and. ndims==2 .and. dimids(1)==dim1id .and. dimids(2)==dim2id), &
name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF data - check data for field"
write(failMsg, *) "unexpected data for field"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
allocate(ncdata(15,30))
ncstat = nf90_get_var(ncid, varid, ncdata)
if (ESMF_LogFoundNetCDFError(ncstat, file=ESMF_FILENAME, rcToReturn=rc)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
! reconstruct expected data
maxvalue = 0.0
do j = lbound(ncdata, 2), ubound(ncdata, 2)
do i = lbound(ncdata, 1), ubound(ncdata, 1)
!print *, "i, j = (", i, j, ") val = ", ncdata(i,j), " expected", i*100 + j
diff = abs(ncdata(i,j) - (i*100 + j))
if (maxvalue .le. diff) maxvalue = diff
enddo
enddo
deallocate(ncdata)
call ESMF_Test((maxvalue .lt. 1.e-14), name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!NEX_UTest_Multi_Proc_Only
write(name, *) "Confirm NetCDF data - close file"
write(failMsg, *) "error closing file"
#if (defined ESMF_PIO && (defined ESMF_NETCDF || defined ESMF_PNETCDF))
ncstat = nf90_close(ncid)
call ESMF_Test((.not.ESMF_LogFoundNetCDFError(ncstat)), &
name, failMsg, result, ESMF_SRCLINE)
#else
call ESMF_Test(.true., name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!
! Test multiple time slices that making use of NETCDF's unlimited dimension
!
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! ! Write data at time t on file, total number of time=endtime
endtime = 5
! The first time through, we need to replace these files
statusFlag = ESMF_FILESTATUS_REPLACE
countfail = 0
do t = 1, endtime
!------------------------------------------------------------------------
! Create Field with Halo
field_t=ESMF_FieldCreate(grid, arrayspec=arrayspec, &
totalLWidth=(/1,1/), totalUWidth=(/1,2/), &
name="temperature", rc=rc)
if(rc.ne.ESMF_SUCCESS) then
countfail = countfail + 1
exit
endif
!------------------------------------------------------------------------
! Get Info from Field with Halo
call ESMF_FieldGet(field_t, localDe=0, farrayPtr=Farray_tw, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
!------------------------------------------------------------------------
! Set values of fortran array with Halo
Farray_tw = 0.02 ! halo points will have value 0.02
do j=exclusiveLBound(2),exclusiveUBound(2)
do i=exclusiveLBound(1),exclusiveUBound(1)
! Farray_tw(i,j) = 100.0 + localpet
Farray_tw(i,j) = dble(t)*(sin(i/5.0d0)*tan(j/5.0d0))
enddo
enddo
!------------------------------------------------------------------------
! Write Fortran array in Field
! After two timesteps, test the auto-increment feature.
! Also, stop using the status flag after t = 3
select case (t)
case (1,2)
call ESMF_FieldWrite(field_t, fileName="field_time.nc", timeslice=t, &
status=statusFlag, overwrite=.true., rc=rc)
case (3)
call ESMF_FieldWrite(field_t, fileName="field_time.nc", &
status=statusFlag, overwrite=.true., rc=rc)
case (4:)
call ESMF_FieldWrite(field_t, fileName="field_time.nc", &
overwrite=.true., rc=rc)
end select
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
if(rc.ne.ESMF_SUCCESS) then
countfail = countfail + 1
endif
#else
if(rc.ne.ESMF_RC_LIB_NOT_PRESENT) then
countfail = countfail + 1
exit
endif
#endif
!------------------------------------------------------------------------
! Set values of fortran array for without halo case
do j=exclusiveLBound(2),exclusiveUBound(2)
do i=exclusiveLBound(1),exclusiveUBound(1)
Farray_sw(i,j) = dble(t)*(sin(dble(i)/5.0)*tan(dble(j)/5.0))
enddo
enddo
!------------------------------------------------------------------------
! Create Field without Halo
field_s=ESMF_FieldCreate(grid, farray=Farray_sw, &
indexflag=ESMF_INDEX_DELOCAL,name="temperature", rc=rc)
if(rc.ne.ESMF_SUCCESS) then
countfail = countfail + 1
exit
endif
!------------------------------------------------------------------------
! Write Fortran array in Field without halo
call ESMF_FieldWrite(field_s, fileName="fieldNoHalo_time.nc", timeslice=t, &
status=statusFlag, overwrite=.true., rc=rc)
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
if(rc.ne.ESMF_SUCCESS) then
countfail = countfail + 1
endif
#else
if(rc.ne.ESMF_RC_LIB_NOT_PRESENT) then
countfail = countfail + 1
exit
endif
#endif
! Next time through the loop, we expect the file to be there
statusFlag = ESMF_FILESTATUS_OLD
enddo ! t
! Loop of time is ended. Check for failure.
write(name, *) "Write Farray_tw at different time t in a loop"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_Test((countfail==0), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Test ESMF_FieldRead()
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create a ArraySpec
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, &
rank=2, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Array Spec Set "
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create a new Field
field_r = ESMF_FieldCreate(grid, arrayspec, indexflag=ESMF_INDEX_DELOCAL, &
name="temperature", rc=rc)
write(failMsg, *) ""
write(name, *) "Create new Field_r"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Read data to Object Field_r with non-existant file.
write(failMsg, *) ""
write(name, *) "Read data to object field_r with non-existant file"
call ESMF_FieldRead(field_r, fileName="xyzzy_field.nc", rc=rc)
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc/=ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Read data to Object Field_r
write(failMsg, *) ""
write(name, *) "Read data to object field_r"
call ESMF_FieldRead(field_r, fileName="field.nc", rc=rc)
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Obtain the Fortran pointer
call ESMF_FieldGet(field_r, localDe=0, farrayPtr=Farray_r, rc=rc)
write(failMsg, *) ""
write(name, *) "Point data to Fortran pointer Farray_r"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! ! Compare readin and the existing file
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
Maxvalue = 0.0
do j=exclusiveLBound(2),exclusiveUBound(2)
do i=exclusiveLBound(1),exclusiveUBound(1)
diff = abs(Farray_w(i,j) - Farray_r(i,j))
if (Maxvalue.le.diff) Maxvalue=diff
enddo
enddo
#else
Maxvalue = 1.0d0
#endif
write(name, *) "Compare readin data to the existing data"
write(failMsg, *) "Comparison failed"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
write(*,*)"Maximum Error (read-write) = ", Maxvalue
call ESMF_Test((Maxvalue .lt. 1.e-14), name, failMsg, result,ESMF_SRCLINE)
#else
write(failMsg, *) "Comparison did not fail as was expected"
call ESMF_Test((Maxvalue .gt. 1.e-14), name, failMsg, result,ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Read back the time slices of the field from file.
!------------------------------------------------------------------------
! Recall my Fortran array at time=t=... :
#ifdef ESMF_MPICH1
! For multi-PET with MPICH1 always first slice is pulled out by FieldRead()
t = 1
#else
t = 3
#endif
! Note that in exclusive region, Farray_tw and Farray_sw are identical.
! So for comparison purpose, just recall Farray_tw is enough.
Farray_tw = 0.02d0 ! halo points will have value 0.02
do j=exclusiveLBound(2),exclusiveUBound(2)
do i=exclusiveLBound(1),exclusiveUBound(1)
Farray_tw(i,j) = dble(t)*(sin(i/5.0d0)*tan(j/5.0d0))
enddo
enddo
! Compare Field with Halos
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create an empty new Field
field_tr = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, &
name="temperature", ungriddedLBound=(/1/), ungriddedUBound=(/t/), rc=rc)
write(failMsg, *) ""
write(name, *) "Create new Field_r"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Read data at time=t to Object Field_r with Halos
write(failMsg, *) ""
write(name, *) "Read data time=t to object field_r per slice"
call ESMF_FieldRead(field_tr, fileName="field_time.nc", timeslice=t, rc=rc)
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, &
failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Obtain the Fortran pointer
call ESMF_FieldGet(field_tr, localDe=0, farrayPtr=Farray_tr, rc=rc)
write(failMsg, *) ""
write(name, *) "Point data to Fortran pointer Farray_tr"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! ! Compare readin and the existing file
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
Maxvalue = 0.0
do j=exclusiveLBound(2),exclusiveUBound(2)
do i=exclusiveLBound(1),exclusiveUBound(1)
diff = abs(Farray_tw(i,j) - Farray_tr(i,j,t))
if (Maxvalue.le.diff) Maxvalue=diff
enddo
enddo
#else
Maxvalue = 1.0d0
#endif
write(name, *) "Compare readin data to the existing data"
write(failMsg, *) "Comparison failed"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
write(*,*)"Maximum Error with Halos (read-write) = ", Maxvalue
call ESMF_Test((Maxvalue .lt. 1.e-14), name, failMsg, result,ESMF_SRCLINE)
#else
write(failMsg, *) "Comparison did not fail as was expected"
call ESMF_Test((Maxvalue .gt. 1.e-14), name, failMsg, result,ESMF_SRCLINE)
#endif
! Compare fields without Halos
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create an empty new Field
field_sr = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, &
name="temperature", ungriddedLBound=(/1/), ungriddedUBound=(/t/), rc=rc)
write(failMsg, *) ""
write(name, *) "Create new Field_s for without Halo"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Read data at time=t to Object Field_r without Halos
write(failMsg, *) ""
write(name, *) "Read data time=t to object field_r per slice"
call ESMF_FieldRead(field_sr, fileName="fieldNoHalo_time.nc", timeslice=t, rc=rc)
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, &
failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Obtain the Fortran pointer
call ESMF_FieldGet(field_sr, localDe=0, farrayPtr=Farray_sr, rc=rc)
write(failMsg, *) ""
write(name, *) "Point data to Fortran pointer Farray_sr"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! ! Compare readin and the existing file
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
Maxvalue = 0.0
do j=exclusiveLBound(2),exclusiveUBound(2)
do i=exclusiveLBound(1),exclusiveUBound(1)
diff = abs(Farray_tw(i,j) - Farray_sr(i,j,t))
if (Maxvalue.le.diff) Maxvalue=diff
enddo
enddo
#else
Maxvalue = 1.0d0
#endif
write(name, *) "Compare readin data to the existing data"
write(failMsg, *) "Comparison failed"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
write(*,*)"Maximum Error without Halos (read-write) = ", Maxvalue
call ESMF_Test((Maxvalue .lt. 1.e-14), name, failMsg, result,ESMF_SRCLINE)
#else
write(failMsg, *) "Comparison did not fail as was expected"
call ESMF_Test((Maxvalue .gt. 1.e-14), name, failMsg, result,ESMF_SRCLINE)
#endif
deallocate (computationalLBound, computationalUBound)
deallocate (exclusiveLBound, exclusiveUBound)
deallocate (Farray_sw)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Destroy Grid"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_GridDestroy(grid, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Test Field with STAGGERLOC_EDGE1 specified
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
rc = ESMF_SUCCESS ! Initialize
write(name, *) "Write Field"
write(failMsg, *) "Did not return ESMF_SUCCESS"
grid = ESMF_GridCreateNoPeriDim(maxIndex=(/44, 8/), gridEdgeLWidth=(/0,0/), &
rc=rc)
if (ESMF_LogFoundError (rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=ESMF_FILENAME)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
field = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_R4, &
staggerLoc=ESMF_STAGGERLOC_EDGE1, name="velocity", &
totalLWidth=(/1,1/), totalUWidth=(/1,1/), rc=rc)
if (ESMF_LogFoundError (rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=ESMF_FILENAME)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldGet(field, farrayPtr=fptr, &
totalLBound=tlb, totalUBound=tub, &
rc=rc)
if (ESMF_LogFoundError (rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=ESMF_FILENAME)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (.not. associated (fptr)) rc = ESMF_RC_PTR_NOTALLOC
if (ESMF_LogFoundError (rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=ESMF_FILENAME)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
! print *, tlb, tub
! Replace file first time through
statusFlag = ESMF_FILESTATUS_REPLACE
do k = 1, 5
do i = tlb(1), tub(1)
do j = tlb(2), tub(2)
fptr(i,j) = ((i-1)*(tub(2)-tlb(2))+j)*(10**(k-1))
enddo
enddo
call ESMF_FieldWrite(field, fileName='halof.nc', timeslice=k, &
status=statusFlag, overwrite=.true., rc=rc)
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
if (ESMF_LogFoundError (rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, file=ESMF_FILENAME)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
#else
if (rc/=ESMF_RC_LIB_NOT_PRESENT) call ESMF_Finalize(endflag=ESMF_END_ABORT)
rc = ESMF_SUCCESS
#endif
! Next time through the loop, write to same file
statusFlag = ESMF_FILESTATUS_OLD
enddo
call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Destroy Grid"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_GridDestroy(grid, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! Test with ESMF_INDEX_GLOBAL
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Grid
grid_g = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/16,20/), &
regDecomp=(/2,2/), indexflag=ESMF_INDEX_GLOBAL, &
rc=rc)
write(failMsg, *) ""
write(name, *) "Create a gloablly indexed grid"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_gw=ESMF_FieldCreate(grid_g, arrayspec=arrayspec, &
indexflag=ESMF_INDEX_GLOBAL, &
name="temperature_g", rc=rc)
write(failMsg, *) ""
write(name, *) "Create a gloablly indexed field from grid and fortran dummy array"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Get Array pointer from Field
allocate(exclusiveLBound(2)) ! dimCount=2
allocate(exclusiveUBound(2)) ! dimCount=2
call ESMF_FieldGet(field_gw, localDe=0, farrayPtr=Farray_w, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get Farray_gw from field"
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Fill array and write
Farray_w = localPet ! Fill
call ESMF_FieldWrite(field_gw, fileName="field_globalindex.nc", &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write globally indexed Field"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_gr=ESMF_FieldCreate(grid_g, arrayspec=arrayspec, &
indexflag=ESMF_INDEX_GLOBAL, &
name="temperature_g", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a globally indexed field from grid and fortran dummy array"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! read array into Field.
call ESMF_FieldRead(field_gr, fileName="field_globalindex.nc", &
rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Read globally indexed Field data"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Get Array pointer from Field
call ESMF_FieldGet(field_gr, localDe=0, farrayPtr=Farray_r, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get Farray_gr from field"
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Compare read-in data with expected
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
rc = merge (ESMF_SUCCESS, ESMF_FAILURE, all (abs (Farray_r - real (localPet)) < 0.001d0))
#else
rc = ESMF_FAILURE
#endif
write(failMsg, *) "Failed comparison check"
write(name, *) "Compare read-in data with expected"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Comparison did not fail as was expected"
call ESMF_Test((rc==ESMF_FAILURE), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field with different name
field_gr2=ESMF_FieldCreate(grid_g, arrayspec=arrayspec, &
indexflag=ESMF_INDEX_GLOBAL, &
name="temperature_g2", rc=rc)
write(failMsg, *) ""
write(name, *) "Create a gloablly indexed field with different name"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Attempt to read array into Field with wrong field name.
call ESMF_FieldRead(field_gr2, fileName="field_globalindex.nc", &
rc=rc)
write(failMsg, *) "Did not fail"
write(name, *) "Read globally indexed Field data"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc/=ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Destroy globally indexed Grid"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_GridDestroy(grid_g, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Multiple DEs per PET tests
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verifying that a Grid can be created
grid_2DE = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/10,20/), &
regDecomp=(/8,1/), gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,0/), &
name="landgrid", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Creating a Grid with 2DEs/PET to use in Field Tests"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_w2DE=ESMF_FieldCreate(grid_2DE, arrayspec=arrayspec, &
totalLWidth=(/1,1/), totalUWidth=(/1,2/), &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a field from 2DE grid and fortran dummy array"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Get Array pointer from Field
call ESMF_FieldGet(field_w2DE, localDe=0, farrayPtr=Farray_DE0_w, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get and fill Farray_w from field DE 0"
Farray_DE0_w = 0.1d0
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Get Array pointer from Field
call ESMF_FieldGet(field_w2DE, localDe=1, farrayPtr=Farray_DE1_w, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get and fill Farray_w from field DE 1"
Farray_DE1_w = 1.1d0
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Write Fortran 2DE array in Field
call ESMF_FieldWrite(field_w2DE, fileName="field_2DE.nc", &
iofmt=ESMF_IOFMT_NETCDF, &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Fortran 2DE array in Field"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_r2DE=ESMF_FieldCreate(grid_2DE, arrayspec=arrayspec, &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a globally indexed field from grid and fortran dummy array"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! Make sure read-only files can be read.
call ESMF_VMBarrier (vm)
if (localPet == 0) then
call c_ESMC_UtilSystem ("chmod 444 field_2DE.nc", rc)
call c_ESMC_UtilSystem ("ls -l field_2DE.nc", rc)
end if
call ESMF_VMBarrier (vm)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! read array into Field.
call ESMF_FieldRead(field_r2DE, fileName="field_2DE.nc", &
rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Read 2DE Field Array data"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
! change permission back to read-write to avoid issues with test cleanup.
call ESMF_VMBarrier (vm)
if (localPet == 0) then
call c_ESMC_UtilSystem ("chmod 644 field_2DE.nc", rc)
call c_ESMC_UtilSystem ("ls -l field_2DE.nc", rc)
end if
call ESMF_VMBarrier (vm)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Get DE 0 Array pointer from Field
call ESMF_FieldGet(field_r2DE, localDe=0, farrayPtr=Farray_DE0_r, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get Farray_r from field DE 0"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! DE 0 Array comparison test
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
rc = merge (ESMF_SUCCESS, ESMF_FAILURE, all (abs (Farray_DE0_r - 0.1d0) < 0.0001d0))
#else
rc = ESMF_SUCCESS
#endif
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "DE 0 Array comparison test"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Get DE 1 Array pointer from Field
call ESMF_FieldGet(field_r2DE, localDe=1, farrayPtr=Farray_DE1_r, &
exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get Farray_r from field DE 1"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! DE 1 Array comparison test
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
rc = merge (ESMF_SUCCESS, ESMF_FAILURE, all (Farray_DE1_r == 1.1d0))
#else
rc = ESMF_SUCCESS
#endif
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "DE 1 Array comparison test"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Mesh Write test
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
allocate(arbseqlist(8))
do i = 1, 8
arbseqlist(i)=localPet+1+4*(i-1)
enddo
!print *, lpet, arbseqlist
elem_dg = ESMF_DistGridCreate(arbseqindexlist=arbseqlist, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a 1D arbitrarily distributed distgrid"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
elem_mesh = ESMF_MeshCreate(elem_dg, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a mesh on the 1D elemental distgrid"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
call ESMF_MeshGetFieldBounds(elem_mesh, &
totalLBound=elem_tlb, totalUBound=elem_tub, &
totalCount=elem_tc, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get Field Bounds based on elem_mesh"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
elem_field = ESMF_FieldCreate(elem_mesh, typekind=ESMF_TYPEKIND_R8, &
meshloc=ESMF_MESHLOC_ELEMENT, &
ungriddedLBound=(/1/), ungriddedUBound=(/10/), &
gridToFieldMap=(/2/), &
rc=rc)
write(failMsg, *) ""
write(name, *) "Create a Field on the 1D mesh"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate(arbseqlist)
#if 1
call ESMF_FieldPrint (elem_field)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
call ESMF_FieldWrite (elem_field, fileName='elem_mesh.nc', &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) ""
write(name, *) "Write a Field containing the 1D mesh"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
#endif
!------------------------------------------------------------------------
! Write with Attributes test
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verifying that a Grid can be created
grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/10,20/), &
regDecomp=(/2,2/), gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,0/), &
name="landgrid", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Creating a Grid to use in Field Attribute Tests"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create dimensions attribute package on Grid Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_AttributeAdd (grid, &
convention=apConv, purpose=apPurp, &
attrList=(/ ESMF_ATT_GRIDDED_DIM_LABELS /), rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Set dimension label values on Grid Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_AttributeSet (grid, &
name=ESMF_ATT_GRIDDED_DIM_LABELS, &
valueList=(/ "grid_x_axis", "grid_y_axis" /), &
convention=apConv, purpose=apPurp, &
rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_att=ESMF_FieldCreate(grid, arrayspec=arrayspec, &
totalLWidth=(/1,1/), totalUWidth=(/1,2/), &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a field for attribute package Test"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create attribute package for Field variable Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_AttributeAdd (field_att, &
convention=apConv, purpose=apPurp, &
attrList=attrNames, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Set attribute package values for Field variable Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
do, i=1, size (attrNames)
select case (attrNames(i))
case ("long_name")
call ESMF_AttributeSet (field_att, &
attrNames(i), valueList=(/ "temperature" /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
case ("units")
call ESMF_AttributeSet (field_att, &
attrNames(i), valueList=(/ "K" /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
case ("valid_range")
call ESMF_AttributeSet (field_att, &
attrNames(i), valueList=(/ 100.0, 350.0 /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
case ("missing_value")
call ESMF_AttributeSet (field_att, &
attrNames(i), valueList=(/ -1.e+10 /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
#if !defined (ESMF_PNETCDF)
case ("_FillValue")
call ESMF_AttributeSet (field_att, &
attrNames(i), valueList=(/ -1.e+10_ESMF_KIND_R8 /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
#endif
case ("cell_methods")
call ESMF_AttributeSet (field_att, &
attrNames(i), valueList=(/ "time: point" /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
case default
print *, 'unhandled case!'
rc = ESMF_FAILURE
exit
end select
end do
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!call ESMF_FieldPrint (field_att)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Write Fortran array in Field
call ESMF_FieldWrite(field_att, fileName="field_attributes.nc", &
convention=apConv, purpose=apPurp, &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Fortran array in Field with attributes"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
! Write with ungridded dimensions test
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verifying that a Grid can be created
grid_gblind = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/10,20/), &
regDecomp=(/2,2/), gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,0/), &
indexflag=ESMF_INDEX_GLOBAL, &
name="landgrid", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Creating a Grid with global indexing to use in Field Tests"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_ug = ESMF_FieldCreate(grid_gblind, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/2/), &
name="t_src", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a field with 1 ungridded dim"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Fill Field
call ESMF_FieldGet (field_ug, &
totalLbound=tlb3, &
totalUbound=tub3, &
farrayPtr=t_ptr, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get and fill a field with 1 ungridded dim"
if (rc == ESMF_SUCCESS) then
do, j=tlb3(2), tub3(2)
do, i=tlb3(1), tub3(1)
t_ptr(i,j,:) = real (j*100 + i)
end do
end do
end if
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Write Fortran array in Field
call ESMF_FieldWrite(field_ug, fileName="field_ug.nc", &
iofmt=ESMF_IOFMT_NETCDF, &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Fortran array in Field with 1 ungridded dimension"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_ug2 = ESMF_FieldCreate(grid_gblind, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/2/), &
name="t_src", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a field with 1 ungridded dim for comparison test"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Write Fortran array in Field
call ESMF_FieldRead (field_ug2, fileName="field_ug.nc", &
iofmt=ESMF_IOFMT_NETCDF, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Read Fortran array in Field with 1 ungridded dimension"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Compare data
call ESMF_FieldGet (field_ug2, &
totalLbound=tlb4, &
totalUbound=tub4, &
farrayPtr=t_ptr2, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Access comparison field data with 1 ungridded dim"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Compare data
write(name, *) "Comparison field data with 1 ungridded dim"
write(failMsg, *) "Did not return ESMF_SUCCESS"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
failed = .false.
do, j=tlb4(2), tub4(2)
do, i=tlb4(1), tub4(1)
if (any (t_ptr2(i,j,:) /= real (j*100 + i))) then
failed = .true.
exit
end if
end do
end do
if (failed) &
write(failMsg, *) "Comparison failed at (", i, j, ")"
#else
failed = .false.
#endif
call ESMF_Test(.not. failed, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create a ArraySpec
call ESMF_ArraySpecSet(arrayspec_nd, typekind=ESMF_TYPEKIND_R8, &
rank=4, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Array Spec 3D Set "
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Create Field
field_ugd_att=ESMF_FieldCreate(grid, arrayspec=arrayspec_nd, &
ungriddedLBound=(/1,1/), ungriddedUBound=(/10,20/), &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a field with ungridded dims for attribute package Test"
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create ungridded dimensions attribute package on Field Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_AttributeAdd (field_ugd_att, &
convention=apConv, purpose=apPurp, &
attrList=(/ ESMF_ATT_UNGRIDDED_DIM_LABELS /), rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Set ungridded dimension label values on Field Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_AttributeSet (field_ugd_att, &
name=ESMF_ATT_UNGRIDDED_DIM_LABELS, &
valueList=(/ "ungridded_1", "ungridded_2" /), &
convention=apConv, purpose=apPurp, &
rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create attribute package for Field variable Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_AttributeAdd (field_ugd_att, &
convention=apConv, purpose=apPurp, &
attrList=attrNames, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Set attribute package values for Field variable Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
do, i=1, size (attrNames)
select case (attrNames(i))
case ("long_name")
call ESMF_AttributeSet (field_ugd_att, &
attrNames(i), valueList=(/ "temperature" /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
case ("units")
call ESMF_AttributeSet (field_ugd_att, &
attrNames(i), valueList=(/ "K" /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
case ("valid_range")
call ESMF_AttributeSet (field_ugd_att, &
attrNames(i), valueList=(/ 100.0, 350.0 /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
case ("missing_value")
call ESMF_AttributeSet (field_ugd_att, &
attrNames(i), valueList=(/ -1.e+10 /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
#if !defined (ESMF_PNETCDF)
case ("_FillValue")
call ESMF_AttributeSet (field_ugd_att, &
attrNames(i), valueList=(/ -1.e+10_ESMF_KIND_R8 /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
#endif
case ("cell_methods")
call ESMF_AttributeSet (field_ugd_att, &
attrNames(i), valueList=(/ "time: point" /), &
convention=apConv, purpose=apPurp, &
rc=rc)
if (rc /= ESMF_SUCCESS) exit
case default
print *, 'unhandled case!'
rc = ESMF_FAILURE
exit
end select
end do
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!call ESMF_FieldPrint (field_att)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Write Fortran array in Field
call ESMF_FieldWrite(field_ugd_att, fileName="field_ugd_attributes.nc", &
iofmt=ESMF_IOFMT_NETCDF, &
convention=apConv, purpose=apPurp, &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Fortran array in Field with attributes"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Write with Grid created using deBlockList
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create connectionList for deBlockList test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
idim_size=108
jdim_size=60
allocate (deBlockList(2, 2, petCount))
deBlockList(:,1,1) = (/1,1/)
deBlockList(:,2,1) = (/108,15/)
deBlockList(:,1,2) = (/1,16/)
deBlockList(:,2,2) = (/108,30/)
deBlockList(:,1,3) = (/1,31/)
deBlockList(:,2,3) = (/108,45/)
deBlockList(:,1,4) = (/1,46/)
deBlockList(:,2,4) = (/108,60/)
allocate(connectionList(1)) ! one connection
call ESMF_DistGridConnectionSet(connection=connectionList(1), &
tileIndexA=1, tileIndexB=1, positionVector=(/idim_size, 0/), &
rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create DistGrid (from deBlockList) test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
dg_debl = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/idim_size,jdim_size/), &
indexflag=ESMF_INDEX_GLOBAL, &
deBlockList=deBlockList, connectionList=connectionList, &
rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create Grid from DistGrid (from deBlockList) test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
grid_debl = ESMF_GridCreate(distGrid=dg_debl, &
indexflag=ESMF_INDEX_GLOBAL, &
coordSys=ESMF_COORDSYS_SPH_DEG, &
name="ATM:grid", &
rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create Field from Grid (from deBlockList) test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
field_debl = ESMF_FieldCreate(name="field_3d_3dbl", grid=grid_debl, &
typekind=ESMF_TYPEKIND_R8, ungriddedLBound=(/1/), ungriddedUBound=(/50/), &
rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Write Field (from deBlockList) test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_FieldWrite(field_debl, &
filename="field_3d_debl.nc", overwrite=.true., &
rc=rc)
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
deallocate (deBlockList, connectionList)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Tests with both (a) multiple DEs per PET and (b) ungridded dimensions
! (Note that these are exhaustive-only unit tests.)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Create Field
field_ug_w2DE=ESMF_FieldCreate(grid_2DE, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/2/), &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a Field from 2DE grid with 1 ungridded dim"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Fill Field for DE0
call ESMF_FieldGet(field_ug_w2DE, localDe=0, farrayPtr=Farray_ug_DE0_w, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get and fill farray from field_ug_w2DE, DE 0"
if (rc == ESMF_SUCCESS) then
do k = lbound(Farray_ug_DE0_w, 3), ubound(Farray_ug_DE0_w, 3)
do j = lbound(Farray_ug_DE0_w, 2), ubound(Farray_ug_DE0_w, 2)
do i = lbound(Farray_ug_DE0_w, 1), ubound(Farray_ug_DE0_w, 1)
Farray_ug_DE0_w(i,j,k) = (localPet+1) * real(k*1000 + j*100 + i, ESMF_KIND_R8)
end do
end do
end do
end if
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Fill Field for DE1
call ESMF_FieldGet(field_ug_w2DE, localDe=1, farrayPtr=Farray_ug_DE1_w, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get and fill farray from field_ug_w2DE, DE 1"
if (rc == ESMF_SUCCESS) then
do k = lbound(Farray_ug_DE1_w, 3), ubound(Farray_ug_DE1_w, 3)
do j = lbound(Farray_ug_DE1_w, 2), ubound(Farray_ug_DE1_w, 2)
do i = lbound(Farray_ug_DE1_w, 1), ubound(Farray_ug_DE1_w, 1)
Farray_ug_DE1_w(i,j,k) = 7 * (localPet+1) * real(k*1000 + j*100 + i, ESMF_KIND_R8)
end do
end do
end do
end if
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Write Field with both (a) multiple DEs per PET and (b) ungridded dimensions
call ESMF_FieldWrite(field_ug_w2DE, fileName="field_ug_2DE.nc", &
iofmt=ESMF_IOFMT_NETCDF, &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Field from 2DE grid with 1 ungridded dim"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Create Field
field_ug_r2DE=ESMF_FieldCreate(grid_2DE, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/2/), &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a Field from 2DE grid with 1 ungridded dim for read"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Read Field with both (a) multiple DEs per PET and (b) ungridded dimensions
call ESMF_FieldRead(field_ug_r2DE, fileName="field_ug_2DE.nc", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Read Field from 2DE grid with 1 ungridded dim"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Get Farray from read-in Field on DE 0
call ESMF_FieldGet(field_ug_r2DE, localDe=0, farrayPtr=Farray_ug_DE0_r, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get farray from field_ug_r2DE, DE 0"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Compare read-in Field with original for DE 0
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
allEqual = all(Farray_ug_DE0_r == Farray_ug_DE0_w)
#else
allEqual = .true.
#endif
write(failMsg, *) "Some read-in values differ from original"
write(name, *) "Comparison of read-in Field from 2DE grid with 1 ungridded dim vs original, DE 0"
call ESMF_Test(allEqual, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Get Farray from read-in Field on DE 1
call ESMF_FieldGet(field_ug_r2DE, localDe=1, farrayPtr=Farray_ug_DE1_r, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get farray from field_ug_r2DE, DE 1"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Compare read-in Field with original for DE 1
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
allEqual = all(Farray_ug_DE1_r == Farray_ug_DE1_w)
#else
allEqual = .true.
#endif
write(failMsg, *) "Some read-in values differ from original"
write(name, *) "Comparison of read-in Field from 2DE grid with 1 ungridded dim vs original, DE 1"
call ESMF_Test(allEqual, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! Destroy all Fields and cleanup
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Destroy globally indexed 2DE Grid"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_GridDestroy(grid_2DE, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verifying that a Field with no data can be destroyed
call ESMF_FieldDestroy(field, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Destroying a Field "
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verifying that a Field with no data can be destroyed
countfail = 0
call ESMF_FieldDestroy(field_r, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_t, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_tr, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_w_nohalo, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_w, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_md, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_gw, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_w2DE, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_r2DE, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_att, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_ugd_att, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_ug, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_ug2, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_ug_w2DE, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_ug_r2DE, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(elem_field, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_debl, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_GridDestroy(grid_debl, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_GridDestroy(grid_md, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_DistGridDestroy(elem_dg, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_DistGridDestroy(dg_debl, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Destroying all Fields, Grids, and DistGrids"
call ESMF_Test(countfail == 0, name, failMsg, result, ESMF_SRCLINE)
deallocate (exclusiveLBound, exclusiveUBound)
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
10 continue
!-----------------------------------------------------------------------------
call ESMF_TestEnd(ESMF_SRCLINE) ! calls ESMF_Finalize() internally
!-----------------------------------------------------------------------------
end program ESMF_FieldIOUTest