MAPL_GenericFinalize Subroutine

public recursive subroutine MAPL_GenericFinalize(GC, IMPORT, EXPORT, CLOCK, RC)

Arguments

Type IntentOptional Attributes Name
type(ESMF_GridComp), intent(inout) :: GC
type(ESMF_State), intent(inout) :: IMPORT
type(ESMF_State), intent(inout) :: EXPORT
type(ESMF_Clock), intent(inout) :: CLOCK
integer, intent(out), optional :: RC

Calls

MAPL_GenericFinalizewArrDescrCreateReaderComm
w
wArrDescrCreateWriterComm
w
wArrDescrSet
w
wCompositeComponent%get_num_children
w
wDistributedProfiler%reduce
w
wESMF_AttributeGet
w
wESMF_ClockGet
w
wESMF_GridCompFinalize
w
wESMF_GridCompGet
w
wESMF_GridGet
w
wesmf_statedestroy
w
wesmf_stateget
w
wesmf_stateiscreated
w
wESMF_TimeGet
w
wESMF_UtilStringLowerCase
w
wESMF_VMGetCurrent
w
wfill_grads_template
w
wFREE_FILE
w
wget_global_time_profiler
w
wGETFILE
w
wLogger%info
w
wLogger%warning
w
wMAPL_Am_I_Root
w
wMAPL_Assert
w
wMAPL_GetLogger
w
wMAPL_GetObjectFromGC
w
wMAPL_GetResource
w
wMAPL_GridGet
w
wMAPL_InternalStateRetrieve
w
wMAPL_LocStreamGet
w
wMAPL_LocStreamIsAssociated
w
wMAPL_MetaComp%get_child_export_state
w
wMAPL_MetaComp%get_child_gridcomp
w
wMAPL_MetaComp%get_child_import_state
w
wMAPL_ProfIsDisabled
w
wMAPL_Return
w
wMAPL_SunOrbitDestroy
w
wMAPL_TimerOff
w
wMAPL_TimerOn
w
wMAPL_VarSpecDestroy
w
wMAPL_VarWrite
w
wMAPL_VarWriteNCPar
w
wMAPL_Verify
w
wMaplGenericComponent%get_internal_state
w
wmpi_barrier
w
wmpi_comm_rank
w
wmpi_file_close
w
wmpi_file_open
w
wmpi_info_create
w
wmpi_info_free
w
wmpi_info_set
w
wMultiColumn%add_column
w
wProfileReporter%generate_report
w
wWRITE_PARALLEL
w

Source Code

   recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC )

      !ARGUMENTS:
      type(ESMF_GridComp), intent(inout) :: GC     ! composite gridded component
      type(ESMF_State),    intent(inout) :: IMPORT ! import state
      type(ESMF_State),    intent(inout) :: EXPORT ! export state
      type(ESMF_Clock),    intent(inout) :: CLOCK  ! the clock
      integer, optional,   intent(  out) :: RC     ! Error code:
      ! = 0 all is well
      ! otherwise, error
      !EOPI

      ! LOCAL VARIABLES

      character(len=ESMF_MAXSTR)                  :: IAm
      character(len=ESMF_MAXSTR)                  :: comp_name
      integer                                     :: status
      integer                                     :: userRC

      character(len=ESMF_MAXSTR)                  :: FILENAME
      character(len=ESMF_MAXSTR)                  :: FILETYPE
      character(len=ESMF_MAXSTR)                  :: CHILD_NAME
      character(len=ESMF_MAXSTR)                  :: RECFIN
      type (MAPL_MetaComp), pointer               :: STATE
      integer                                     :: I
      logical                                     :: final_checkpoint
#ifndef H5_HAVE_PARALLEL
      logical                                     :: nwrgt1
