! $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. ! !============================================================================== module ESMF_AttributeUpdateMultiReconcileUTestMod use ESMF implicit none private public userm1_setvm, userm1_register public userm2_setvm, userm2_register public userm3_setvm, userm3_register public usercpl1_setvm, usercpl1_register public usercpl2_setvm, usercpl2_register contains !------------------------------------------------------------------------- ! ! The SetVM Register routines for Gridcomp1 subroutine userm1_setvm(comp, rc) type(ESMF_GridComp) :: comp integer, intent(out) :: rc #ifdef ESMF_TESTWITHTHREADS type(ESMF_VM) :: vm logical :: pthreadsEnabled #endif ! Initialize return code rc = ESMF_SUCCESS #ifdef ESMF_TESTWITHTHREADS ! The following call will turn on ESMF-threading (single threaded) ! for this component. If you are using this file as a template for ! your own code development you probably don't want to include the ! following call unless you are interested in exploring ESMF's ! threading features. ! First test whether ESMF-threading is supported on this machine call ESMF_VMGetGlobal(vm, rc=rc) call ESMF_VMGet(vm, pthreadsEnabledFlag=pthreadsEnabled, rc=rc) if (pthreadsEnabled) then call ESMF_GridCompSetVMMinThreads(comp, rc=rc) endif #endif end subroutine userm1_setvm subroutine userm1_register(comp, rc) type(ESMF_GridComp) :: comp integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS ! Register the callback routines. call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userm1_init, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userm1_run, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userm1_final, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out end subroutine userm1_register !------------------------------------------------------------------------- ! ! The SetVM Register routines for Gridcomp2 subroutine userm2_setvm(comp, rc) type(ESMF_GridComp) :: comp integer, intent(out) :: rc #ifdef ESMF_TESTWITHTHREADS type(ESMF_VM) :: vm logical :: pthreadsEnabled #endif ! Initialize return code rc = ESMF_SUCCESS #ifdef ESMF_TESTWITHTHREADS ! The following call will turn on ESMF-threading (single threaded) ! for this component. If you are using this file as a template for ! your own code development you probably don't want to include the ! following call unless you are interested in exploring ESMF's ! threading features. ! First test whether ESMF-threading is supported on this machine call ESMF_VMGetGlobal(vm, rc=rc) call ESMF_VMGet(vm, pthreadsEnabledFlag=pthreadsEnabled, rc=rc) if (pthreadsEnabled) then call ESMF_GridCompSetVMMinThreads(comp, rc=rc) endif #endif end subroutine userm2_setvm subroutine userm2_register(comp, rc) type(ESMF_GridComp) :: comp integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS ! Register the callback routines. call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userm2_init, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userm2_run, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userm2_final, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out end subroutine userm2_register !------------------------------------------------------------------------- ! ! The SetVM Register routines for Gridcomp3 subroutine userm3_setvm(comp, rc) type(ESMF_GridComp) :: comp integer, intent(out) :: rc #ifdef ESMF_TESTWITHTHREADS type(ESMF_VM) :: vm logical :: pthreadsEnabled #endif ! Initialize return code rc = ESMF_SUCCESS #ifdef ESMF_TESTWITHTHREADS ! The following call will turn on ESMF-threading (single threaded) ! for this component. If you are using this file as a template for ! your own code development you probably don't want to include the ! following call unless you are interested in exploring ESMF's ! threading features. ! First test whether ESMF-threading is supported on this machine call ESMF_VMGetGlobal(vm, rc=rc) call ESMF_VMGet(vm, pthreadsEnabledFlag=pthreadsEnabled, rc=rc) if (pthreadsEnabled) then call ESMF_GridCompSetVMMinThreads(comp, rc=rc) endif #endif end subroutine userm3_setvm subroutine userm3_register(comp, rc) type(ESMF_GridComp) :: comp integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS ! Register the callback routines. call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userm3_init, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userm3_run, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userm3_final, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out end subroutine userm3_register !------------------------------------------------------------------------- ! ! The SetVM Register routines for cplcomp subroutine usercpl1_setvm(comp, rc) type(ESMF_CplComp) :: comp integer, intent(out) :: rc #ifdef ESMF_TESTWITHTHREADS type(ESMF_VM) :: vm logical :: pthreadsEnabled #endif ! Initialize return code rc = ESMF_SUCCESS #ifdef ESMF_TESTWITHTHREADS ! The following call will turn on ESMF-threading (single threaded) ! for this component. If you are using this file as a template for ! your own code development you probably don't want to include the ! following call unless you are interested in exploring ESMF's ! threading features. ! First test whether ESMF-threading is supported on this machine call ESMF_VMGetGlobal(vm, rc=rc) call ESMF_VMGet(vm, pthreadsEnabledFlag=pthreadsEnabled, rc=rc) if (pthreadsEnabled) then call ESMF_CplCompSetVMMinThreads(comp, rc=rc) endif #endif end subroutine usercpl1_setvm subroutine usercpl1_register(comp, rc) type(ESMF_CplComp) :: comp integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS ! Register the callback routines. call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, usercpl1_init, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, usercpl1_run, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, usercpl1_final, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out end subroutine usercpl1_register !------------------------------------------------------------------------- ! ! The SetVM Register routines for cplcomp subroutine usercpl2_setvm(comp, rc) type(ESMF_CplComp) :: comp integer, intent(out) :: rc #ifdef ESMF_TESTWITHTHREADS type(ESMF_VM) :: vm logical :: pthreadsEnabled #endif ! Initialize return code rc = ESMF_SUCCESS #ifdef ESMF_TESTWITHTHREADS ! The following call will turn on ESMF-threading (single threaded) ! for this component. If you are using this file as a template for ! your own code development you probably don't want to include the ! following call unless you are interested in exploring ESMF's ! threading features. ! First test whether ESMF-threading is supported on this machine call ESMF_VMGetGlobal(vm, rc=rc) call ESMF_VMGet(vm, pthreadsEnabledFlag=pthreadsEnabled, rc=rc) if (pthreadsEnabled) then call ESMF_CplCompSetVMMinThreads(comp, rc=rc) endif #endif end subroutine usercpl2_setvm subroutine usercpl2_register(comp, rc) type(ESMF_CplComp) :: comp integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS ! Register the callback routines. call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, usercpl2_init, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, usercpl2_run, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, usercpl2_final, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out end subroutine usercpl2_register !------------------------------------------------------------------------- ! ! User Comp Component created by higher level calls, here is the ! ! Initialization routine. subroutine userm1_init(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_AttPack) :: attpack type(ESMF_VM) :: vm integer :: petCount, status, myPet character(ESMF_MAXSTR) :: name1,name2,name3,name4,value1,value2, & value3,value4,convESMF,purpGen,convCC type(ESMF_ArraySpec) :: arrayspec type(ESMF_Grid) :: grid type(ESMF_Field) :: field type(ESMF_FieldBundle) :: fieldbundle character(ESMF_MAXSTR),dimension(2) :: attrList rc = ESMF_SUCCESS call ESMF_GridCompGet(comp, vm=vm, rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_VMGet(vm, petCount=petCount, localPet=myPet, rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) if (rc/=ESMF_SUCCESS) return grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/100,150/), & regDecomp=(/1,petCount/), & gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,0/), & indexflag=ESMF_INDEX_GLOBAL, rc=rc) if (rc/=ESMF_SUCCESS) return convCC = 'CustomConvention' convESMF = 'ESMF' purpGen = 'General' name1 = 'ShortName' name2 = 'StandardName' name3 = 'LongName' name4 = 'Units' value1 = 'field' value2 = 'tendency_of_air_pressure' value3 = 'Edge pressure tendency' value4 = 'Pa s-1' field = ESMF_FieldCreate(grid, arrayspec=arrayspec, & staggerloc=ESMF_STAGGERLOC_CENTER, name="field", rc=status) call ESMF_AttributeAdd(field, convention=convESMF, purpose=purpGen, & rc=status) call ESMF_AttributeSet(field, name1, value1, & convention=convESMF, purpose=purpGen, rc=status) call ESMF_AttributeSet(field, name2, value2, & convention=convESMF, purpose=purpGen, rc=status) call ESMF_AttributeSet(field, name3, value3, & convention=convESMF, purpose=purpGen, rc=status) call ESMF_AttributeSet(field, name4, value4, & convention=convESMF, purpose=purpGen, rc=status) if (status .ne. ESMF_SUCCESS) return ! Create the Grid Attribute Package call ESMF_AttributeAdd(grid,convention=convESMF, purpose=purpGen, rc=status) call ESMF_AttributeSet(grid,'RegDecompX', 96, & convention=convESMF, purpose=purpGen, rc=status) call ESMF_AttributeSet(grid,'RegDecompY', 84, & convention=convESMF, purpose=purpGen, rc=status) if (status .ne. ESMF_SUCCESS) return fieldbundle = ESMF_FieldBundleCreate(name="fieldbundle", rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_FieldBundleSet(fieldbundle, grid=grid, rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_FieldBundleAdd(fieldbundle, (/ field /), rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_StateAdd(exportState, fieldbundleList=(/fieldbundle/), rc=status) if (status .ne. ESMF_SUCCESS) return end subroutine userm1_init !------------------------------------------------------------------------- ! ! User Comp Component created by higher level calls, here is the ! ! Initialization routine. subroutine userm2_init(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS end subroutine userm2_init !------------------------------------------------------------------------- ! ! User Comp Component created by higher level calls, here is the ! ! Initialization routine. subroutine userm3_init(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS end subroutine userm3_init !------------------------------------------------------------------------- ! !User Comp Component created by higher level calls, here is the ! ! Initialization routine. subroutine usercpl1_init(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_VM) :: vm rc = ESMF_SUCCESS call ESMF_CplCompGet(comp, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_StateReconcile(importState, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_StateReconcile(exportState, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return end subroutine usercpl1_init !------------------------------------------------------------------------- ! !User Comp Component created by higher level calls, here is the ! ! Initialization routine. subroutine usercpl2_init(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_VM) :: vm rc = ESMF_SUCCESS call ESMF_CplCompGet(comp, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_StateReconcile(importState, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_StateReconcile(exportState, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return end subroutine usercpl2_init !------------------------------------------------------------------------- ! ! The Run routine where data is computed. ! ! subroutine userm1_run(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_AttPack) :: attpack, attpack_nested type(ESMF_VM) :: vm integer :: petCount, status, myPet character(ESMF_MAXSTR) :: name2,value2,convESMF,purpGen,purp2,name3 character(ESMF_MAXSTR),dimension(2) :: attrList, valueList type(ESMF_Field) :: field type(ESMF_FieldBundle) :: fieldbundle type(ESMF_Grid) :: grid rc = ESMF_SUCCESS convESMF = 'ESMF' purpGen = 'General' name2 = 'StandardName' value2 = 'default_standard_name' name3 = 'LongName' purp2 = 'Extended' attrList(1) = 'Coordinates' attrList(2) = 'Mask' valueList(1) = "Latlon" valueList(2) = "Yes" call ESMF_GridCompGet(comp, vm=vm, rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_VMGet(vm, petCount=petCount, localPet=myPet, rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_StateGet(exportState, "fieldbundle", fieldbundle, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_FieldBundleGet(fieldbundle, grid=grid, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_FieldBundleGet(fieldbundle, fieldname="field", field=field, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_AttributeGetAttPack(field, convESMF, purpGen, attpack=attpack, rc=status) if (rc/=ESMF_SUCCESS) return call ESMF_AttributeSet(field, name2, value2, attpack=attpack, rc=status) if (rc/=ESMF_SUCCESS) return call ESMF_AttributeAdd(field, convention=convESMF, purpose=purp2, & attrList=attrList, nestConvention=convESMF, nestPurpose=purpGen, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_AttributeSet(field, attrList(1), valueList(1), & convention=convESMF, purpose=purp2, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_AttributeSet(field, attrList(2), valueList(2), & convention=convESMF, purpose=purp2, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_LogWrite("ESMF_AttributeUpdateMultiReconcileUTest: Calling ESMF_AttributeRemove", ESMF_LOGMSG_INFO, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_AttributeRemove(field, name=name3, convention=convESMF, & purpose=purpGen, rc=status) if (rc/=ESMF_SUCCESS) return call ESMF_LogWrite("ESMF_AttributeUpdateMultiReconcileUTest: After ESMF_AttributeRemove", ESMF_LOGMSG_INFO, rc=rc) if (rc/=ESMF_SUCCESS) return end subroutine userm1_run !------------------------------------------------------------------------- ! ! The Run routine where data is coupled. ! ! subroutine usercpl1_run(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_VM) :: vm integer :: myPet integer, dimension(2) :: rootList rc = ESMF_SUCCESS call ESMF_CplCompGet(comp, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_VMGet(vm, localPet=myPet, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_StateGet(importState, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_StateGet(exportState, rc=rc) if (rc/=ESMF_SUCCESS) return rootList = (/0,1/) call ESMF_AttributeUpdate(importState, vm, rootList=rootList, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_AttributeCopy(importState, exportState, rc=rc) if (rc/=ESMF_SUCCESS) return end subroutine usercpl1_run !------------------------------------------------------------------------- ! ! The Run routine where data is computed. ! ! subroutine userm2_run(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_VM) :: vm integer :: petCount, status, myPet character(ESMF_MAXSTR) :: convESMF,purpGen rc = ESMF_SUCCESS call ESMF_GridCompGet(comp, vm=vm, rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_VMGet(vm, petCount=petCount, localPet=myPet, rc=status) if (status .ne. ESMF_SUCCESS) return convESMF = 'ESMF' purpGen = 'General' ! Evolve the Field metadata? end subroutine userm2_run !------------------------------------------------------------------------- ! ! The Run routine where data is coupled. ! ! subroutine usercpl2_run(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_VM) :: vm integer :: myPet integer, dimension(2) :: rootList rc = ESMF_SUCCESS call ESMF_CplCompGet(comp, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_VMGet(vm, localPet=myPet, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_StateGet(importState, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_StateGet(exportState, rc=rc) if (rc/=ESMF_SUCCESS) return rootList = (/0,1/) call ESMF_AttributeUpdate(importState, vm, rootList=rootList, rc=rc) if (rc/=ESMF_SUCCESS) return call ESMF_AttributeCopy(importState, exportState, rc=rc) if (rc/=ESMF_SUCCESS) return end subroutine usercpl2_run !------------------------------------------------------------------------- ! ! The Run routine where data is computed. ! ! subroutine userm3_run(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_VM) :: vm integer :: petCount, status, myPet character(ESMF_MAXSTR) :: convESMF,purpGen rc = ESMF_SUCCESS call ESMF_GridCompGet(comp, vm=vm, rc=status) if (status .ne. ESMF_SUCCESS) return call ESMF_VMGet(vm, petCount=petCount, localPet=myPet, rc=status) if (status .ne. ESMF_SUCCESS) return convESMF = 'ESMF' purpGen = 'General' ! Evolve the Field metadata? end subroutine userm3_run !------------------------------------------------------------------------- ! ! The Finalization routine where things are deleted and cleaned up. ! ! subroutine userm1_final(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_Field) :: field type(ESMF_FieldBundle) :: fieldbundle type(ESMF_Grid) :: grid integer :: k ! Initialize return code rc = ESMF_SUCCESS call ESMF_StateGet(exportState, "fieldbundle", fieldbundle, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_FieldBundleGet(fieldbundle, grid=grid, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_FieldBundleGet(fieldbundle, fieldname="field", field=field, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_FieldDestroy(field, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_FieldBundleDestroy(fieldbundle, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridDestroy(grid, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out end subroutine userm1_final !------------------------------------------------------------------------- ! ! The Finalization routine where things are deleted and cleaned up. ! ! subroutine userm2_final(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS end subroutine userm2_final !------------------------------------------------------------------------- ! ! The Finalization routine where things are deleted and cleaned up. ! ! subroutine userm3_final(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS end subroutine userm3_final !------------------------------------------------------------------------- ! ! The Finalization routine where things are deleted and cleaned up. ! ! subroutine usercpl1_final(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS end subroutine usercpl1_final !------------------------------------------------------------------------- ! ! The Finalization routine where things are deleted and cleaned up. ! ! subroutine usercpl2_final(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! Initialize return code rc = ESMF_SUCCESS end subroutine usercpl2_final end module program ESMF_AttributeUpdateMultiReconcileUTest #include "ESMF.h" !============================================================================== !BOP ! !PROGRAM: ESMF_AttributeUpdateMultiReconcileUTest - Attribute Update Unit Tests ! ! !DESCRIPTION: ! ! The code in this file drives F90 Attribute Update unit tests. ! !----------------------------------------------------------------------------- ! !USES: use ESMF use ESMF_TestMod use ESMF_AttributeUpdateMultiReconcileUTestMod, only : userm1_setvm, userm1_register, & userm2_setvm, userm2_register, userm3_setvm, userm3_register, & usercpl1_setvm, usercpl1_register, usercpl2_setvm, usercpl2_register implicit none !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter :: version = & '$Id$' !------------------------------------------------------------------------------ ! individual test failure message character(ESMF_MAXSTR) :: failMsg character(ESMF_MAXSTR) :: name ! cumulative result: count failures; no failures equals "all pass" integer :: result = 0 ! individual test result code integer :: rc = ESMF_SUCCESS ! local variables integer :: petCount, localPet type(ESMF_VM) :: vm type(ESMF_State) :: c1exp, c2imp type(ESMF_GridComp) :: gridcomp1 type(ESMF_GridComp) :: gridcomp2 type(ESMF_GridComp) :: gridcomp3 type(ESMF_CplComp) :: cplcomp1 type(ESMF_CplComp) :: cplcomp2 character(ESMF_MAXSTR) :: convESMF,purpGen type(ESMF_AttPack) :: attpack type(ESMF_Field) :: field type(ESMF_FieldBundle) :: fieldbundle type(ESMF_Grid) :: grid integer :: k character(ESMF_MAXSTR) :: name2,value2,purp2,name3,outVal character(ESMF_MAXSTR),dimension(2) :: attrList, valueList !------------------------------------------------------------------------------- ! The unit tests are divided into Sanity and Exhaustive. The Sanity tests are ! always run. When the environment variable, EXHAUSTIVE, is set to ON then ! the EXHAUSTIVE and sanity tests both run. If the EXHAUSTIVE variable is set ! to OFF, then only the sanity unit tests. ! Special strings (Non-exhaustive and exhaustive) have been ! added to allow a script to count the number and types of unit tests. !------------------------------------------------------------------------------- !----------------------------------------------------------------------------- call ESMF_TestStart(ESMF_SRCLINE, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !----------------------------------------------------------------------------- #ifdef ESMF_TESTEXHAUSTIVE call ESMF_VMGetCurrent(vm, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) gridcomp1 = ESMF_GridCompCreate(name="gridcomp1", & petList=(/0,1/), rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) gridcomp2 = ESMF_GridCompCreate(name="gridcomp2", & petList=(/2,3/), rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) gridcomp3 = ESMF_GridCompCreate(name="gridcomp3", & petList=(/4,5/), rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) cplcomp1 = ESMF_CplCompCreate(name="cplcomp1", & petList=(/0,1,2,3/), rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) cplcomp2 = ESMF_CplCompCreate(name="cplcomp2", & petList=(/0,1,4,5/), rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) c1exp = ESMF_StateCreate(name="Comp1 exportState", & stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) c2imp = ESMF_StateCreate(name="Comp2 importState", & stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompSetVM(gridcomp1, userm1_setvm, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompSetVM(gridcomp2, userm2_setvm, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompSetVM(gridcomp3, userm3_setvm, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompSetVM(cplcomp1, usercpl1_setvm, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompSetVM(cplcomp2, usercpl2_setvm, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompSetServices(gridcomp1, userRoutine=userm1_register, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompSetServices(gridcomp2, userRoutine=userm2_register, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompSetServices(gridcomp3, userRoutine=userm3_register, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompSetServices(cplcomp1, userRoutine=usercpl1_register, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompSetServices(cplcomp2, userRoutine=usercpl2_register, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompInitialize(gridcomp1, exportState=c1exp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompInitialize(gridcomp2, importState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompInitialize(gridcomp3, importState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompInitialize(cplcomp1, importState=c1exp, & exportState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompInitialize(cplcomp2, importState=c1exp, & exportState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Now we can start doing some testing convESMF = 'ESMF' purpGen = 'General' name2 = 'StandardName' value2 = 'tendency_of_air_pressure' call ESMF_StateGet(c1exp, "fieldbundle", fieldbundle, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldBundleGet(fieldbundle, grid=grid, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldBundleGet(fieldbundle, fieldname="field", field=field, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !EX_UTest_Multi_Proc_Only call ESMF_AttributeGetAttPack(field, convention=convESMF, purpose=purpGen, & attpack=attpack, rc=rc) call ESMF_AttributeGet(field, name2, value=outVal, attpack=attpack, & rc=rc) print *, "PET: ", localPet, "outVal: ", trim(outVal) print *, " expected: ", trim(value2) print *, " rc: ", rc write(failMsg, *) "Did not return ESMF_SUCCESS or wrong value" write(name, *) "Getting an updated Attribute value from a Field test" call ESMF_Test((rc==ESMF_SUCCESS).and.(value2==outVal), & name, failMsg, result, ESMF_SRCLINE) call ESMF_GridCompRun(gridcomp1, exportState=c1exp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompRun(cplcomp1, importState=c1exp, & exportState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompRun(gridcomp2, importState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompRun(cplcomp2, importState=c1exp, & exportState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompRun(gridcomp3, importState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Now we can start doing some testing convESMF = 'ESMF' purpGen = 'General' name2 = 'StandardName' value2 = 'default_standard_name' name3 = 'LongName' purp2 = 'Extended' attrList(1) = 'Coordinates' attrList(2) = 'Mask' valueList(1) = "Latlon" valueList(2) = "Yes" call ESMF_StateGet(c1exp, "fieldbundle", fieldbundle, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldBundleGet(fieldbundle, grid=grid, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldBundleGet(fieldbundle, fieldname="field", field=field, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !EX_UTest_Multi_Proc_Only write(name, *) "Getting an updated Attribute value from a Field test" call ESMF_LogWrite("Start: "//TRIM(name)) call ESMF_AttributeGetAttPack(field, convention=convESMF, purpose=purpGen, & attpack=attpack, rc=rc) call ESMF_AttributeGet(field, name2, value=outVal, attpack=attpack, rc=rc) print *, "PET: ", localPet, "outVal: ", trim(outVal) print *, " expected: ", trim(value2) write(failMsg, *) "Did not return ESMF_SUCCESS or wrong value" call ESMF_Test((rc==ESMF_SUCCESS).and.(value2==outVal), & name, failMsg, result, ESMF_SRCLINE) call ESMF_LogWrite("End: "//TRIM(name)) !EX_UTest_Multi_Proc_Only call ESMF_AttributeGetAttPack(field, convention=convESMF, purpose=purp2, & attpack=attpack, rc=rc) call ESMF_AttributeGet(field, attrList(1), value=outVal, & convention=convESMF, purpose=purp2, rc=rc) print *, "PET: ", localPet, "outVal: ", trim(outVal) print *, " expected: ", trim(valueList(1)) write(failMsg, *) "Did not return ESMF_SUCCESS or wrong value" write(name, *) "Getting an updated Attribute package Attribute value from a Field test" call ESMF_Test((rc==ESMF_SUCCESS).and.(valueList(1)==outVal), & name, failMsg, result, ESMF_SRCLINE) !EX_UTest_Multi_Proc_Only call ESMF_AttributeGet(field, attrList(2), value=outVal, & convention=convESMF, purpose=purp2, rc=rc) print *, "PET: ", localPet, "outVal: ", trim(outVal) print *, " expected: ", trim(valueList(2)) write(failMsg, *) "Did not return ESMF_SUCCESS or wrong value" write(name, *) "Getting an updated Attribute package Attribute value from a Field test" call ESMF_Test((rc==ESMF_SUCCESS).and.(valueList(2)==outVal), & name, failMsg, result, ESMF_SRCLINE) !EX_UTest_Multi_Proc_Only write(name, *) "Getting an updated deleted Attribute value from a Field test" call ESMF_LogWrite("Start: "//TRIM(name)) call ESMF_AttributeGet(field, name3, value=outVal, & convention=convESMF, purpose=purpGen, rc=rc) print *, "PET: ", localPet, "DELETED, rc = ", rc write(failMsg, *) "Did not return ESMF_SUCCESS or wrong value" call ESMF_Test((rc/=ESMF_SUCCESS), & name, failMsg, result, ESMF_SRCLINE) ! Now back to finalizing the model run call ESMF_GridCompFinalize(gridcomp1, exportState=c1exp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompFinalize(gridcomp2, importState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompFinalize(gridcomp3, importState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompFinalize(cplcomp1, importState=c1exp, & exportState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompFinalize(cplcomp2, importState=c1exp, & exportState=c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompDestroy(gridcomp1, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompDestroy(gridcomp2, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_GridCompDestroy(gridcomp3, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompDestroy(cplcomp1, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_CplCompDestroy(cplcomp2, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_StateDestroy(c1exp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_StateDestroy(c2imp, rc=rc) if (rc .ne. ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) #endif !----------------------------------------------------------------------------- call ESMF_TestEnd(ESMF_SRCLINE) !----------------------------------------------------------------------------- end program ESMF_AttributeUpdateMultiReconcileUTest