user_model2.F90 Source File


Source Code

! $Id$
!
! Example/test code which shows User Component calls.

!--------------------------------------------------------------------------------
!--------------------------------------------------------------------------------

!BOP
!
! !DESCRIPTION:
!  User-supplied Component
!
!
!\begin{verbatim}

    module user_model2

    ! ESMF Framework module
    use ESMF

    implicit none
    
    public userm2_register
        
    type mylocaldata
      integer :: dataoffset
    end type

    type wrapper
      type(mylocaldata), pointer :: ptr
    end type

    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 userm2_register(comp, rc)
        type(ESMF_GridComp) :: comp
        integer :: rc

        ! local variables
        type(mylocaldata), pointer :: mydatablock
        type(wrapper) :: wrap

        print *, "In user register routine"

        ! Register the callback routines.

        call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, user_init, rc=rc)
        call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, user_run, rc=rc)
        call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, user_final, rc=rc)

        print *, "Registered Initialize, Run, and Finalize routines"

        allocate(mydatablock)

        mydatablock%dataoffset = 52

        wrap%ptr => mydatablock
        call ESMF_GridCompSetInternalState(comp, wrap, rc)

        print *, "Registered Private Data block for Internal State"

        rc = ESMF_SUCCESS

    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), intent(inout) :: comp
      type(ESMF_State), intent(inout) :: importState, exportState
      type(ESMF_Clock), intent(in) :: clock
      integer, intent(out) :: rc

