user_run Subroutine

public subroutine user_run(comp, importState, exportState, clock, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_GridComp) :: comp
type(ESMF_State) :: importState
type(ESMF_State) :: exportState
type(ESMF_Clock) :: clock
integer, intent(out) :: rc

Source Code

  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