MAPL_GenericSetServices Subroutine

public recursive subroutine MAPL_GenericSetServices(GC, RC)

MAPL_GenericSetServices performs the following tasks:

  • Allocate an instance of MAPL_GenericState, wrap it, and set it as the GC’s internal state.
  • Exract the grid and configuration from the GC and save them in the generic state.
  • Set GC’s IRF methods to the generic versions
  • If there are children
  • Allocate a gridded comoponent and an import and export state for each child
  • Create each child’s GC using the natural grid and the inherited configuration.
  • Create each child’s Import and Export states. These are named GCNames(I)//"_IMPORT" and GCNames(I)//"_EXPORT".
  • Invoke each child’s set services.
  • Add each item in each child’s export state to GC’s export state.
  • Add each item in each child’s import state to GC’s import, eliminating duplicates.

Since MAPL_GenericSetServices calls SetServices for the children, which may be generic themselves, the routine must be recursive.

The optional arguments describe the component’s children. There can be any number of children but they must be of one of the types specified by the five SetServices entry points passed. If SSptr is not specified there can only be five children, one for each {\tt SSn}, and the names must be in SSn order.

Arguments

Type IntentOptional Attributes Name
type(ESMF_GridComp), intent(inout) :: GC

Gridded component

integer, intent(out) :: RC

Return code


Calls

proc~~mapl_genericsetservices~~CallsGraph proc~mapl_genericsetservices MAPL_GenericSetServices ESMF_AttributeSet ESMF_AttributeSet proc~mapl_genericsetservices->ESMF_AttributeSet ESMF_CplCompCreate ESMF_CplCompCreate proc~mapl_genericsetservices->ESMF_CplCompCreate ESMF_GridCompGet ESMF_GridCompGet proc~mapl_genericsetservices->ESMF_GridCompGet ESMF_UserCompGetInternalState ESMF_UserCompGetInternalState proc~mapl_genericsetservices->ESMF_UserCompGetInternalState esmf_cplcompsetservices esmf_cplcompsetservices proc~mapl_genericsetservices->esmf_cplcompsetservices interface~mapl_assert MAPL_Assert proc~mapl_genericsetservices->interface~mapl_assert interface~mapl_getobjectfromgc MAPL_GetObjectFromGC proc~mapl_genericsetservices->interface~mapl_getobjectfromgc interface~mapl_varspecaddreftolist~2 MAPL_VarSpecAddRefToList proc~mapl_genericsetservices->interface~mapl_varspecaddreftolist~2 interface~mapl_varspecget MAPL_VarSpecGet proc~mapl_genericsetservices->interface~mapl_varspecget interface~mapl_varspecgetindex MAPL_VarSpecGetIndex proc~mapl_genericsetservices->interface~mapl_varspecgetindex interface~mapl_varspecset MAPL_VarSpecSet proc~mapl_genericsetservices->interface~mapl_varspecset interface~write_parallel WRITE_PARALLEL proc~mapl_genericsetservices->interface~write_parallel none~checkreq VarConn%checkReq proc~mapl_genericsetservices->none~checkreq none~checkunused VarConn%checkUnused proc~mapl_genericsetservices->none~checkunused none~get_child_gridcomp MAPL_MetaComp%get_child_gridcomp proc~mapl_genericsetservices->none~get_child_gridcomp none~get_num_children~4 CompositeComponent%get_num_children proc~mapl_genericsetservices->none~get_num_children~4 none~start~84 DistributedProfiler%start proc~mapl_genericsetservices->none~start~84 none~varisconnected~2 VarConn%varIsConnected proc~mapl_genericsetservices->none~varisconnected~2 none~varislisted VarConn%varIsListed proc~mapl_genericsetservices->none~varislisted proc~mapl_cplcompsetvarspecs MAPL_CplCompSetVarSpecs proc~mapl_genericsetservices->proc~mapl_cplcompsetvarspecs proc~mapl_gridcompsetentrypoint MAPL_GridCompSetEntryPoint proc~mapl_genericsetservices->proc~mapl_gridcompsetentrypoint proc~mapl_internalstateretrieve MAPL_InternalStateRetrieve proc~mapl_genericsetservices->proc~mapl_internalstateretrieve proc~mapl_return MAPL_Return proc~mapl_genericsetservices->proc~mapl_return proc~mapl_varspecsameprec MAPL_VarSpecSamePrec proc~mapl_genericsetservices->proc~mapl_varspecsameprec proc~mapl_verify MAPL_Verify proc~mapl_genericsetservices->proc~mapl_verify