#endif
      integer                                     :: NC
      integer                                     :: PHASE
      integer                                     :: NUMPHASES
      integer                                     :: MAXPHASES
      type (MAPL_MetaPtr), allocatable            :: CHLDMAPL(:)
      integer                                     :: hdr
      integer                                     :: yyyymmdd, hhmmss
      integer                                     :: year, month, day, hh, mm, ss
      character(len=ESMF_MAXSTR)                  :: tmp_label, FILEtpl
      character(len=ESMF_MAXSTR)                  :: id_string
      integer                                     :: ens_id_width
      type(ESMF_Time)                             :: CurrTime
      class(BaseProfiler), pointer                :: t_p
      type(ESMF_GridComp), pointer :: gridcomp
      type(ESMF_State), pointer :: child_import_state
      type(ESMF_State), pointer :: child_export_state
      type(ESMF_State), pointer :: internal_state
      !=============================================================================

      !  Begin...

      _UNUSED_DUMMY(EXPORT)

      Iam = "MAPL_GenericFinalize"
      call ESMF_GridCompGet(GC, name=comp_name, RC=status )
      _VERIFY(status)
      Iam = trim(comp_name) // Iam


      ! Retrieve the pointer to the state
      !----------------------------------
      call MAPL_InternalStateRetrieve(GC, STATE, RC=status)
      _VERIFY(status)

      ! Finalize the children
      ! ---------------------

      t_p => get_global_time_profiler()

      NC = STATE%get_num_children()
      allocate(CHLDMAPL(NC), stat=status)
      MAXPHASES = 0
      do I=1,NC
         gridcomp => STATE%GET_CHILD_GRIDCOMP(I)
         call MAPL_GetObjectFromGC(gridcomp, CHLDMAPL(I)%PTR, RC=status)
         _VERIFY(status)
         MAXPHASES = max(MAXPHASES, size(CHLDMAPL(I)%PTR%PHASE_FINAL))
      end do

      do PHASE = 1, MAXPHASES
         do I=1,NC
            NUMPHASES = size(CHLDMAPL(I)%PTR%PHASE_FINAL)
            if (PHASE .le. NUMPHASES) then
               gridcomp => STATE%GET_CHILD_GRIDCOMP(I)
               call ESMF_GridCompGet( gridcomp, NAME=CHILD_NAME, RC=status )
               _VERIFY(status)

               call MAPL_TimerOn (STATE,trim(CHILD_NAME))
               child_import_state => STATE%get_child_import_state(i)
               child_export_state => STATE%get_child_export_state(i)
               call ESMF_GridCompFinalize (gridcomp, &
                    importState=child_import_state, &
                    exportState=child_export_state, &
                    clock=CLOCK, PHASE=CHLDMAPL(I)%PTR%PHASE_FINAL(PHASE), &
                    userRC=userRC, _RC)
               _VERIFY(userRC)
               call MAPL_TimerOff(STATE,trim(CHILD_NAME),_RC)
            end if
         enddo
      end do
      deallocate(CHLDMAPL)

      call MAPL_TimerOn(STATE,"generic")

      call MAPL_GetResource( STATE, RECFIN, LABEL="RECORD_FINAL:", &
           RC=status )
      final_checkpoint = .true.
      IF (status == ESMF_SUCCESS) then
         IF (RECFIN == "NO")  final_checkpoint = .false.
      END IF

      if (final_checkpoint) then
         ! Checkpoint the internal state if required.
         !------------------------------------------

         call ESMF_ClockGet (clock, currTime=currTime, rc=status)
         _VERIFY(status)
         call ESMF_TimeGet( currTime, YY = YEAR, MM = MONTH, DD = DAY, H=HH, M=MM, S=SS, rc = status  )
         _VERIFY(status)

         yyyymmdd = year*10000 + month*100 + day
         hhmmss   = HH*10000 + MM*100 + SS

         call MAPL_GetResource( STATE, ens_id_width,         &
              LABEL="ENS_ID_WIDTH:", default=0, &
              RC=status)

         id_string=""
         tmp_label = "INTERNAL_CHECKPOINT_FILE:"
         call MAPL_GetResource( STATE   , FILEtpl,         &
              LABEL=trim(tmp_label), &
              RC=status)
         if((status /= ESMF_SUCCESS) .and. ens_id_width>0) then
            i = len(trim(comp_name))
            id_string = comp_name(i-ens_id_width+1:i)
            tmp_label =comp_name(1:i-ens_id_width)//"_"//trim(tmp_label)
            call MAPL_GetResource( STATE   , FILEtpl,       &
                 LABEL=trim(tmp_label), &
                 RC=status)
         endif

         if(status==ESMF_SUCCESS) then
            ! if the filename is tempate
            call fill_grads_template(filename,trim(adjustl(filetpl)),experiment_id=trim(id_string), nymd=yyyymmdd,nhms=hhmmss,rc=status)
            call    MAPL_GetResource( STATE, FILETYPE, LABEL="INTERNAL_CHECKPOINT_TYPE:",                RC=status )
            if ( status/=ESMF_SUCCESS  .or.  FILETYPE == "default" ) then
               call MAPL_GetResource( STATE, FILETYPE, LABEL="DEFAULT_CHECKPOINT_TYPE:", default='pnc4', RC=status )
               _VERIFY(status)
            end if
            FILETYPE = ESMF_UtilStringLowerCase(FILETYPE,rc=status)
            _VERIFY(status)
