MAPL_GenericSetServices

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	Intent	Optional	Attributes		Name
type(ESMF_GridComp),	intent(inout)			::	GC	Gridded component
integer,	intent(out)			::	RC	Return code

Called by

Help

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

MAPL_GenericSetServices Subroutine

Contents

Source Code

public recursive subroutine MAPL_GenericSetServices(GC, RC)

Arguments

Calls

Called by

Source Code