Called by

proc~~mapl_genericsetservices~~CalledByGraph proc~mapl_genericsetservices MAPL_GenericSetServices proc~setservices~2 SetServices proc~setservices~2->proc~mapl_genericsetservices proc~setservices~4 SetServices proc~setservices~4->proc~mapl_genericsetservices proc~setservices~5 SetServices proc~setservices~5->proc~mapl_genericsetservices proc~setservices~6 SetServices proc~setservices~6->proc~mapl_genericsetservices proc~setservices~7 SetServices proc~setservices~7->proc~mapl_genericsetservices

Source Code

   recursive subroutine MAPL_GenericSetServices ( GC, RC )

      !ARGUMENTS:
      type(ESMF_GridComp),                  intent(INOUT) :: GC  !! Gridded component
      integer,                              intent(  OUT) :: RC  !! Return code

      ! ErrLog Variables
      !-----------------
      integer                           :: status

      ! Local variables
      ! ---------------
      type (MAPL_MetaComp), pointer     :: meta
      type(ESMF_GridComp), pointer :: gridcomp

      !=============================================================================
      ! Begin...

      ! Create the generic state, intializing its configuration and grid.
      !----------------------------------------------------------
      call MAPL_InternalStateRetrieve( GC, meta, _RC)

      call meta%t_profiler%start('generic',_RC)

      call register_generic_entry_points(gc, _RC)
      call MAPL_GetRootGC(GC, meta%rootGC, _RC)
      call setup_children(meta, _RC)

      call process_spec_dependence(meta, _RC)
      call meta%t_profiler%stop('generic',_RC)

      _RETURN(ESMF_SUCCESS)

   contains

     subroutine process_spec_dependence(meta, rc)
       type (MAPL_MetaComp), target, intent(inout) :: meta
       integer, optional, intent(out) :: rc

       integer :: status
       integer :: k, i, j, nc, nvars
       logical :: depends_on_children
       character(len=:), allocatable :: depends_on(:)
       character(len=ESMF_MAXSTR) :: SHORT_NAME, NAME
       type (MAPL_VarSpec), pointer :: ex_specs(:), c_ex_specs(:)
       type (MAPL_MetaComp), pointer :: cmeta
       type(ESMF_GridComp), pointer :: childgridcomp
       logical :: found

       ! get the export specs
       call  MAPL_StateGetVarSpecs(meta, export=ex_specs, _RC)
       ! allow for possibility we do not have export specs
       _RETURN_IF(.not. associated(ex_specs))

       ! check for DEPENDS_ON_CHILDREN
       do K=1,size(EX_SPECS)
          call MAPL_VarSpecGet(EX_SPECS(K), SHORT_NAME=SHORT_NAME, &
               DEPENDS_ON_CHILDREN=DEPENDS_ON_CHILDREN, &
               DEPENDS_ON=DEPENDS_ON, _RC)
          if (DEPENDS_ON_CHILDREN) then