#ifndef H5_HAVE_PARALLEL
            nwrgt1 = ((state%grid%num_readers > 1) .or. (state%grid%num_writers > 1))
            if(FILETYPE=='pnc4' .and. nwrgt1) then
               print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel'
               _FAIL('needs informative message')
            endif
#endif
            call MAPL_GetResource( STATE   , hdr,         &
                 default=0, &
                 LABEL="INTERNAL_HEADER:", &
                 RC=status)
            _VERIFY(status)
            internal_state => state%get_internal_state()
            call MAPL_ESMFStateWriteToFile(internal_state,CLOCK,FILENAME, &
                 FILETYPE, STATE, hdr/=0, state%grid%write_restart_by_oserver, RC=status)
            _VERIFY(status)
         endif

         ! Checkpoint the import state if required.
         !----------------------------------------

         call       MAPL_GetResource( STATE, FILENAME, LABEL="IMPORT_CHECKPOINT_FILE:",                  RC=status )
         if(status==ESMF_SUCCESS) then
            call    MAPL_GetResource( STATE, FILETYPE, LABEL="IMPORT_CHECKPOINT_TYPE:",                  RC=status )
            if ( status/=ESMF_SUCCESS  .or.  FILETYPE == "default" ) then
               call MAPL_GetResource( STATE, FILETYPE, LABEL="DEFAULT_CHECKPOINT_TYPE:", default='pnc4', RC=status )
               _VERIFY(status)
            end if
            FILETYPE = ESMF_UtilStringLowerCase(FILETYPE,rc=status)
            _VERIFY(status)
#ifndef H5_HAVE_PARALLEL
            nwrgt1 = ((state%grid%num_readers > 1) .or. (state%grid%num_writers > 1))
            if(FILETYPE=='pnc4' .and. nwrgt1) then
               print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel'
               _FAIL('needs informative message')
            endif
#endif
            call MAPL_ESMFStateWriteToFile(IMPORT,CLOCK,FILENAME, &
                 FILETYPE, STATE, .FALSE., state%grid%write_restart_by_oserver, RC=status)
            _VERIFY(status)
         endif

         ! Checkpoint the export state if required.
         !----------------------------------------
         call checkpoint_export_state(_RC)
      end if

      call MAPL_TimerOff(STATE,"generic",_RC)

      ! Write summary of profiled times
      !--------------------------------

      call state%t_profiler%stop('Finalize',_RC)
      call state%t_profiler%stop(_RC)

      if (.not. MAPL_ProfIsDisabled()) then
         call report_generic_profile()
      end if

      call t_p%stop(trim(state%compname),_RC)

      ! Clean-up
      !---------
      !ALT
      call MAPL_GenericStateDestroy (STATE,  RC=status)
      _VERIFY(status)

      _RETURN(ESMF_SUCCESS)

   contains

      subroutine checkpoint_export_state(rc)
         integer, optional,   intent(  out) :: RC     ! Error code:

         call       MAPL_GetResource( STATE, FILENAME, LABEL="EXPORT_CHECKPOINT_FILE:",                  RC=status )
         if(status==ESMF_SUCCESS) then
            call    MAPL_GetResource( STATE, FILETYPE, LABEL="EXPORT_CHECKPOINT_TYPE:",                  RC=status )
            if ( status/=ESMF_SUCCESS  .or.  FILETYPE == "default" ) then
               call MAPL_GetResource( STATE, FILETYPE, LABEL="DEFAULT_CHECKPOINT_TYPE:", default='pnc4', RC=status )
               _VERIFY(status)
            end if
            FILETYPE = ESMF_UtilStringLowerCase(FILETYPE,rc=status)
            _VERIFY(status)
#ifndef H5_HAVE_PARALLEL
            nwrgt1 = ((state%grid%num_readers > 1) .or. (state%grid%num_writers > 1))
            if(FILETYPE=='pnc4' .and. nwrgt1) then
               if (mapl_am_i_root()) then
                  print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel'
               end if
               _FAIL('needs informative message')
            endif
