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_VM)                  :: vm
    integer                        :: de_id
    type(ESMF_FieldBundle)         :: fieldbundle
    type(ESMF_LocStream)           :: locs
    type(ESMF_DistGrid)            :: distgrid
    logical                        :: arbIndex
    integer                        :: elementCount
    integer, allocatable           :: indexList(:)
    type(ESMF_Field)               :: field
    integer(ESMF_KIND_I4), pointer :: fptr(:,:,:)
    integer                        :: i
    integer                        :: exlb(3), exub(3)
    
    ! Initialize return code
    rc = ESMF_SUCCESS

    call ESMF_GridCompGet(comp, vm=vm, rc=rc)
    if(rc/=ESMF_SUCCESS) return
    call ESMF_VMGet(vm, localPet=de_id, rc=rc)
    if(rc/=ESMF_SUCCESS) return

    print *, de_id, "User Comp2 Run starting"

    ! Get the destination Field from the import State
    call ESMF_StateGet(importState, itemName="fieldbundle data", fieldbundle=fieldbundle, rc=rc)
    if (rc/=ESMF_SUCCESS) return
   
    ! Get the LocStream from the FieldBundle
    call ESMF_FieldBundleGet(fieldbundle, locstream=locs, rc=rc)
    if (rc/=ESMF_SUCCESS) return

    call ESMF_LocStreamGet(locs, distgrid=distgrid, rc=rc)
    if(rc/=ESMF_SUCCESS) return

    call ESMF_DistGridGet(distgrid, localDe=0, arbSeqIndexFlag=arbIndex, &
          elementCount=elementCount, rc=rc)
    if(rc/=ESMF_SUCCESS) return

    allocate(indexList(elementCount))

    call ESMF_DistGridGet(distgrid, localDe=0, seqIndexList=indexList, rc=rc)
    if(rc/=ESMF_SUCCESS) return

    nullify(fptr)
    call ESMF_FieldBundleGet(fieldbundle, fieldName="temperature", &
          field=field, rc=rc)
    if (rc/=ESMF_SUCCESS) return
    call ESMF_FieldGet(field, localDe=0, farrayPtr=fptr, &
          exclusiveLBound=exlb, exclusiveUBound=exub, rc=rc)
    if(rc/=ESMF_SUCCESS) return
    do i = exlb(2), exub(2)
          if(fptr(1,i,1) .ne. indexList(i)*1*1) then
            print *, de_id, "ERROR temp ", indexList(i), " val(1,i,1) =", fptr(1,i,1)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,2) .ne. indexList(i)*1*2) then
            print *, de_id, "ERROR temp ", indexList(i), " val(1,i,2) =", fptr(1,i,2)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,3) .ne. indexList(i)*1*3) then
            print *, de_id, "ERROR temp ", indexList(i), " val(1,i,3) =", fptr(1,i,3)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,4) .ne. indexList(i)*1*4) then
            print *, de_id, "ERROR temp ", indexList(i), " val(1,i,4) =", fptr(1,i,4)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,1) .ne. 1*1) then
            print *, de_id, "ERROR temp ", indexList(i), " val(2,i,1) =", fptr(2,i,1)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,2) .ne. 1*2) then
            print *, de_id, "ERROR temp ", indexList(i), " val(2,i,2) =", fptr(2,i,2)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,3) .ne. 1*3) then
            print *, de_id, "ERROR temp ", indexList(i), " val(2,i,3) =", fptr(2,i,3)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,4) .ne. 1*4) then
            print *, de_id, "ERROR temp ", indexList(i), " val(2,i,4) =", fptr(2,i,4)
            rc = ESMF_FAILURE
          endif
    enddo

    nullify(fptr)
    call ESMF_FieldBundleGet(fieldbundle, fieldName="humidity", &
          field=field, rc=rc)
    if (rc/=ESMF_SUCCESS) return
    call ESMF_FieldGet(field, localDe=0, farrayPtr=fptr, &
          exclusiveLBound=exlb, exclusiveUBound=exub, rc=rc)
    if(rc/=ESMF_SUCCESS) return
    do i = exlb(2), exub(2)
          if(fptr(1,i,1) .ne. indexList(i)*10*1) then
            print *, de_id, "ERROR humd ", indexList(i), " val(1,i,1) =", fptr(1,i,1)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,2) .ne. indexList(i)*10*2) then
            print *, de_id, "ERROR humd ", indexList(i), " val(1,i,2) =", fptr(1,i,2)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,3) .ne. indexList(i)*10*3) then
            print *, de_id, "ERROR humd ", indexList(i), " val(1,i,3) =", fptr(1,i,3)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,4) .ne. indexList(i)*10*4) then
            print *, de_id, "ERROR humd ", indexList(i), " val(1,i,4) =", fptr(1,i,4)
            rc = ESMF_FAILURE
          endif
    enddo

    nullify(fptr)
    call ESMF_FieldBundleGet(fieldbundle, fieldName="pressure", &
          field=field, rc=rc)
    if (rc/=ESMF_SUCCESS) return
    call ESMF_FieldGet(field, localDe=0, farrayPtr=fptr, &
          exclusiveLBound=exlb, exclusiveUBound=exub, rc=rc)
    if(rc/=ESMF_SUCCESS) return
    do i = exlb(2), exub(2)
          if(fptr(1,i,1) .ne. indexList(i)*100*1) then
            print *, de_id, "ERROR pres ", indexList(i), " val(1,i,1) =", fptr(1,i,1)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,2) .ne. indexList(i)*100*2) then
            print *, de_id, "ERROR pres ", indexList(i), " val(1,i,2) =", fptr(1,i,2)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,3) .ne. indexList(i)*100*3) then
            print *, de_id, "ERROR pres ", indexList(i), " val(1,i,3) =", fptr(1,i,3)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,4) .ne. indexList(i)*100*4) then
            print *, de_id, "ERROR pres ", indexList(i), " val(1,i,4) =", fptr(1,i,4)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,1) .ne. 100*1) then
            print *, de_id, "ERROR pres ", indexList(i), " val(2,i,1) =", fptr(2,i,1)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,2) .ne. 100*2) then
            print *, de_id, "ERROR pres ", indexList(i), " val(2,i,2) =", fptr(2,i,2)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,3) .ne. 100*3) then
            print *, de_id, "ERROR pres ", indexList(i), " val(2,i,3) =", fptr(2,i,3)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,4) .ne. 100*4) then
            print *, de_id, "ERROR pres ", indexList(i), " val(2,i,4) =", fptr(2,i,4)
            rc = ESMF_FAILURE
          endif
    enddo

    deallocate(indexList)

    print *, de_id, "User Comp2 Run returning"

  end subroutine user_run