MAPL_Cap.F90

This file depends on

Help
Files dependent on this one

Help
Source Code

#include "MAPL_ErrLog.h"
#include "unused_dummy.H"


module MAPL_CapMod
   use MPI
   use ESMF
   use MAPL_SimpleCommSplitterMod
   use MAPL_SplitCommunicatorMod
   use MAPL_KeywordEnforcerMod
   use MAPL_CapGridCompMod
   use MAPL_BaseMod
   use MAPL_ExceptionHandling
   use pFIO
   use MAPL_CapOptionsMod
   use MAPL_ServerManager
   use MAPL_ApplicationSupport
   use, intrinsic :: iso_fortran_env, only: REAL64, INT64, OUTPUT_UNIT
   implicit none
   private

   public :: MAPL_Cap

   type :: MAPL_Cap
      private
      character(:), allocatable :: name
      procedure(), nopass, pointer :: set_services => null()
      logical :: non_dso = .false.
      integer :: comm_world
      integer :: rank
      integer :: npes_member
      character(:), allocatable :: root_dso

      type (MAPL_CapOptions), allocatable :: cap_options
      ! misc
      logical :: mpi_already_initialized = .false.
      type(MAPL_CapGridComp), public :: cap_gc
      type(ServerManager) :: cap_server
      type(SimpleCommSplitter), public :: splitter
   contains
      procedure :: run
      procedure :: run_ensemble
      procedure :: run_member
      procedure :: run_model
      procedure :: step_model
      procedure :: rewind_model

      procedure :: create_member_subcommunicator
      procedure :: initialize_io_clients_servers
      procedure :: finalize_io_clients_servers
      procedure :: initialize_cap_gc
      procedure :: initialize_mpi
      procedure :: finalize_mpi


      !getters
      procedure :: get_npes_model
      procedure :: get_comm_world
      procedure :: get_n_members
      procedure :: get_cap_gc
      procedure :: get_cap_rc_file
      procedure :: get_egress_file

   end type MAPL_Cap

   interface MAPL_Cap
      module procedure new_MAPL_Cap_from_set_services
      module procedure new_MAPL_Cap_from_dso
   end interface MAPL_Cap


   interface
      integer function c_chdir(path) bind(C,name="chdir")
         use iso_c_binding
         character(kind=c_char) :: path(*)
      end function c_chdir
   end interface

contains

   function new_MAPL_Cap_from_set_services(name, set_services, unusable, cap_options, rc) result(cap)
      type (MAPL_Cap) :: cap
      character(*), intent(in) :: name
      procedure() :: set_services
      class (KeywordEnforcer),  optional, intent(in) :: unusable
      type ( MAPL_CapOptions), optional, intent(in) :: cap_options
      integer, optional, intent(out) :: rc
      integer :: status

      cap%name = name
      cap%set_services => set_services
      cap%non_dso = .true.

      if (present(cap_options)) then
         allocate(cap%cap_options, source = cap_options)
      else
         allocate(cap%cap_options, source = MAPL_CapOptions())
      endif

      if (cap%cap_options%use_comm_world) then
         cap%comm_world       = MPI_COMM_WORLD
         cap%cap_options%comm = MPI_COMM_WORLD
      else
         cap%comm_world = cap%cap_options%comm
      endif

      call cap%initialize_mpi(rc=status)
      _VERIFY(status)

      call MAPL_Initialize(comm=cap%comm_world, &
                           logging_config=cap%cap_options%logging_config, &
                           rc=status)
      _VERIFY(status)

      _RETURN(_SUCCESS)
      _UNUSED_DUMMY(unusable)

    end function new_MAPL_Cap_from_set_services

   function new_MAPL_Cap_from_dso(name, unusable, cap_options, rc) result(cap)
      type (MAPL_Cap) :: cap
      character(*), intent(in) :: name
      class (KeywordEnforcer),  optional, intent(in) :: unusable
      type ( MAPL_CapOptions), optional, intent(in) :: cap_options
      integer, optional, intent(out) :: rc
      integer :: status

      cap%name = name

      if (present(cap_options)) then
         allocate(cap%cap_options, source = cap_options)
      else
         allocate(cap%cap_options, source = MAPL_CapOptions())
      endif

      if (cap%cap_options%use_comm_world) then
         cap%comm_world       = MPI_COMM_WORLD
         cap%cap_options%comm = MPI_COMM_WORLD
      else
         cap%comm_world = cap%cap_options%comm
      endif

      call cap%initialize_mpi(rc=status)
      _VERIFY(status)

      call MAPL_Initialize(comm=cap%comm_world, &
                           logging_config=cap%cap_options%logging_config, &
                           rc=status)
      _VERIFY(status)

      _RETURN(_SUCCESS)
      _UNUSED_DUMMY(unusable)

    end function new_MAPL_Cap_from_dso


   ! 3. Run the ensemble (default is 1 member)
   ! 4. Finalize MPI if initialized locally.
   subroutine run(this, unusable, rc)
      class (MAPL_Cap), intent(inout) :: this
      class (KeywordEnforcer), optional, intent(in) :: unusable
      integer, optional, intent(out) :: rc
      integer :: status