#endif
            call MAPL_ESMFStateWriteToFile(EXPORT,CLOCK,FILENAME, &
                 FILETYPE, STATE, .FALSE., state%grid%write_restart_by_oserver, RC=status)
            _VERIFY(status)
         endif
         _RETURN(_SUCCESS)
      end subroutine checkpoint_export_state

      subroutine report_generic_profile( rc )
         integer, optional,   intent(  out) :: RC     ! Error code:
         character(:), allocatable :: report(:)
         type (ProfileReporter) :: reporter
         type (MultiColumn) :: min_multi, mean_multi, max_multi, pe_multi, n_cyc_multi
         type (ESMF_VM) :: vm
         character(1) :: empty(0)
         class(Logger), pointer :: lgr

         call ESMF_VmGetCurrent(vm, rc=status)
         _VERIFY(status)

         lgr => logging%get_logger('MAPL.profiler')

         ! Generate stats _across_ processes covered by this timer
         ! Requires consistent call trees for now.

         call state%t_profiler%reduce()

         if  (MAPL_AM_I_Root(vm)) then
            reporter = ProfileReporter(empty)
            call reporter%add_column(NameColumn(25, separator=" "))

            min_multi = MultiColumn(['Min'], separator='=')
            call min_multi%add_column(FormattedTextColumn('   %  ','(f6.2)', 6, PercentageColumn(ExclusiveColumn('MIN')), separator='-'))
            call min_multi%add_column(FormattedTextColumn('inclusive', '(f10.2)', 10, InclusiveColumn('MIN'), separator='-'))
            call min_multi%add_column(FormattedTextColumn('exclusive', '(f10.2)',10, ExclusiveColumn('MIN'), separator='-'))

            mean_multi = MultiColumn(['Mean'], separator='=')
            call mean_multi%add_column(FormattedTextColumn('   %  ','(f6.2)', 6, PercentageColumn(ExclusiveColumn('MEAN')), separator='-'))
            call mean_multi%add_column(FormattedTextColumn('inclusive', '(f10.2)', 10, InclusiveColumn('MEAN'), separator='-'))
            call mean_multi%add_column(FormattedTextColumn('exclusive', '(f10.2)', 10, ExclusiveColumn('MEAN'), separator='-'))

            max_multi = MultiColumn(['Max'], separator='=')
            call max_multi%add_column(FormattedTextColumn('   %  ','(f6.2)', 6, PercentageColumn(ExclusiveColumn('MAX')), separator='-'))
            call max_multi%add_column(FormattedTextColumn('inclusive', '(f10.2)', 10, InclusiveColumn('MAX'), separator='-'))
            call max_multi%add_column(FormattedTextColumn('exclusive', '(f10.2)', 10, ExclusiveColumn('MAX'), separator='-'))

            pe_multi = MultiColumn(['PE'], separator='=')
            call pe_multi%add_column(FormattedTextColumn('max','(1x,i5.5)', 6, ExclusiveColumn('MAX_PE'), separator='-'))
            call pe_multi%add_column(FormattedTextColumn('min','(1x,i5.5)', 6, ExclusiveColumn('MIN_PE'),separator='-'))

            n_cyc_multi = MultiColumn(['# cycles'], separator='=')
            call n_cyc_multi%add_column(FormattedTextColumn('', '(i8.0)', 8, NumCyclesColumn(),separator=' '))

            call reporter%add_column(SeparatorColumn('|'))
            call reporter%add_column(min_multi)
            call reporter%add_column(SeparatorColumn('|'))
            call reporter%add_column(mean_multi)
            call reporter%add_column(SeparatorColumn('|'))
            call reporter%add_column(max_multi)
            call reporter%add_column(SeparatorColumn('|'))
            call reporter%add_column(pe_multi)
            call reporter%add_column(SeparatorColumn('|'))
            call reporter%add_column(n_cyc_multi)


            report = reporter%generate_report(state%t_profiler)
            call lgr%info('')
            call lgr%info('Times for component <%a~>', trim(comp_name))
            do i = 1, size(report)
               call lgr%info('%a', report(i))
            end do
            call lgr%info('')
         end if

         _RETURN(ESMF_SUCCESS)
      end subroutine report_generic_profile

   end subroutine MAPL_GenericFinalize