!   ! Local variables
      type(ESMF_Field) :: humidity
      type(ESMF_VM) :: vm
      type(ESMF_DELayout) :: delayout
      type(ESMF_FieldDataMap) :: datamap
      type(ESMF_IGrid) :: igrid1
      type(ESMF_ArraySpec) :: arrayspec
      real(ESMF_KIND_R8), dimension(:,:,:), pointer :: idata
      real(ESMF_KIND_R8) :: min(2)
      real(ESMF_KIND_R8) :: delta1(40), delta2(50)
      integer :: countsPerDE1(3), countsPerDE2(2), order(3), counts(3)
      integer :: npets, de_id
      type(ESMF_IGridHorzStagger) :: horz_stagger
      integer :: status

      print *, "User Comp Init starting"

      ! Query component for VM and create a layout with the right breakdown
      call ESMF_GridCompGet(comp, vm=vm, rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10
      call ESMF_VMGet(vm, petCount=npets, rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10
      delayout = ESMF_DELayoutCreate(vm, (/ npets/2, 2 /), rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10

      ! and get our local de number
      call ESMF_DELayoutGetDeprecated(delayout, localDE=de_id, rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10


      ! Add a "humidity" field to the import state.
      countsPerDE1 = (/ 10, 18, 12 /)
      countsPerDE2 = (/ 22, 28 /)
      counts       = (/  4, 40, 50 /)
      min(1) = 0.0
      delta1 = (/ 1.0, 1.0, 1.0, 1.1, 1.1, 1.1, 1.2, 1.2, 1.3, 1.4, &
                  1.4, 1.5, 1.6, 1.6, 1.6, 1.8, 1.8, 1.7, 1.7, 1.6, &
                  1.6, 1.6, 1.8, 1.8, 2.0, 2.0, 2.2, 2.2, 2.2, 2.2, &
                  2.0, 1.7, 1.5, 1.3, 1.2, 1.1, 1.0, 1.0, 1.0, 0.9 /)
      min(2) = 0.0
      delta2 = (/ 0.8, 0.8, 0.8, 0.8, 0.8, 0.7, 0.7, 0.6, 0.7, 0.8, &
                  0.9, 0.9, 0.9, 0.9, 1.0, 1.0, 1.0, 1.0, 0.9, 1.0, &
                  1.0, 1.0, 1.0, 1.1, 1.2, 1.3, 1.3, 1.3, 1.4, 1.4, &
                  1.4, 1.4, 1.4, 1.4, 1.4, 1.3, 1.3, 1.3, 1.2, 1.2, &
                  1.1, 1.0, 1.0, 0.9, 0.8, 0.7, 0.6, 0.6, 0.5, 0.5 /)

      horz_stagger = ESMF_IGRID_HORZ_STAGGER_D_NE

      igrid1 = ESMF_IGridCreateHorzXY(minGlobalCoordPerDim=min, &
                                    delta1=delta1, delta2=delta2, &
                                    horzStagger=horz_stagger, &
                                    name="source igrid", rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10
      call ESMF_IGridDistribute(igrid1, delayout=delayout, &
                               countsPerDEDim1=countsPerDE1, &
                               countsPerDEDim2=countsPerDE2, &
                               rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10

      ! Set up a 3D real array
      call ESMF_ArraySpecSet(arrayspec, rank=3, &
                             typekind=ESMF_TYPEKIND_R8)

      ! Create a datamap
      order(1) = 0
      order(2) = 1
      order(3) = 2
      call ESMF_FieldDataMapSetDefault(datamap, 3, order, horzRelloc=ESMF_CELL_NFACE, &
                                   counts=counts(1:1), rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10

      ! Create the field 
      humidity = ESMF_FieldCreate(igrid1, arrayspec=arrayspec, datamap=datamap, &
                                  haloWidth=0, name="humidity", rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10

      ! Get the allocated array back and get an F90 array pointer
      call ESMF_FieldGetDataPointer(humidity, idata, rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10

      call ESMF_StateAddField(importState, (/humidity/), rc=status)
      if (status .ne. ESMF_SUCCESS) goto 10
   !   call ESMF_StatePrint(importState, rc=status)

      print *, "User Comp Init returning"
   
10 continue
      rc = status

    end subroutine user_init


!-------------------------------------------------------------------------------
!   !  The Run routine where data is computed.
!   !
 
    subroutine user_run(comp, importState, exportState, clock, rc)
      type(ESMF_GridComp), intent(inout) :: comp
      type(ESMF_State), intent(inout) :: importState, exportState
      type(ESMF_Clock), intent(in) :: clock
      integer, intent(out) :: rc

!   ! Local variables
      type(ESMF_Field) :: humidity
      integer :: status

      print *, "User Comp Run starting"

      ! Get information from the component.
  !    call ESMF_StatePrint(importState, rc=status)
      call ESMF_StateGetField(importState, "humidity", humidity, rc=status)
  !    call ESMF_FieldPrint(humidity, "", rc=status)
    
      ! This is where the model specific computation goes.
      print *, "Imported Array in user model 2:"

      print *, "User Comp Run returning"

      rc = status

    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), intent(inout) :: comp
      type(ESMF_State), intent(inout) :: importState, exportState
      type(ESMF_Clock), intent(in) :: clock
      integer, intent(out) :: rc

      ! Local variables
      integer :: status
      type(ESMF_Field) :: field
      integer :: localrc, finalrc
      type(mylocaldata), pointer :: mydatablock
      type(wrapper) :: wrap

      print *, "User Comp Final starting"  

      ! set this up to run the validate code on all fields
      ! so we can see and compare the output.  but if any of
      ! the verify routines return error, return error at the end.
      finalrc = ESMF_SUCCESS

      ! Get our local info
      nullify(wrap%ptr)
      mydatablock => wrap%ptr
        
      call ESMF_GridCompGetInternalState(comp, wrap, status)

      mydatablock => wrap%ptr
      print *, "before deallocate, dataoffset = ", mydatablock%dataoffset

      ! check validity of results
      ! Get Fields from import state
      call ESMF_StateGetField(importState, "humidity", field, rc=rc)
      if (rc .ne. ESMF_SUCCESS) then
        finalrc = ESMF_FAILURE
        goto 30
      endif
      call verifyResults(field, localrc)
      if (localrc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE

      deallocate(mydatablock, stat=status)
      print *, "deallocate returned ", status
      nullify(wrap%ptr)

30 continue
      ! come straight here if you cannot get the data from the state.
      ! otherwise error codes are accumulated but ignored until the
      ! end so we can see the output from all the cases to help track
      ! down errors.

      print *, "User Comp Final returning"
      rc = finalrc
   
    end subroutine user_final

!--------------------------------------------------------------------------------
!   !  The routine where results are validated.
!   !
 
    subroutine verifyResults(humidity, rc)
      type(ESMF_Field), intent(inout) :: humidity
      integer, intent(out) :: rc

      ! Local variables
      integer :: status, i, j, k, myDE, counts(2)
      type(ESMF_RelLoc) :: relloc
      type(ESMF_IGrid) :: igrid
      real(ESMF_KIND_R8) :: pi, error, maxError, maxPerError
      real(ESMF_KIND_R8) :: minCValue, maxCValue, minDValue, maxDValue
      real(ESMF_KIND_R8), dimension(:,:), pointer :: calc, coordX, coordY
      real(ESMF_KIND_R8), dimension(:,:,:), pointer :: data

      print *, "User verifyResults starting"  

      pi = 3.14159

      ! get the igrid and coordinates
      call ESMF_FieldGet(humidity, igrid=igrid, horzRelloc=relloc, rc=status)
      call ESMF_IGridGetDELocalInfo(igrid, myDE=myDE, &
                                   localCellCountPerDim=counts, &
                                   horzRelloc=ESMF_CELL_CENTER, rc=status)
      call ESMF_IGridGetCoord(igrid, dim=1, horzRelloc=relloc, &
                             centerCoord=coordX, rc=status)
      call ESMF_IGridGetCoord(igrid, dim=2, horzRelloc=relloc, &
                             centerCoord=coordY, rc=status)

      ! update field values here
      ! Get a pointer to the start of the data
      call ESMF_FieldGetDataPointer(humidity, data, ESMF_DATACOPY_REFERENCE, rc=rc)

      ! allocate array for computed results and fill it
      allocate(calc(counts(1), counts(2)))
      do j   = 1,counts(2)
        do i = 1,counts(1)
          calc(i,j) = 10.0 + 5.0*sin(coordX(i,j)/60.0*pi) &
                           + 2.0*sin(coordY(i,j)/50.0*pi)
        enddo
      enddo

     ! calculate data error from computed results
      maxError    = 0.0
      maxPerError = 0.0
      maxCValue   = 0.0
      minCValue   = 1000.0
      maxDValue   = 0.0
      minDValue   = 1000.0
      do k     = 1,size(data,1)
        do j   = 1,counts(2)
          do i = 1,counts(1)
            error       = abs(data(k,i,j)) - abs(calc(i,j))
            minCValue   = min(minCValue, abs(calc(i,j)))
            maxCValue   = max(maxCValue, abs(calc(i,j)))
            minDValue   = min(minDValue, abs(data(k,i,j)))
            maxDValue   = max(maxDValue, abs(data(k,i,j)))
            maxError    = max(maxError, abs(error))
            maxPerError = max(maxPerError, 100.*abs(error)/abs(calc(i,j)))
          enddo
        enddo
      enddo

      write(*,*) "Results for DE #", myDE, ":"
      write(*,*) "   minimum regridded value = ", minDValue
      write(*,*) "   maximum regridded value = ", maxDValue
      write(*,*) "   minimum computed value  = ", minCValue
      write(*,*) "   maximum computed value  = ", maxCValue
      write(*,*) "   maximum error           = ", maxError
      write(*,*) "   maximum percent error   = ", maxPerError
      print *, "User verifyResults returning"
   
      ! only accept this test as successful if the max percent
      ! error is below 2%
      if (maxPerError .gt. 2.0) then
          write(*,*) "Test Failing because percentage error too large"
          rc = ESMF_FAILURE 
      else
          rc = ESMF_SUCCESS
      endif

    end subroutine verifyResults


    end module user_model2
    
!\end{verbatim}