diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 139adc0255..732026592f 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -72,6 +72,10 @@ program MOM_main use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init use MOM_write_cputime, only : write_cputime_start_clock, write_cputime_CS + use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_size + use ensemble_manager_mod, only : ensemble_pelist_setup + use mpp_mod, only : set_current_pelist => mpp_set_current_pelist + use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS use MOM_ice_shelf, only : shelf_calc_flux, ice_shelf_save_restart ! , add_shelf_flux_forcing, add_shelf_flux_IOB @@ -144,7 +148,6 @@ program MOM_main type(time_type) :: energysavedays ! The interval between writing the energies ! and other integral quantities of the run. - integer :: ocean_nthreads = 1 ! Number of Openmp threads integer :: date_init(6)=0 ! The start date of the whole simulation. integer :: date(6)=-1 ! Possibly the start date of this run segment. integer :: years=0, months=0, days=0 ! These may determine the segment run @@ -157,6 +160,10 @@ program MOM_main integer :: calendar_type=-1 integer :: unit, io_status, ierr + integer :: ensemble_size, nPEs_per, ensemble_info(6) + + integer, dimension(0) :: atm_PElist, land_PElist, ice_PElist + integer, dimension(:), allocatable :: ocean_PElist logical :: unit_in_use integer :: initClock, mainClock, termClock @@ -167,14 +174,12 @@ program MOM_main type(ice_shelf_CS), pointer :: ice_shelf_CSp => NULL() !----------------------------------------------------------------------- - integer :: get_cpu_affinity, base_cpu, omp_get_num_threads, omp_get_thread_num - character(len=4), parameter :: vers_num = 'v2.0' ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mod = "MOM_main (MOM_driver)" ! This module's name. - namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds, ocean_nthreads + namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds !####################################################################### @@ -182,6 +187,19 @@ program MOM_main call MOM_infra_init() ; call io_infra_init() + ! Initialize the ensemble manager. If there are no settings for ensemble_size + ! in input.nml(ensemble.nml), these should not do anything. In coupled + ! configurations, this all occurs in the external driver. + call ensemble_manager_init() ; ensemble_info(:) = get_ensemble_size() + ensemble_size=ensemble_info(1) ; nPEs_per=ensemble_info(3) + if (ensemble_size > 1) then ! There are multiple ensemble members. + allocate(ocean_pelist(nPEs_per)) + call ensemble_pelist_setup(.true., 0, nPEs_per, 0, 0, atm_pelist, ocean_pelist, & + land_pelist, ice_pelist) + call set_current_pelist(ocean_pelist) + deallocate(ocean_pelist) + endif + ! These clocks are on the global pelist. initClock = cpu_clock_id( 'Initialization' ) mainClock = cpu_clock_id( 'Main loop' ) @@ -196,10 +214,10 @@ program MOM_main call open_file(unit, 'input.nml', form=ASCII_FILE, action=READONLY_FILE) read(unit, ocean_solo_nml, iostat=io_status) call close_file(unit) -! if (years+months+days+hours+minutes+seconds > 0) then - ierr = check_nml_error(io_status,'ocean_solo_nml') + ierr = check_nml_error(io_status,'ocean_solo_nml') + if (years+months+days+hours+minutes+seconds > 0) then if (is_root_pe()) write(*,ocean_solo_nml) -! endif + endif endif ! Read ocean_solo restart, which can override settings from the namelist. @@ -223,14 +241,6 @@ program MOM_main endif call set_calendar_type(calendar_type) -#ifndef NOT_SET_AFFINITY -!$ call omp_set_num_threads(ocean_nthreads) -!$ base_cpu = get_cpu_affinity() -!$OMP PARALLEL -!$ call set_cpu_affinity( base_cpu + omp_get_thread_num() ) -!$OMP END PARALLEL -#endif - if (sum(date_init) > 0) then Start_time = set_date(date_init(1),date_init(2), date_init(3), & @@ -344,15 +354,17 @@ program MOM_main call diag_mediator_close_registration() ! Write out a time stamp file. - call open_file(unit, 'time_stamp.out', form=ASCII_FILE, action=APPEND_FILE, & - threading=SINGLE_FILE) - call get_date(Time, date(1), date(2), date(3), date(4), date(5), date(6)) - month = month_name(date(2)) - if (is_root_pe()) write(unit,'(6i4,2x,a3)') date, month(1:3) - call get_date(Time_end, date(1), date(2), date(3), date(4), date(5), date(6)) - month = month_name(date(2)) - if (is_root_pe()) write(unit,'(6i4,2x,a3)') date, month(1:3) - call close_file(unit) + if (calendar_type /= NO_CALENDAR) then + call open_file(unit, 'time_stamp.out', form=ASCII_FILE, action=APPEND_FILE, & + threading=SINGLE_FILE) + call get_date(Time, date(1), date(2), date(3), date(4), date(5), date(6)) + month = month_name(date(2)) + if (is_root_pe()) write(unit,'(6i4,2x,a3)') date, month(1:3) + call get_date(Time_end, date(1), date(2), date(3), date(4), date(5), date(6)) + month = month_name(date(2)) + if (is_root_pe()) write(unit,'(6i4,2x,a3)') date, month(1:3) + call close_file(unit) + endif call write_energy(MOM_CSp%u, MOM_CSp%v, MOM_CSp%h, & MOM_CSp%tv, Time, 0, grid, sum_output_CSp, MOM_CSp%tracer_flow_CSp) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 623917543a..685e0b9b3f 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -40,7 +40,7 @@ module MOM_domains use mpp_domains_mod, only : mpp_reset_group_update_field use mpp_domains_mod, only : mpp_group_update_initialized use mpp_domains_mod, only : mpp_start_group_update, mpp_complete_group_update -use mpp_domains_mod, only : compute_block_extent => mpp_compute_block_extent +use mpp_domains_mod, only : compute_block_extent => mpp_compute_block_extent use mpp_parameter_mod, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER use mpp_parameter_mod, only : To_East => WUPDATE, To_West => EUPDATE use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE @@ -213,8 +213,8 @@ function pass_var_start_2d(array, MOM_dom, sideflag, position, complete) ! (in) position - An optional argument indicating the position. This is ! may be CORNER, but is CENTER by default. ! (in) complete - An optional argument indicating whether the halo updates -! should be initiated immediately or wait for second -! pass_..._start call. Omitting complete is the same as +! should be initiated immediately or wait for second +! pass_..._start call. Omitting complete is the same as ! setting complete to .true. ! (return value) - The integer index for this update. integer :: dirflag @@ -245,8 +245,8 @@ function pass_var_start_3d(array, MOM_dom, sideflag, position, complete) ! (in) position - An optional argument indicating the position. This is ! may be CORNER, but is CENTER by default. ! (in) complete - An optional argument indicating whether the halo updates -! should be initiated immediately or wait for second -! pass_..._start call. Omitting complete is the same as +! should be initiated immediately or wait for second +! pass_..._start call. Omitting complete is the same as ! setting complete to .true. ! (return value) - The integer index for this update. integer :: dirflag @@ -324,7 +324,7 @@ subroutine pass_vector_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete) ! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) direction - An optional integer indicating which directions the @@ -367,14 +367,14 @@ subroutine fill_vector_symmetric_edges_2d(u_cmpt, v_cmpt, MOM_dom, stagger, scal ! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE, ! or CGRID_NE, indicating where the two components of the ! vector are discretized. Omitting stagger is the same as ! setting it to CGRID_NE. -! (in) scalar - An optional argument indicating whether +! (in) scalar - An optional argument indicating whether integer :: stagger_local integer :: dirflag @@ -443,7 +443,7 @@ subroutine pass_vector_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete) ! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) direction - An optional integer indicating which directions the @@ -488,7 +488,7 @@ function pass_vector_start_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, compl ! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) direction - An optional integer indicating which directions the @@ -504,8 +504,8 @@ function pass_vector_start_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, compl ! vector are discretized. Omitting stagger is the same as ! setting it to CGRID_NE. ! (in) complete - An optional argument indicating whether the halo updates -! should be initiated immediately or wait for second -! pass_..._start call. Omitting complete is the same as +! should be initiated immediately or wait for second +! pass_..._start call. Omitting complete is the same as ! setting complete to .true. ! (return value) - The integer index for this update. integer :: stagger_local @@ -532,7 +532,7 @@ function pass_vector_start_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, compl ! Arguments: u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) direction - An optional integer indicating which directions the @@ -548,8 +548,8 @@ function pass_vector_start_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, compl ! vector are discretized. Omitting stagger is the same as ! setting it to CGRID_NE. ! (in) complete - An optional argument indicating whether the halo updates -! should be initiated immediately or wait for second -! pass_..._start call. Omitting complete is the same as +! should be initiated immediately or wait for second +! pass_..._start call. Omitting complete is the same as ! setting complete to .true. ! (return value) - The integer index for this update. integer :: stagger_local @@ -577,7 +577,7 @@ subroutine pass_vector_complete_2d(id_update, u_cmpt, v_cmpt, MOM_dom, direction ! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) direction - An optional integer indicating which directions the @@ -618,7 +618,7 @@ subroutine pass_vector_complete_3d(id_update, u_cmpt, v_cmpt, MOM_dom, direction ! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) direction - An optional integer indicating which directions the @@ -654,8 +654,8 @@ subroutine create_var_group_pass_2d(group, array, MOM_dom, sideflag, position) type(MOM_domain_type), intent(inout) :: MOM_dom integer, optional, intent(in) :: sideflag integer, optional, intent(in) :: position -! Arguments: -! (inout) group - The data type that store information for group update. +! Arguments: +! (inout) group - The data type that store information for group update. ! This data will be used in do_group_pass. ! (inout) array - The array which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to @@ -677,7 +677,7 @@ subroutine create_var_group_pass_2d(group, array, MOM_dom, sideflag, position) call mpp_reset_group_update_field(group,array) else call mpp_create_group_update(group, array, MOM_dom%mpp_domain, flags=dirflag, & - position=position) + position=position) endif end subroutine create_var_group_pass_2d @@ -688,8 +688,8 @@ subroutine create_var_group_pass_3d(group, array, MOM_dom, sideflag, position) type(MOM_domain_type), intent(inout) :: MOM_dom integer, optional, intent(in) :: sideflag integer, optional, intent(in) :: position -! Arguments: -! (inout) group - The data type that store information for group update. +! Arguments: +! (inout) group - The data type that store information for group update. ! This data will be used in do_group_pass. ! (inout) array - The array which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to @@ -723,13 +723,13 @@ subroutine create_vector_group_pass_2d(group, u_cmpt, v_cmpt, MOM_dom, direction type(MOM_domain_type), intent(inout) :: MOM_dom integer, optional, intent(in) :: direction integer, optional, intent(in) :: stagger -! Arguments: -! (inout) group - The data type that store information for group update. +! Arguments: +! (inout) group - The data type that store information for group update. ! This data will be used in do_group_pass. ! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) direction - An optional integer indicating which directions the @@ -768,13 +768,13 @@ subroutine create_vector_group_pass_3d(group, u_cmpt, v_cmpt, MOM_dom, direction type(MOM_domain_type), intent(inout) :: MOM_dom integer, optional, intent(in) :: direction integer, optional, intent(in) :: stagger -! Arguments: -! (inout) group - The data type that store information for group update. +! Arguments: +! (inout) group - The data type that store information for group update. ! This data will be used in do_group_pass. ! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which ! is having its halos points exchanged. ! (inout) v_cmpt - The nominal meridional (v) component of the vector pair -! which is having its halos points exchanged. +! which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. ! (in) direction - An optional integer indicating which directions the @@ -813,8 +813,8 @@ subroutine do_group_pass(group, MOM_dom) type(MOM_domain_type), intent(inout) :: MOM_dom real :: d_type -! Arguments: -! (inout) group - The data type that store information for group update. +! Arguments: +! (inout) group - The data type that store information for group update. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. @@ -827,8 +827,8 @@ subroutine start_group_pass(group, MOM_dom) type(MOM_domain_type), intent(inout) :: MOM_dom real :: d_type -! Arguments: -! (inout) group - The data type that store information for group update. +! Arguments: +! (inout) group - The data type that store information for group update. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. @@ -841,8 +841,8 @@ subroutine complete_group_pass(group, MOM_dom) type(MOM_domain_type), intent(inout) :: MOM_dom real :: d_type -! Arguments: -! (inout) group - The data type that store information for group update. +! Arguments: +! (inout) group - The data type that store information for group update. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. @@ -864,7 +864,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & integer, dimension(2), optional, intent(inout) :: min_halo character(len=*), optional, intent(in) :: domain_name character(len=*), optional, intent(in) :: include_name - + ! Arguments: MOM_dom - A pointer to the MOM_domain_type being defined here. ! (in) param_file - A structure indicating the open file to parse for ! model parameter values. @@ -886,6 +886,9 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & integer, dimension(2) :: layout = (/ 1, 1 /) integer, dimension(2) :: io_layout = (/ 0, 0 /) integer, dimension(4) :: global_indices +!$ integer :: ocean_nthreads ! Number of Openmp threads +!$ integer :: get_cpu_affinity, base_cpu, omp_get_num_threads +!$ integer :: omp_get_thread_num, default_threads integer :: nihalo_dflt, njhalo_dflt integer :: pe, proc_used integer :: X_FLAGS, Y_FLAGS @@ -948,7 +951,30 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & "Use tripolar connectivity at the northern edge of the \n"//& "domain. With TRIPOLAR_N, NIGLOBAL must be even.", & default=.false.) - + +#ifndef NOT_SET_AFFINITY +!$ default_threads = 1 +!$OMP PARALLEL default(none) shared(default_threads) +!$OMP SINGLE +!$ default_threads = omp_get_num_threads() +!$OMP END SINGLE +!$OMP END PARALLEL +!$ if (default_threads == 1) then +!$ call get_param(param_file, mod, "OCEAN_OMP_THREADS", ocean_nthreads, & +!$ "The number of OpenMP threads that MOM6 will use.", & +!$ default = default_threads, layoutParam=.true.) +!$ call omp_set_num_threads(ocean_nthreads) +!$ base_cpu = get_cpu_affinity() +!$OMP PARALLEL +!$ call set_cpu_affinity( base_cpu + omp_get_thread_num() ) +!$OMP END PARALLEL +!$ else +!$ call log_param(param_file, mod, "OCEAN_OMP_THREADS", default_threads, & +!$ "The number of OpenMP threads that MOM6 will use.", & +!$ layoutParam=.true.) +!$ endif +#endif + call log_param(param_file, mod, "!SYMMETRIC_MEMORY_", MOM_dom%symmetric, & "If defined, the velocity point data domain includes \n"//& "every face of the thickness points. In other words, \n"//& @@ -1163,7 +1189,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & io_layout(1),layout(1) call MOM_error(FATAL, mesg) endif ; endif - + if (io_layout(2) < 0) then write(mesg,'("MOM_domains_init: NJPROC_IO = ",i4,". Negative values of "//& &" of NJPROC_IO are not allowed.")') io_layout(2) @@ -1174,7 +1200,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & io_layout(2),layout(2) call MOM_error(FATAL, mesg) endif ; endif - + if ((io_layout(1) > 0) .and. (io_layout(2) == 0)) io_layout(2) = layout(2) if ((io_layout(2) > 0) .and. (io_layout(1) == 0)) io_layout(1) = layout(1) @@ -1258,10 +1284,10 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & ! Save the extra data for creating other domains of different resolution that overlay this domain MOM_dom%niglobal = MD_in%niglobal ; MOM_dom%njglobal = MD_in%njglobal MOM_dom%nihalo = MD_in%nihalo ; MOM_dom%njhalo = MD_in%njhalo - + MOM_dom%symmetric = MD_in%symmetric MOM_dom%nonblocking_updates = MD_in%nonblocking_updates - + MOM_dom%X_FLAGS = MD_in%X_FLAGS ; MOM_dom%Y_FLAGS = MD_in%Y_FLAGS MOM_dom%layout(:) = MD_in%layout(:) ; MOM_dom%io_layout(:) = MD_in%io_layout(:) MOM_dom%use_io_layout = (MOM_dom%io_layout(1) + MOM_dom%io_layout(2) > 0) @@ -1283,7 +1309,7 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & MOM_dom%njhalo = max(MOM_dom%njhalo, min_halo(2)) min_halo(2) = MOM_dom%njhalo endif - + if (present(halo_size)) then MOM_dom%nihalo = halo_size ; MOM_dom%njhalo = halo_size endif @@ -1313,10 +1339,8 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & call MOM_define_io_domain(MOM_dom%mpp_domain, MOM_dom%io_layout) endif - end subroutine clone_MD_to_MD - subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, & domain_name) type(MOM_domain_type), intent(in) :: MD_in @@ -1334,9 +1358,9 @@ subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, & ! Save the extra data for creating other domains of different resolution that overlay this domain niglobal = MD_in%niglobal ; njglobal = MD_in%njglobal nihalo = MD_in%nihalo ; njhalo = MD_in%njhalo - + symmetric_dom = MD_in%symmetric - + X_FLAGS = MD_in%X_FLAGS ; Y_FLAGS = MD_in%Y_FLAGS layout(:) = MD_in%layout(:) ; io_layout(:) = MD_in%io_layout(:) @@ -1348,7 +1372,7 @@ subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, & njhalo = max(njhalo, min_halo(2)) min_halo(1) = nihalo ; min_halo(2) = njhalo endif - + if (present(halo_size)) then nihalo = halo_size ; njhalo = halo_size endif