! $Id$ ! ! Example/test code which shows User Component calls. !------------------------------------------------------------------------- !------------------------------------------------------------------------- ! ! !DESCRIPTION: ! User-supplied Component ! ! !\begin{verbatim} module user_modelB #include "ESMF.h" ! ESMF Framework module use ESMF use ESMF_TestMod implicit none public usermB_register private type dblock sequence real(ESMF_KIND_R8)::offset end type type dataWrapper sequence type(dblock), pointer :: p end type contains subroutine usermB_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, userRoutine=user_init, & rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=user_run, & rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=user_final, & rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out print *, "User CompB Register returning" end subroutine !------------------------------------------------------------------------- ! ! User Comp Component created by higher level calls, here is the ! ! Initialization routine. subroutine user_init(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! Local variables type(ESMF_ArraySpec) :: arrayspec type(ESMF_DistGrid) :: distgrid type(ESMF_Array) :: array type(ESMF_VM) :: vm integer :: myPet, petCount, i, j real(ESMF_KIND_R8), pointer :: farrayPtr(:,:) ! matching F90 array pointer real(ESMF_KIND_R8) :: perturbation character(len=ESMF_MAXSTR) :: compName type(dataWrapper) :: intStatePtr ! Initialize return code rc = ESMF_SUCCESS ! Get component information/attribute call ESMF_GridCompGet(comp, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_VMGet(vm, localPet=myPet, petCount=petCount, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_AttributeGet(comp, "perturbation", perturbation, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! Create the source Array and add it to the export State call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! The array for compB is distributed on the second dimension distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/100,150/), & regDecomp=(/1,petCount/), rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, & indexflag=ESMF_INDEX_GLOBAL, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_ArraySet(array, name="array data", rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! Gain access to actual data via F90 array pointer call ESMF_ArrayGet(array, localDe=0, farrayPtr=farrayPtr, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! Set the array values using the perturbation. ! The value and the perturbation was set so that after the values of the compB array ! is exactly half of the values of compA array do j = lbound(farrayPtr, 2), ubound(farrayPtr, 2) do i = lbound(farrayPtr, 1), ubound(farrayPtr, 1) farrayPtr(i,j) = 6+perturbation enddo enddo allocate(intStatePtr%p) ! Set the export state call ESMF_StateAdd(exportState, (/array/), rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! Set the internal state call ESMF_GridCompGet(comp, name=compName, rc=rc) if (trim(compName) .eq. "user model B-1") then intStatePtr%p%offset = 3.0 else intStatePtr%p%offset = 6.0 endif call ESMF_GridCompSetInternalState(comp, intStatePtr, rc) if (rc/=ESMF_SUCCESS) return ! bail out print *, "User CompB Init returning ", compName end subroutine user_init !------------------------------------------------------------------------- ! ! The Run routine where data is computed. ! ! subroutine user_run(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! Local variables type(ESMF_Array) :: array real(ESMF_KIND_R8), pointer :: farrayPtr(:,:) ! matching F90 array pointer integer :: i, j, l1, l2 character(len=ESMF_MAXSTR) :: compName type(dataWrapper) :: intStatePtr real(ESMF_KIND_R8) :: offset call ESMF_GridCompGet(comp, name=compName, rc=rc) call ESMF_GridCompGetInternalState(comp, intStatePtr, rc) if (rc/=ESMF_SUCCESS) return ! bail out offset = intStatePtr%p%offset ! Initialize return code rc = ESMF_SUCCESS ! Get the source Array from the export State call ESMF_StateGet(exportState, "array data", array, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! Gain access to actual data via F90 array pointer call ESMF_ArrayGet(array, localDe=0, farrayPtr=farrayPtr, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! increment each element by the offset set in the init routine and passed over using ! internal state do j = lbound(farrayPtr, 2), ubound(farrayPtr, 2) do i = lbound(farrayPtr, 1), ubound(farrayPtr, 1) farrayPtr(i,j) = farrayPtr(i,j) + offset enddo enddo #if 0 l1=lbound(farrayPtr,1) l2=lbound(farrayPtr,2) print *, "User CompB Run returning ", trim(compName), farrayPtr(l1,l2) #endif print *, "User CompB Run returning ", trim(compName) end subroutine user_run !------------------------------------------------------------------------- ! ! The Finalization routine where things are deleted and cleaned up. ! ! subroutine user_final(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(dataWrapper) :: intStatePtr ! Local variables type(ESMF_DistGrid) :: distgrid type(ESMF_Array) :: array ! Initialize return code rc = ESMF_SUCCESS call ESMF_GridCompGetInternalState(comp, intStatePtr, rc) if (rc/=ESMF_SUCCESS) return ! bail out deallocate(intStatePtr%p) call ESMF_StateGet(exportState, "array data", array, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_ArrayGet(array, distgrid=distgrid, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_ArrayDestroy(array, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_DistGridDestroy(distgrid, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out print *, "User CompB Final returning" end subroutine user_final end module user_modelB !\end{verbatim}