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
    real(ESMF_KIND_R8)    :: pi
    type(ESMF_Array)      :: array(3)
    type(ESMF_ArrayBundle):: arraybundle
    real(ESMF_KIND_R8), pointer :: farrayPtr1(:,:)   ! matching F90 array ptr
    real(ESMF_KIND_R8), pointer :: farrayPtr2(:,:)   ! matching F90 array ptr
    real(ESMF_KIND_R8), pointer :: farrayPtr3(:,:)   ! matching F90 array ptr
    integer               :: i, j
    
    ! Initialize return code
    rc = ESMF_SUCCESS

    print *, "User Comp2 Run starting"

    pi = 3.14159d0

    ! Get the destination ArrayBundle from the export State
    call ESMF_StateGet(importState, "dstAryBndl", arraybundle, rc=rc)
    if (rc/=ESMF_SUCCESS) return ! bail out

    ! Get the destination Arrays from the ArrayBundle
    call ESMF_ArrayBundleGet(arraybundle, "Z array data 1", &
      array=array(1), rc=rc)
    if (rc/=ESMF_SUCCESS) return ! bail out
    call ESMF_ArrayBundleGet(arraybundle, "Y array data 2", &
      array=array(2), rc=rc)
    if (rc/=ESMF_SUCCESS) return ! bail out
    call ESMF_ArrayBundleGet(arraybundle, "X array data 3", &
      array=array(3), rc=rc)
    if (rc/=ESMF_SUCCESS) return ! bail out

    ! Gain access to actual data via F90 array pointer
    call ESMF_ArrayGet(array(1), localDe=0, farrayPtr=farrayPtr1, rc=rc)
    if (rc/=ESMF_SUCCESS) return ! bail out
    call ESMF_ArrayGet(array(2), localDe=0, farrayPtr=farrayPtr2, rc=rc)
    if (rc/=ESMF_SUCCESS) return ! bail out
    call ESMF_ArrayGet(array(3), localDe=0, farrayPtr=farrayPtr3, rc=rc)
    if (rc/=ESMF_SUCCESS) return ! bail out
      
    ! Test Array in import state against exact solution
    do j = lbound(farrayPtr1, 2), ubound(farrayPtr1, 2)
      do i = lbound(farrayPtr1, 1), ubound(farrayPtr1, 1)
        if (abs(farrayPtr1(i,j) - (10.0d0 &
          + 5.0d0 * sin(real(i,ESMF_KIND_R8)/100.d0*pi) &
          + 2.0d0 * sin(real(j,ESMF_KIND_R8)/150.d0*pi))) > 1.d-8) then
          call ESMF_LogWrite("array1 check failure", ESMF_LOGMSG_INFO)
          rc=ESMF_FAILURE
          return ! bail out
        endif
        if (abs(farrayPtr2(i,j) - farrayPtr1(i,j) - 123.456d0) > 1.d-8) then
          call ESMF_LogWrite("array2 check failure", ESMF_LOGMSG_INFO)
          rc=ESMF_FAILURE
          return ! bail out
        endif
        if (abs(farrayPtr3(i,j) - farrayPtr1(i,j) + 123.456d0) > 1.d-8) then
          call ESMF_LogWrite("array3 check failure", ESMF_LOGMSG_INFO)
          rc=ESMF_FAILURE
          return ! bail out
        endif
      enddo
    enddo
 
    print *, "User Comp2 Run returning"

  end subroutine user_run