! $Id$ ! ! Earth System Modeling Framework ! Copyright (c) 2002-2023, University Corporation for Atmospheric Research, ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics ! Laboratory, University of Michigan, National Centers for Environmental ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, ! NASA Goddard Space Flight Center. ! Licensed under the University of Illinois-NCSA License. ! !============================================================================== ! program ESMF_FieldLSSMMUTest !------------------------------------------------------------------------------ ! INCLUDES #include "ESMF.h" #include "ESMF_Macros.inc" ! !============================================================================== !BOPI ! !PROGRAM: ESMF_FieldLSSMMUTest - This test verifies FieldLSSMM functionality. ! ! !DESCRIPTION: ! ! The code in this file specializes on testing the usage of FiledSMM. !EOPI ! !----------------------------------------------------------------------------- ! !USES: use ESMF_TestMod ! test methods use ESMF implicit none !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter :: version = & '$Id$' !------------------------------------------------------------------------------ ! cumulative result: count failures; no failures equals "all pass" integer :: result = 0 ! individual test result code integer :: rc = ESMF_SUCCESS #ifdef ESMF_TESTEXHAUSTIVE ! individual test name character(ESMF_MAXSTR) :: name ! individual test failure messages character(ESMF_MAXSTR*2) :: failMsg #endif call ESMF_TestStart(ESMF_SRCLINE, rc=rc) 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) #ifdef ESMF_TESTEXHAUSTIVE !------------------------------------------------------------------------ !EX_UTest_Multi_Proc_Only call test_smm_1db(rc) write(failMsg, *) "" write(name, *) "FieldLSSMM test using lpe for both src and dst, with halos" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) #endif call ESMF_TestEnd(ESMF_SRCLINE) #ifdef ESMF_TESTEXHAUSTIVE contains #undef ESMF_METHOD #define ESMF_METHOD "test_smm_1d" subroutine test_smm_1db(rc) integer, intent(out) :: rc ! local arguments used to create field etc type(ESMF_Field) :: srcField, dstField type(ESMF_DistGrid) :: distgrid type(ESMF_VM) :: vm type(ESMF_RouteHandle) :: routehandle type(ESMF_ArraySpec) :: arrayspec integer :: localrc, lpe, i type(ESMF_LocStream) :: locs integer, pointer :: srcfptr(:), dstfptr(:) integer, pointer :: fptr(:) integer :: exlb(1), exub(1) integer(ESMF_KIND_I4), allocatable :: factorList(:) integer, allocatable :: factorIndexList(:,:) rc = ESMF_SUCCESS localrc = ESMF_SUCCESS call ESMF_VMGetCurrent(vm, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_VMGet(vm, localPet=lpe, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! create distgrid and grid distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/16/), & regDecomp=(/4/), & rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return locs = ESMF_LocStreamCreate(distgrid=distgrid, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_I4, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return srcField = ESMF_FieldCreate(locs, arrayspec, & rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_FieldGet(srcField, localDe=0, farrayPtr=srcfptr, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return srcfptr = lpe+1 dstField = ESMF_FieldCreate(locs, arrayspec, & rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_FieldGet(dstField, localDe=0, farrayPtr=dstfptr, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return dstfptr = 0 ! initialize factorList and factorIndexList ! SMM is a diagonal matrix with 1,2,3,4 as eigenvalues allocate(factorList(4)) allocate(factorIndexList(2,4)) factorList = (/1,2,3,4/) factorIndexList(1,:) = (/lpe*4+1,lpe*4+2,lpe*4+3,lpe*4+4/) factorIndexList(2,:) = (/lpe*4+1,lpe*4+2,lpe*4+3,lpe*4+4/) call ESMF_FieldSMMStore(srcField, dstField, routehandle, & factorList, factorIndexList, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! perform smm call ESMF_FieldSMM(srcField, dstField, routehandle, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! verify smm call ESMF_FieldGet(dstField, localDe=0, farrayPtr=fptr, & exclusiveLBound=exlb, exclusiveUBound=exub, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Verify that the smm data in dstField(l) is correct. ! Before the smm op, the dst Field contains all 0. ! The smm op reset the values to the index value, verify this is the case. !write(*, '(9I3)') l, lpe, fptr do i = exlb(1), exub(1) if(fptr(i) .ne. i*(lpe+1)) localrc = ESMF_FAILURE enddo if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! release SMM route handle call ESMF_FieldSMMRelease(routehandle, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! release all acquired resources call ESMF_FieldDestroy(srcField) call ESMF_FieldDestroy(dstField) call ESMF_LocStreamDestroy(locs) call ESMF_DistGridDestroy(distgrid) deallocate(factorList, factorIndexList) rc = ESMF_SUCCESS end subroutine test_smm_1db #endif end program ESMF_FieldLSSMMUTest