!             mark SHORT_NAME in each child "alwaysAllocate"
             nc = meta%get_num_children()
             _ASSERT(nc > 0, 'DEPENDS_ON_CHILDREN requires at least 1 child')
             do I=1, nc
                childgridcomp => meta%get_child_gridcomp(i)
                call MAPL_InternalStateRetrieve(childgridcomp, cmeta, _RC)
                found = .false.
                call  MAPL_StateGetVarSpecs(cmeta, export=c_ex_specs, _RC)
                _ASSERT(associated(c_ex_specs), 'Component '//trim(cmeta%compname)//' must have a valid export spec')
                ! find the "correct" export spec (i.e. has the same SHORT_NAME)
                do j=1,size(c_ex_specs)
                   call MAPL_VarSpecGet(c_ex_specs(j), SHORT_NAME=NAME, _RC)
                   if (short_name == name) then
                      call MAPL_VarSpecSet(c_ex_specs(j), alwaysAllocate=.true., _RC)
                      found = .true.
                      exit
                   end if
                end do ! spec loop
                _ASSERT(found, 'All children must have '//trim(short_name))
             end do
          end if ! DEPENDS_ON_CHILDREN

          if (allocated(depends_on)) then
!             mark SHORT_NAME in each variable "alwaysAllocate"
             nvars = size(depends_on)
             _ASSERT(nvars > 0, 'DEPENDS_ON requires at least 1 var')
             do I=1, nvars
                ! find the "correct" export spec (i.e. has the same SHORT_NAME)
                do j=1,size(ex_specs)
                   call MAPL_VarSpecGet(ex_specs(j), SHORT_NAME=NAME, _RC)
                   if (name == depends_on(i)) then
                      call MAPL_VarSpecSet(ex_specs(j), alwaysAllocate=.true., _RC)
                      exit
                   end if
                end do ! spec loop
             end do
          end if ! DEPENDS_ON
       end do

       _RETURN(ESMF_SUCCESS)
     end subroutine process_spec_dependence

      subroutine register_generic_entry_points(gc, rc)
         type(ESMF_GridComp), intent(inout) :: gc
         integer, optional, intent(out) :: rc

         integer :: status

         if (.not. associated(meta%phase_init)) then
            call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_INITIALIZE, MAPL_GenericInitialize,  _RC)
         endif

         if (.not. associated(meta%phase_run)) then
            call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_RUN, MAPL_GenericRunChildren,  _RC)
         endif


         if (.not. associated(meta%phase_final)) then
            call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_FINALIZE, MAPL_GenericFinalize,  _RC)
         endif

         !ALT check record!
         if (.not. associated(meta%phase_record)) then
            call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_WRITERESTART, MAPL_GenericRecord, _RC)
         end if
         _ASSERT(size(meta%phase_record)==1,'needs informative message')  !ALT: currently we support only 1 record

         if (.not.associated(meta%phase_coldstart)) then
            !ALT: this part is not supported yet
            !      call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_READRESTART, &
            !                                      MAPL_Coldstart, _RC)
         endif
      end subroutine register_generic_entry_points

