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

Calls

proc~~user_run~28~~CallsGraph proc~user_run~28 user_run esmf_fieldget esmf_fieldget proc~user_run~28->esmf_fieldget esmf_stateget esmf_stateget proc~user_run~28->esmf_stateget interface~esmf_distgridget ESMF_DistGridGet proc~user_run~28->interface~esmf_distgridget interface~esmf_vmget ESMF_VMGet proc~user_run~28->interface~esmf_vmget proc~esmf_gridcompget ESMF_GridCompGet proc~user_run~28->proc~esmf_gridcompget proc~esmf_locstreamget ESMF_LocStreamGet proc~user_run~28->proc~esmf_locstreamget proc~esmf_distgridgetdefault ESMF_DistGridGetDefault interface~esmf_distgridget->proc~esmf_distgridgetdefault proc~esmf_distgridgetplocalde ESMF_DistGridGetPLocalDe interface~esmf_distgridget->proc~esmf_distgridgetplocalde proc~esmf_distgridgetplocaldepdim ESMF_DistGridGetPLocalDePDim interface~esmf_distgridget->proc~esmf_distgridgetplocaldepdim proc~esmf_vmgetdefault ESMF_VMGetDefault interface~esmf_vmget->proc~esmf_vmgetdefault proc~esmf_vmgetpetspecific ESMF_VMGetPetSpecific interface~esmf_vmget->proc~esmf_vmgetpetspecific proc~esmf_compget ESMF_CompGet proc~esmf_gridcompget->proc~esmf_compget proc~esmf_compstatusget ESMF_CompStatusGet proc~esmf_gridcompget->proc~esmf_compstatusget proc~esmf_gridcompgetinit ESMF_GridCompGetInit proc~esmf_gridcompget->proc~esmf_gridcompgetinit proc~esmf_imerr ESMF_IMErr proc~esmf_gridcompget->proc~esmf_imerr proc~esmf_logfounderror ESMF_LogFoundError proc~esmf_gridcompget->proc~esmf_logfounderror proc~esmf_locstreamget->interface~esmf_distgridget proc~esmf_delayoutget ESMF_DELayoutGet proc~esmf_locstreamget->proc~esmf_delayoutget proc~esmf_getname ESMF_GetName proc~esmf_locstreamget->proc~esmf_getname proc~esmf_locstreamget->proc~esmf_imerr proc~esmf_locstreamgetinit ESMF_LocStreamGetInit proc~esmf_locstreamget->proc~esmf_locstreamgetinit proc~esmf_locstreamget->proc~esmf_logfounderror proc~esmf_logseterror ESMF_LogSetError proc~esmf_locstreamget->proc~esmf_logseterror

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_Field) :: humidity
      type(ESMF_LocStream) :: locs
      type(ESMF_DistGrid)  :: distgrid
      logical              :: arbIndex
      integer              :: elementCount
      integer, allocatable :: indexList(:)
      integer(ESMF_KIND_I4), pointer :: fptr(:,:,:)
      integer                        :: exlb(3), exub(3), i

      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 Comp Run starting"

      ! Get information from the component.
      call ESMF_StateGet(importState, "humidity", humidity, rc=rc)
      if(rc/=ESMF_SUCCESS) return

      call ESMF_FieldGet(humidity, 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

      call ESMF_FieldGet(humidity, localDe=0, farrayPtr=fptr, &
            exclusiveLBound=exlb, exclusiveUBound=exub, rc=rc)
      if(rc/=ESMF_SUCCESS) return

      ! Verify that the redist data in dstField(l) is correct.
      ! Before the FieldRedist op, the dst Field contains all 0. 
      ! The FieldRedist op reset the values to the index value or an positive
      ! integer, verify this is the case.
      do i = exlb(2), exub(2)
          if(fptr(1,i,1) .ne. indexList(i)*1) then
            print *, de_id, "ERROR ", indexList(i), " val(1,i,1) =", fptr(1,i,1)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,2) .ne. indexList(i)*2) then
            print *, de_id, "ERROR ", indexList(i), " val(1,i,2) =", fptr(1,i,2)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,3) .ne. indexList(i)*3) then
            print *, de_id, "ERROR ", indexList(i), " val(1,i,3) =", fptr(1,i,3)
            rc = ESMF_FAILURE
          endif
          if(fptr(1,i,4) .ne. indexList(i)*4) then
            print *, de_id, "ERROR ", indexList(i), " val(1,i,4) =", fptr(1,i,4)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,1) .ne. 1) then
            print *, de_id, "ERROR ", indexList(i), " val(2,i,1) =", fptr(2,i,1)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,2) .ne. 2) then
            print *, de_id, "ERROR ", indexList(i), " val(2,i,2) =", fptr(2,i,2)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,3) .ne. 3) then
            print *, de_id, "ERROR ", indexList(i), " val(2,i,3) =", fptr(2,i,3)
            rc = ESMF_FAILURE
          endif
          if(fptr(2,i,4) .ne. 4) then
            print *, de_id, "ERROR ", indexList(i), " val(2,i,4) =", fptr(2,i,4)
            rc = ESMF_FAILURE
          endif
      enddo

      deallocate(indexList)

      print *, de_id, "User Comp Run returning"

    end subroutine user_run