SetServices Subroutine

public subroutine SetServices(GC, RC)

Sets IRF services for the Orb Grid Component. Sets Initialize, Run and Finalize services.

Arguments

Type IntentOptional Attributes Name
type(ESMF_GridComp), intent(inout) :: GC
integer, intent(out), optional :: RC

Calls

proc~~setservices~7~~CallsGraph proc~setservices~7 SetServices ESMF_ConfigCreate ESMF_ConfigCreate proc~setservices~7->ESMF_ConfigCreate ESMF_ConfigFindLabel ESMF_ConfigFindLabel proc~setservices~7->ESMF_ConfigFindLabel ESMF_ConfigGetAttribute ESMF_ConfigGetAttribute proc~setservices~7->ESMF_ConfigGetAttribute ESMF_ConfigGetDim ESMF_ConfigGetDim proc~setservices~7->ESMF_ConfigGetDim ESMF_ConfigLoadFile ESMF_ConfigLoadFile proc~setservices~7->ESMF_ConfigLoadFile ESMF_ConfigNextLine ESMF_ConfigNextLine proc~setservices~7->ESMF_ConfigNextLine ESMF_GridCompGet ESMF_GridCompGet proc~setservices~7->ESMF_GridCompGet ESMF_UserCompSetInternalState ESMF_UserCompSetInternalState proc~setservices~7->ESMF_UserCompSetInternalState interface~mapl_addexportspec MAPL_AddExportSpec proc~setservices~7->interface~mapl_addexportspec interface~mapl_am_i_root MAPL_Am_I_Root proc~setservices~7->interface~mapl_am_i_root interface~mapl_assert MAPL_Assert proc~setservices~7->interface~mapl_assert interface~mapl_timeradd MAPL_TimerAdd proc~setservices~7->interface~mapl_timeradd proc~mapl_genericsetservices MAPL_GenericSetServices proc~setservices~7->proc~mapl_genericsetservices proc~mapl_gridcompsetentrypoint MAPL_GridCompSetEntryPoint proc~setservices~7->proc~mapl_gridcompsetentrypoint proc~mapl_return MAPL_Return proc~setservices~7->proc~mapl_return proc~mapl_verify MAPL_Verify proc~setservices~7->proc~mapl_verify

Source Code

   SUBROUTINE SetServices ( GC, RC )

    type(ESMF_GridComp), intent(INOUT) :: GC  ! gridded component
    integer, intent(out), optional     :: RC  ! return code

!   Local derived type aliases
!   --------------------------
    type (Orb_State), pointer  :: self   ! internal, that is
    type (Orb_wrap)            :: wrap

    character(len=ESMF_MAXSTR) :: comp_name

    integer :: i, nCols
                            _Iam_('SetServices')
    integer :: status
    logical :: found
!                              ------------

!   Get my name and set-up traceback handle
!   ---------------------------------------
    call ESMF_GridCompGet( GC, name=comp_name, _RC )
    Iam = TRIM(comp_name) // '::' // TRIM(Iam)

!   Greetings
!   ---------
    IF(MAPL_AM_I_ROOT()) THEN
         PRINT *, TRIM(Iam)//': ACTIVE'
    END IF

!   Wrap internal state for storing in GC; rename legacyState
!   -------------------------------------
    allocate ( self, stat=STATUS )
    _VERIFY(STATUS)
    wrap%ptr => self

!   Load private Config Attributes
!   ------------------------------
    self%CF = ESMF_ConfigCreate(_RC)
    inquire(file="MAPL_OrbGridComp.rc", exist=found)
    if (found) then
       call ESMF_ConfigLoadFile ( self%CF,'MAPL_OrbGridComp.rc',rc=status)
       _VERIFY(STATUS)

       call ESMF_ConfigGetAttribute(self%CF, self%verbose, Label='verbose:', default=.false. ,  _RC )

!                       ------------------------
!                         Get Mask Definitions
!                       ------------------------

       call ESMF_ConfigGetDim(self%CF, self%no, nCols, LABEL='Nominal_Orbits::',_RC)
       _ASSERT(self%no>0,'needs informative message')
       allocate(self%Instrument(self%no), self%Satellite(self%no), &
          self%Swath(self%no), self%halo(self%no), __STAT__)
       if ( self%verbose .AND. MAPL_AM_I_ROOT() ) then
             write(*,*)"                                   Swath"
             write(*,*)"Instrument          Satellite       (km)        Halo Width"
             write(*,*)"---------------    -----------    ---------    -------------"
       end if
       call ESMF_ConfigFindLabel(self%CF, 'Nominal_Orbits::',_RC)
       do i = 1, self%no
          call ESMF_ConfigNextLine(self%CF,_RC)
          call ESMF_ConfigGetAttribute(self%CF,self%Instrument(i),_RC)
          call ESMF_ConfigGetAttribute(self%CF,self%Satellite(i),_RC)
          call ESMF_ConfigGetAttribute(self%CF,self%Swath(i),_RC)
          call ESMF_ConfigGetAttribute(self%CF,self%halo(i),_RC)
          if ( self%verbose .AND. MAPL_AM_I_ROOT() ) then
             write(*,'(1x,a15,4x,a11,4x,f9.1,4x,i3)') self%Instrument(i), self%Satellite(i), self%Swath(i), self%halo(i)
          end if
       end do
    else
       self%no = 0
    endif

!                       ------------------------
!                       ESMF Functional Services
!                       ------------------------

!   Set the Initialize, Run, Finalize entry points
!   ----------------------------------------------
    call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize_, RC=STATUS)
    _VERIFY(STATUS)
    call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN,   Run_,       RC=STATUS)
    _VERIFY(STATUS)

!   Store internal state in GC
!   --------------------------
    call ESMF_UserCompSetInternalState ( GC, 'Orb_state', wrap, STATUS )
    _VERIFY(STATUS)

!                         ------------------
!                         MAPL Data Services
!
    ! in addition to bundle add each instrument as export in case we want to write out in history
    do i=1,self%no
       call MAPL_AddExportSpec(GC, &
        SHORT_NAME     = trim(self%Instrument(i)) , &
        UNITS          = 'days' , &
        DIMS           = MAPL_DimsHorzOnly , &
                RC = STATUS )
    enddo

    call MAPL_AddExportSpec(GC, &
     SHORT_NAME     = 'SATORB', &
     LONG_NAME      = 'Satellite_orbits', &
     UNITS          = 'days' , &
     DIMS           = MAPL_DimsHorzOnly , &
     DATATYPE       = MAPL_BundleItem , &
                RC = STATUS )
    _VERIFY(STATUS)

    call MAPL_TimerAdd (gc,name="Run"     ,rc=status)

!   Generic Set Services
!   --------------------
    call MAPL_GenericSetServices ( GC, _RC )

!   All done
!   --------
    _RETURN(ESMF_SUCCESS)

  END SUBROUTINE SetServices