#define LOWEST_(c) m=0; do while (m /= c) ;\
      m = c; c=label(c);\
   enddo

      ! Complex algorithm - difficult to explain
      recursive subroutine setup_children(meta, rc)
         type (MAPL_MetaComp), target, intent(inout) :: meta
         integer, optional, intent(out) :: rc

         integer :: nc
         integer :: i
         integer :: ts
         integer :: lbl, k, m
         type (VarConn), pointer :: connect
         type(StateSpecification) :: specs
         type (MAPL_VarSpec), pointer :: im_specs(:)
         type (MAPL_VarSpec), pointer :: ex_specs(:)
         type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:)
         type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:)
         type(ESMF_Field), pointer :: field
         type(ESMF_FieldBundle), pointer :: bundle
         type(ESMF_State), pointer :: state
         integer :: fLBL, tLBL
         integer :: good_label, bad_label
         integer, pointer :: label(:)

         NC = meta%get_num_children()
         CHILDREN: if(nc > 0) then

            do I=1,NC
               call MAPL_GenericStateClockAdd(GC, name=trim(meta%GCNameList(I)), _RC)
            end do


            ! The child should've been already created by MAPL_AddChild
            ! and set his services should've been called.
            ! -------------------------------------

            ! Create internal couplers and composite
            ! component's Im/Ex specs.
            !---------------------------------------

            call MAPL_WireComponent(GC, _RC)

            ! Relax connectivity for non-existing imports
            if (NC > 0) then

               CONNECT => meta%connectList%CONNECT

               allocate (ImSpecPtr(NC), ExSpecPtr(NC), __STAT__)

               DO I = 1, NC
                  gridcomp => meta%get_child_gridcomp(i)
                  call MAPL_GridCompGetVarSpecs(gridcomp, &
                       IMPORT=IM_SPECS, EXPORT=EX_SPECS, _RC)
                  ImSpecPtr(I)%Spec => IM_SPECS
                  ExSpecPtr(I)%Spec => EX_SPECS
               END DO

               call connect%checkReq(ImSpecPtr, ExSpecPtr, _RC)

               deallocate (ImSpecPtr, ExSpecPtr)

            end if

            ! If I am root call Label from here; everybody else
            !  will be called recursively from Label
            !--------------------------------------------------
            ROOT: if (.not. associated(meta%parentGC)) then

               call MAPL_GenericConnCheck(GC, _RC)

               ! Collect all IMPORT and EXPORT specs in the entire tree in one list
               !-------------------------------------------------------------------
               call MAPL_GenericSpecEnum(GC, SPECS, _RC)

               ! Label each spec by its place on the list--sort of.
               !--------------------------------------------------

               TS = SPECS%var_specs%size()
               allocate(LABEL(TS), __STAT__)

               do I = 1, TS
                  LABEL(I)=I
               end do

               ! For each spec...
               !-----------------

               do I = 1, TS

                  !  Get the LABEL attribute on the spec
                  !-------------------------------------
                  call MAPL_VarSpecGet(SPECS%old_var_specs(I), LABEL=LBL, _RC)
                  _ASSERT(LBL > 0, "GenericSetServices :: Expected LBL > 0.")

                  ! Do something to sort labels???
                  !-------------------------------
                  LOWEST_(LBL)

                  good_label = min(lbl, i)
                  bad_label = max(lbl, i)
                  label(bad_label) = good_label


               end do

               if (associated(meta%LINK)) then
                  do I = 1, size(meta%LINK)
                     fLBL = MAPL_LabelGet(meta%LINK(I)%ptr%FROM, _RC)
                     tLBL = MAPL_LabelGet(meta%LINK(I)%ptr%TO,   _RC)
                     LOWEST_(fLBL)
                     LOWEST_(tLBL)

                     if (fLBL < tLBL) then
                        good_label = fLBL
                        bad_label  = tLBL
                     else
                        good_label = tLBL
                        bad_label  = fLBL
                     end if
                     label(bad_label) = good_label
                  end do
               end if

               K=0
               do I = 1, TS
                  LBL = LABEL(I)
                  LOWEST_(LBL)

                  if (LBL == I) then
                     K = K+1
                  else
                     call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), FIELDPTR = FIELD, _RC)
                     call MAPL_VarSpecSet(SPECS%old_var_specs(I), FIELDPTR = FIELD, _RC)
                     call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), BUNDLEPTR = BUNDLE, _RC  )
                     call MAPL_VarSpecSet(SPECS%old_var_specs(I), BUNDLEPTR = BUNDLE, _RC  )
                     call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), STATEPTR = STATE, _RC  )
                     call MAPL_VarSpecSet(SPECS%old_var_specs(I), STATEPTR = STATE, _RC  )
                  end if

                  call MAPL_VarSpecSet(SPECS%old_var_specs(I), LABEL=LBL, _RC)
               end do

               deallocate(LABEL, __STAT__)

            end if ROOT

         end if CHILDREN  !  Setup children
      end subroutine setup_children
#undef LOWEST_

   end subroutine MAPL_GenericSetServices