!


      _UNUSED_DUMMY(unusable)

      call this%run_ensemble(rc=status); _VERIFY(status)
      call this%finalize_mpi(rc=status); _VERIFY(status)

      _RETURN(_SUCCESS)

    end subroutine run


   ! This layer splits the communicator to support running a
   ! multi-member ensemble.
   subroutine run_ensemble(this, unusable, rc)
      class (MAPL_Cap), target, intent(inout) :: this
      class (KeywordEnforcer), optional, intent(in) :: unusable
      integer, optional, intent(out) :: rc

      integer :: status
      integer :: subcommunicator

      _UNUSED_DUMMY(unusable)

      subcommunicator = this%create_member_subcommunicator(this%comm_world, rc=status); _VERIFY(status)
      if (subcommunicator /= MPI_COMM_NULL) then
         call this%initialize_io_clients_servers(subcommunicator, rc = status); _VERIFY(status)
         call this%run_member(rc=status); _VERIFY(status)
         call this%finalize_io_clients_servers()
         call this%splitter%free_sub_comm()
      end if

      _RETURN(_SUCCESS)

   end subroutine run_ensemble


   subroutine finalize_io_clients_servers(this, unusable, rc)
     class (MAPL_Cap), target, intent(inout) :: this
     class (KeywordEnforcer), optional, intent(in) :: unusable
     integer, optional, intent(out) :: rc
     type(SplitCommunicator) :: split_comm

     _UNUSED_DUMMY(unusable)
     call this%cap_server%get_splitcomm(split_comm)
     select case(split_comm%get_name())
     case('model')
        call i_Clients%terminate()
        call o_Clients%terminate()
     end select
     call this%cap_server%finalize()
     _RETURN(_SUCCESS)

   end subroutine finalize_io_clients_servers

   subroutine initialize_io_clients_servers(this, comm, unusable, rc)
     class (MAPL_Cap), target, intent(inout) :: this
     integer, intent(in) :: comm
     class (KeywordEnforcer), optional, intent(in) :: unusable
     integer, optional, intent(out) :: rc
     integer :: status

     _UNUSED_DUMMY(unusable)
     call this%cap_server%initialize(comm, &
         application_size=this%cap_options%npes_model, &
         nodes_input_server=this%cap_options%nodes_input_server, &
         nodes_output_server=this%cap_options%nodes_output_server, &
         npes_input_server=this%cap_options%npes_input_server, &
         npes_output_server=this%cap_options%npes_output_server, &
         oserver_type=this%cap_options%oserver_type, &
         npes_backend_pernode=this%cap_options%npes_backend_pernode, &
         isolate_nodes = this%cap_options%isolate_nodes, &
         fast_oclient  = this%cap_options%fast_oclient, &
         with_profiler = this%cap_options%with_io_profiler, &
         rc=status)
     _VERIFY(status)
     _RETURN(_SUCCESS)

   end subroutine initialize_io_clients_servers

   ! This layer splits the communicator to support separate i/o servers
   ! and runs the model via a CapGridComp.
   subroutine run_member(this, rc)
      use MAPL_CFIOMod
      class (MAPL_Cap), intent(inout) :: this
      integer, optional, intent(out) :: rc

      integer :: status
      type(SplitCommunicator) :: split_comm

      call this%cap_server%get_splitcomm(split_comm)
      select case(split_comm%get_name())
      case('model')
         call this%run_model(comm=split_comm%get_subcommunicator(), rc=status); _VERIFY(status)
      end select

     _RETURN(_SUCCESS)

   end subroutine run_member


   subroutine run_model(this, comm, unusable, rc)
      use pFlogger, only: logging, Logger
      class (MAPL_Cap), intent(inout) :: this
      integer, intent(in) :: comm
      class (KeywordEnforcer), optional, intent(in) :: unusable
      integer, optional, intent(out) ::rc

      integer(kind=INT64) :: start_tick, stop_tick, tick_rate
      integer :: rank, ierror
      integer :: status
      class(Logger), pointer :: lgr
      logical :: file_exists
      type (ESMF_VM) :: vm
      character(len=:), allocatable :: esmfComm

      _UNUSED_DUMMY(unusable)

      call start_timer()

      ! Look for a file called "ESMF.rc" but we want to do this on root and then
      ! broadcast the result to the other ranks

      call MPI_COMM_RANK(comm, rank, status)
      _VERIFY(status)

      if (rank == 0) then
         inquire(file='ESMF.rc', exist=file_exists)
      end if
      call MPI_BCAST(file_exists, 1, MPI_LOGICAL, 0, comm, status)
      _VERIFY(status)

      ! If the file exists, we pass it into ESMF_Initialize, else, we
      ! use the one from the command line arguments
      if (file_exists) then
         call ESMF_Initialize (configFileName='ESMF.rc', mpiCommunicator=comm, vm=vm, _RC)
      else
         call ESMF_Initialize (logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=comm, vm=vm, _RC)
      end if

      ! We check to see if ESMF_COMM was built as mpiuni which is not allowed for MAPL
      call ESMF_VmGet(vm, esmfComm = esmfComm, _RC)
      _ASSERT( esmfComm /= 'mpiuni', 'ESMF_COMM=mpiuni is not allowed for MAPL')

      ! Note per ESMF this is a temporary routine as eventually MOAB will
      ! be the only mesh generator. But until then, this allows us to
      ! test it
      call ESMF_MeshSetMOAB(this%cap_options%with_esmf_moab, rc=status)
      _VERIFY(status)

      lgr => logging%get_logger('MAPL')
      call lgr%info("Running with MOAB library for ESMF Mesh: %l1", this%cap_options%with_esmf_moab)

      call this%initialize_cap_gc(rc=status)
      _VERIFY(status)

      call this%cap_gc%set_services(rc = status)
      _VERIFY(status)
      call this%cap_gc%initialize(rc=status)
      _VERIFY(status)
      call this%cap_gc%run(rc=status)
      _VERIFY(status)
      call this%cap_gc%finalize(rc=status)
      _VERIFY(status)

      call ESMF_Finalize(endflag=ESMF_END_KEEPMPI, rc=status)
      _VERIFY(status)
      call stop_timer()

      call report_throughput()

      _RETURN(_SUCCESS)
   contains

      subroutine start_timer()
         call system_clock(start_tick, count_rate=tick_rate)
      end subroutine start_timer

      subroutine stop_timer()
         call system_clock(stop_tick)
      end subroutine stop_timer

      subroutine report_throughput(rc)
         integer, optional, intent(out) :: rc

         integer :: rank, ierror
         real(kind=REAL64) :: model_duration, wall_time, model_days_per_day

         call MPI_Comm_rank(this%comm_world, rank, ierror)
         _VERIFY(ierror)

         if (rank == 0) then
            model_duration = this%cap_gc%get_model_duration()
            wall_time = (stop_tick - start_tick) / real(tick_rate, kind=REAL64)

            model_days_per_day = model_duration / wall_time


            lgr => logging%get_logger('MAPL.profiler')
            call lgr%info("Model Throughput: %f12.3 days per day", model_days_per_day)
         end if

      end subroutine report_throughput

   end subroutine run_model

   subroutine initialize_cap_gc(this, unusable, n_run_phases, rc)
     class(MAPL_Cap), intent(inout) :: this
     class (KeywordEnforcer), optional, intent(in) :: unusable
     integer, optional, intent(in) :: n_run_phases
     integer, optional, intent(out) :: rc

     integer :: status

     _UNUSED_DUMMY(unusable)

     if (this%non_dso) then
        call MAPL_CapGridCompCreate(this%cap_gc, this%get_cap_rc_file(), &
           this%name, this%get_egress_file(), n_run_phases=n_run_phases, root_set_services = this%set_services,rc=status)
     else
        _ASSERT(this%cap_options%root_dso /= 'none',"No set services specified, must pass a dso")
        call MAPL_CapGridCompCreate(this%cap_gc, this%get_cap_rc_file(), &
           this%name, this%get_egress_file(), n_run_phases=n_run_phases, root_dso = this%cap_options%root_dso,rc=status)
     end if
     _VERIFY(status)
     _RETURN(_SUCCESS)
   end subroutine initialize_cap_gc


   subroutine step_model(this, rc)
     class(MAPL_Cap), intent(inout) :: this
     integer, intent(out) :: rc
     integer :: status
     call this%cap_gc%step(rc = status); _VERIFY(status)
     _RETURN(_SUCCESS)
   end subroutine step_model

   subroutine rewind_model(this, time, rc)
     class(MAPL_Cap), intent(inout) :: this
     type(ESMF_Time), intent(inout) :: time
     integer, intent(out) :: rc
     integer :: status
     call this%cap_gc%rewind_clock(time,rc = status); _VERIFY(status)
     _RETURN(_SUCCESS)
   end subroutine rewind_model

   integer function create_member_subcommunicator(this, comm, unusable, rc) result(subcommunicator)
      class (MAPL_Cap), intent(inout) :: this
      integer, intent(in) :: comm
      class (KeywordEnforcer), optional, intent(in) :: unusable
      integer, optional, intent(out) :: rc

      type (SplitCommunicator) :: split_comm

      integer :: status
      character(:), allocatable :: dir_name
