! $Id$ ! ! Example/test code which shows User Component calls. !------------------------------------------------------------------------- !------------------------------------------------------------------------- ! ! !DESCRIPTION: ! User-supplied Component ! ! !\begin{verbatim} module user_modelC ! ESMF Framework module use ESMF implicit none public usermC_register ! global data real(ESMF_KIND_R8) :: solution integer :: petCount, myPet contains !------------------------------------------------------------------------- ! ! The Register routine sets the subroutines to be called ! ! as the init, run, and finalize routines. Note that these are ! ! private to the module. subroutine usermC_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 CompC 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 :: xprocs, yprocs ! Initialize return code rc = ESMF_SUCCESS ! Determine petCount call ESMF_GridCompGet(comp, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_VMGet(vm, petCount=petCount, localPet = myPet, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! Create the destination Array and add it to the import State call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out xprocs = 2 yprocs = petCount/2 distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/100,150/), & regDecomp=(/xprocs, yprocs/), 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 call ESMF_StateAdd(exportState, (/array/), rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! initial solution -- this is the average of the inital values of the ! four source arrays solution = 8.0; print *, "User CompC Init returning" 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) :: srcArray, dstArray real(ESMF_KIND_R8), pointer :: ftrptr1(:,:), ftrptr2(:,:) ! matching F90 array pointer integer :: i, j, k, itemcount, count, l1, l2 character(len=ESMF_MAXSTR) :: name, stateItemNames(4) integer :: ubnd1(2,1), ubnd2(2,1), lbnd1(2,1), lbnd2(2,1) ! Initialize return code rc = ESMF_SUCCESS ! The import state contains four arrays with the same size and distribution as the ! destination array. Do an average of the four array and set the export array values ! accordingly. Also check the values of the input arrays for correctness ! Get import State information call ESMF_StateGet(importState, name=name, itemNameList=stateItemNames, itemcount=itemcount, rc=rc) ! Get the destination Array from the import State call ESMF_StateGet(exportState, "array data", dstArray, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_ArrayGet(dstArray, farrayPtr=ftrptr1, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out ! find the computation bounds for the srcArray and dstArray and make sure they match with each other call ESMF_ArrayGet(dstArray, computationalUBound=ubnd1, computationalLBound=lbnd1, rc=rc) ! Reset the dest array values to 0 ftrptr1 = 0.0 ! Get the srcArray from the import state item and dstArray from the export state and do a regrid do k=1,itemcount call ESMF_StateGet(importState, stateItemNames(k), srcArray, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_ArrayGet(srcArray, farrayPtr=ftrptr2, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out #if 0 l1=lbound(ftrptr2,1) l2=lbound(ftrptr2,2) print *, 'srcArray ', trim(stateItemNames(k)), ftrptr2(l1,l2) #endif ! find the computation bounds for the srcArray and dstArray and make sure they match with each other call ESMF_ArrayGet(srcArray, computationalUBound=ubnd2, computationalLBound=lbnd2, rc=rc) ! print *, myPet, "The srcArray and dstArray dimension ", ubnd1, ubnd2 if (ubnd1(1,1) /= ubnd1(1,1) .or. lbnd1(2,1) /= lbnd1(2,1)) then print *, "The srcArray and dstArray dimension in the localDE does not match ", ubnd1, ubnd2 rc=ESMF_FAILURE return end if ! add the import array value to the export array do j = lbound(ftrptr1, 2), ubound(ftrptr1, 2) do i = lbound(ftrptr1, 1), ubound(ftrptr1, 1) ftrptr1(i,j) = ftrptr1(i,j)+ftrptr2(i,j) enddo enddo enddo ! now average the output array do j = lbound(ftrptr1, 2), ubound(ftrptr1, 2) do i = lbound(ftrptr1, 1), ubound(ftrptr1, 1) ftrptr1(i,j) = ftrptr1(i,j)/4 enddo enddo ! check the values: Model A-1 and B-1 (after regrid): 11+time*5, ! Model A-2 and B-2 (after regrid): 9+time*10 ! so the average should be 10+7.5*time for each time step ! solution = solution+6.0 count = 0 do j = lbound(ftrptr1, 2), ubound(ftrptr1, 2) do i = lbound(ftrptr1, 1), ubound(ftrptr1, 1) if (ftrptr1(i,j) /= solution) count = count+1 enddo enddo if (count > 0) then rc=ESMF_FAILURE return endif print *, myPet, 'total number of wrong answers:', count 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 ! Local variables type(ESMF_DistGrid) :: distgrid type(ESMF_Array) :: array ! Initialize return code rc = ESMF_SUCCESS 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 end subroutine user_final end module user_modelC !\end{verbatim}