!!$      external :: chdir

      _UNUSED_DUMMY(unusable)

      subcommunicator = MPI_COMM_NULL ! in case of failure
      this%splitter = SimpleCommSplitter(comm, this%cap_options%n_members, this%npes_member, base_name=this%cap_options%ensemble_subdir_prefix)
      split_comm = this%splitter%split(rc=status); _VERIFY(status)
      subcommunicator = split_comm%get_subcommunicator()

      if (this%cap_options%n_members > 1) then
         dir_name = split_comm%get_name()
         status = c_chdir(dir_name)
         _VERIFY(status)
      end if

      _RETURN(_SUCCESS)

   end function create_member_subcommunicator


   subroutine initialize_mpi(this, unusable, rc)
      class (MAPL_Cap), intent(inout) :: this
      class (KeywordEnforcer), optional, intent(in) :: unusable
      integer, optional, intent(out) :: rc

      integer :: ierror, status
      integer :: provided
      integer :: npes_world

      _UNUSED_DUMMY(unusable)

      call MPI_Initialized(this%mpi_already_initialized, ierror)
      _VERIFY(ierror)

      if (.not. this%mpi_already_initialized) then

         call ESMF_InitializePreMPI(_RC)
         call MPI_Init_thread(MPI_THREAD_MULTIPLE, provided, ierror)
         _VERIFY(ierror)
         _ASSERT(provided == MPI_THREAD_MULTIPLE, 'MPI_THREAD_MULTIPLE not supported by this MPI.')
      else
         ! If we are here, then MPI has already been initialized by the user
         ! and we are just using it. But we need to make sure that the user
         ! has initialized MPI with the correct threading level.
         call MPI_Query_thread(provided, ierror)
         _VERIFY(ierror)
      end if
      _ASSERT(provided == MPI_THREAD_MULTIPLE, 'MPI_THREAD_MULTIPLE not supported by this MPI.')

      call MPI_Comm_rank(this%comm_world, this%rank, status)
      _VERIFY(status)
      call MPI_Comm_size(this%comm_world, npes_world, status)
      _VERIFY(status)

      if ( this%cap_options%npes_model == -1) then
         ! just a feed back to cap_options to maintain integrity
          this%cap_options%npes_model = npes_world
      endif
      _ASSERT(npes_world >= this%cap_options%npes_model, "npes_world is smaller than npes_model")

      this%npes_member = npes_world / this%cap_options%n_members


      _RETURN(_SUCCESS)

   end subroutine initialize_mpi


   ! From  https://stackoverflow.com/questions/26730836/change-of-directory-in-fortran-in-a-non-compiler-specific-way
   subroutine chdir(path, err)
      use iso_c_binding
      character(*) :: path
      integer, optional, intent(out) :: err
      integer :: loc_err

      loc_err =  c_chdir(path//c_null_char)

      if (present(err)) err = loc_err

   end subroutine chdir

   subroutine finalize_mpi(this, unusable, rc)
      class (MAPL_Cap), intent(in) :: this
      class (KeywordEnforcer), optional, intent(in) :: unusable
      integer, optional, intent(out) :: rc

      integer :: status
      _UNUSED_DUMMY(unusable)

      call MAPL_Finalize(comm=this%comm_world)
      if (.not. this%mpi_already_initialized) then
         call MPI_Finalize(status)
      end if

      _RETURN(_SUCCESS)

   end subroutine finalize_mpi

   function get_npes_model(this) result(npes_model)
     class(MAPL_Cap), intent(in) :: this
     integer :: npes_model
     npes_model = this%cap_options%npes_model
   end function get_npes_model

   function get_comm_world(this) result(comm_world)
     class(MAPL_Cap), intent(in) :: this
     integer :: comm_world
     comm_world = this%comm_world
   end function get_comm_world

   function get_n_members(this) result(n_members)
     class(MAPL_Cap), intent(in) :: this
     integer :: n_members
     n_members = this%cap_options%n_members
   end function get_n_members

   function get_cap_gc(this) result(cap_gc)
     class(MAPL_Cap), intent(in) :: this
     type(MAPL_CapGridComp) :: cap_gc
     cap_gc = this%cap_gc
   end function get_cap_gc

   function get_cap_rc_file(this) result(cap_rc_file)
     class(MAPL_Cap), intent(in) :: this
     character(len=:), allocatable :: cap_rc_file
     allocate(cap_rc_file, source=this%cap_options%cap_rc_file)
   end function get_cap_rc_file

   function get_egress_file(this) result(egress_file)
     class(MAPL_Cap), intent(in) :: this
     character(len=:), allocatable :: egress_file
     allocate(egress_file, source=this%cap_options%egress_file)
   end function get_egress_file

end module MAPL_CapMod
MAPL_Cap.F90 Source File

Contents

Modules

Source Code

This file depends on

Files dependent on this one

Source Code
