From a40f8fcedcaac1b08c784499f1500f60f4c5d436 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 26 Jan 2024 09:36:15 -0500 Subject: [PATCH 01/78] create coupler_wrapper_mod and remove fredb_id --- full/coupler_main.F90 | 1441 +---------------------------------------- 1 file changed, 3 insertions(+), 1438 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 3a0e7149..5dd93a4f 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -333,253 +333,10 @@ program coupler_main !--- F90 module for OpenMP use omp_lib - - use FMS !, status_fms=>status - use FMSconstants, only: fmsconstants_init - -#ifdef use_deprecated_io - use fms_io_mod, only: fms_io_exit -#endif - -! model interfaces used to couple the component models: -! atmosphere, land, ice, and ocean -! - - use atmos_model_mod, only: atmos_model_init, atmos_model_end - use atmos_model_mod, only: update_atmos_model_dynamics - use atmos_model_mod, only: update_atmos_model_down - use atmos_model_mod, only: update_atmos_model_up - use atmos_model_mod, only: atmos_data_type - use atmos_model_mod, only: land_ice_atmos_boundary_type - use atmos_model_mod, only: atmos_data_type_chksum - use atmos_model_mod, only: lnd_ice_atm_bnd_type_chksum - use atmos_model_mod, only: lnd_atm_bnd_type_chksum - use atmos_model_mod, only: ice_atm_bnd_type_chksum - use atmos_model_mod, only: atmos_model_restart - use atmos_model_mod, only: update_atmos_model_radiation - use atmos_model_mod, only: update_atmos_model_state - - use land_model_mod, only: land_model_init, land_model_end - use land_model_mod, only: land_data_type, atmos_land_boundary_type - use land_model_mod, only: update_land_model_fast, update_land_model_slow - use land_model_mod, only: atm_lnd_bnd_type_chksum - use land_model_mod, only: land_data_type_chksum - use land_model_mod, only: land_model_restart - - use ice_model_mod, only: ice_model_init, share_ice_domains, ice_model_end, ice_model_restart - use ice_model_mod, only: update_ice_model_fast, set_ice_surface_fields - use ice_model_mod, only: ice_data_type, land_ice_boundary_type - use ice_model_mod, only: ocean_ice_boundary_type, atmos_ice_boundary_type - use ice_model_mod, only: ice_data_type_chksum, ocn_ice_bnd_type_chksum - use ice_model_mod, only: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum - use ice_model_mod, only: unpack_ocean_ice_boundary, exchange_slow_to_fast_ice - use ice_model_mod, only: ice_model_fast_cleanup, unpack_land_ice_boundary - use ice_model_mod, only: exchange_fast_to_slow_ice, update_ice_model_slow - - use ocean_model_mod, only: update_ocean_model, ocean_model_init, ocean_model_end - use ocean_model_mod, only: ocean_public_type, ocean_state_type, ice_ocean_boundary_type - use ocean_model_mod, only: ocean_model_restart - use ocean_model_mod, only: ocean_public_type_chksum, ice_ocn_bnd_type_chksum - - use combined_ice_ocean_driver, only: update_slow_ice_and_ocean, ice_ocean_driver_type - use combined_ice_ocean_driver, only: ice_ocean_driver_init, ice_ocean_driver_end -! -! flux_ calls translate information between model grids - see flux_exchange.f90 -! - - use flux_exchange_mod, only: flux_exchange_init, gas_exchange_init, sfc_boundary_layer - use flux_exchange_mod, only: generate_sfc_xgrid, send_ice_mask_sic - use flux_exchange_mod, only: flux_down_from_atmos, flux_up_to_atmos - use flux_exchange_mod, only: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice - use flux_exchange_mod, only: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish - use flux_exchange_mod, only: flux_check_stocks, flux_init_stocks - use flux_exchange_mod, only: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks - use flux_exchange_mod, only: flux_atmos_to_ocean, flux_ex_arrays_dealloc - - use atmos_tracer_driver_mod, only: atmos_tracer_driver_gather_data - - use iso_fortran_env - - implicit none - -!----------------------------------------------------------------------- - - character(len=128) :: version = '$Id$' - character(len=128) :: tag = '$Name$' - -!----------------------------------------------------------------------- -!---- model defined-types ---- - - type (atmos_data_type) :: Atm - type (land_data_type) :: Land - type (ice_data_type) :: Ice - ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target :: Ocean - type (ocean_state_type), pointer :: Ocean_state => NULL() - - type(atmos_land_boundary_type) :: Atmos_land_boundary - type(atmos_ice_boundary_type) :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary - type(land_ice_boundary_type) :: Land_ice_boundary - type(ice_ocean_boundary_type) :: Ice_ocean_boundary - type(ocean_ice_boundary_type) :: Ocean_ice_boundary - type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() - -!----------------------------------------------------------------------- -! ----- coupled model time ----- - - type (FmsTime_type) :: Time, Time_init, Time_end, & - Time_step_atmos, Time_step_cpld - type(FmsTime_type) :: Time_atmos, Time_ocean - type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice - - integer :: num_atmos_calls, na - integer :: num_cpld_calls, nc - - type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() - type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() - - integer :: num_ice_bc_restart=0, num_ocn_bc_restart=0 - type(FmsTime_type) :: Time_restart, Time_restart_current, Time_start - character(len=32) :: timestamp - -! ----- coupled model initial date ----- - - integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) - integer :: calendar_type = INVALID_CALENDAR - -!----------------------------------------------------------------------- -!------ namelist interface ------- - - integer, dimension(6) :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) !< The time interval that write out intermediate restart file. - !! The format is (yr,mo,day,hr,min,sec). When restart_interval - !! is all zero, no intermediate restart file will be written out - integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See - !! force_date_from_namelist.) - character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are - !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. - !! The value 'no_calendar' cannot be used because the time_manager's date - !! functions are used. All values must be lower case. - logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date should override - !! the date in the restart file `INPUT/coupler.res`. If the restart file does not - !! exist then force_date_from_namelist has no effect, the value of current_date - !! will be used. - integer :: months=0 !< Number of months the current integration will be run - integer :: days=0 !< Number of days the current integration will be run - integer :: hours=0 !< Number of hours the current integration will be run - integer :: minutes=0 !< Number of minutes the current integration will be run - integer :: seconds=0 !< Number of seconds the current integration will be run - integer :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fat coupling with land and sea ice - integer :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must be an - !! integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. - integer :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere - integer :: ocean_npes=0 !< The number of MPI tasks to use for the ocean - integer :: ice_npes=0 !< The number of MPI tasks to use for the ice - integer :: land_npes=0 !< The number of MPI tasks to use for the land - integer :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere - integer :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean - integer :: radiation_nthreads=1 !< Number of threads to use for the radiation. - logical :: do_atmos =.true. !< Indicates if this component should be executed. If .FALSE., then execution is skipped. - !! This is used when ALL the output fields sent by this component to the coupler have been - !! overridden using the data_override feature. This is for advanced users only. - logical :: do_land =.true. !< See do_atmos - logical :: do_ice =.true. !< See do_atmos - logical :: do_ocean=.true. !< See do_atmos - logical :: do_flux =.true. !< See do_atmos - logical :: concurrent=.FALSE. !< If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate - !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. - !! If .FALSE., the execution is serial: call atmos... followed by call ocean... - logical :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently - logical :: use_lag_fluxes=.TRUE. !< If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. - !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog - !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable - !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there - !! is probably sufficient damping for MOM4. For more modern ocean models (such as - !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. - !! should be much more stable. - logical :: concurrent_ice=.FALSE. !< If .TRUE., the slow sea-ice is forced with the fluxes that were used for the - !! fast ice processes one timestep before. When used in conjuction with setting - !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and - !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can - !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. - logical :: slow_ice_with_ocean=.FALSE. !< If true, the slow sea-ice is advanced on the ocean processors. Otherwise - !! the slow sea-ice processes are on the same PEs as the fast sea-ice. - logical :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance - !! both the slow sea-ice and the ocean. slow_ice_with_ocean and - !! concurrent_ice must both be true if combined_ice_and_ocean is true. - logical :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. - logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. - logical :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. - integer :: check_stocks = 0 ! -1: never 0: at end of run only n>0: every n coupled steps - logical :: use_hyper_thread = .false. - - namelist /coupler_nml/ current_date, calendar, force_date_from_namelist, & - months, days, hours, minutes, seconds, dt_cpld, dt_atmos, & - do_atmos, do_land, do_ice, do_ocean, do_flux, & - atmos_npes, ocean_npes, ice_npes, land_npes, & - atmos_nthreads, ocean_nthreads, radiation_nthreads, & - concurrent, do_concurrent_radiation, use_lag_fluxes, & - check_stocks, restart_interval, do_debug, do_chksum, & - use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & - do_endpoint_chksum, combined_ice_and_ocean - - integer :: initClock, mainClock, termClock - - integer :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 - integer :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e - integer :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka - integer :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki - integer :: newClockj, newClockk, newClockl - - integer :: id_atmos_model_init, id_land_model_init, id_ice_model_init - integer :: id_ocean_model_init, id_flux_exchange_init - - character(len=80) :: text - character(len=48), parameter :: mod_name = 'coupler_main_mod' - - integer :: outunit - integer :: ensemble_id = 1 - integer, allocatable :: ensemble_pelist(:, :) - integer, allocatable :: slow_ice_ocean_pelist(:) - integer :: conc_nthreads = 1 - real :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 - -!####################################################################### - INTEGER :: i, status, arg_count - CHARACTER(len=256) :: executable_name, arg, fredb_id - -#ifdef FREDB_ID -#define xstr(s) str(s) -#define str(s) #s - fredb_id = xstr(FREDB_ID) -#else -#warning "FREDB_ID not defined. Continuing as normal." - fredb_id = 'FREDB_ID was not defined (e.g. -DFREDB_ID=...) during preprocessing' -#endif - - arg_count = command_argument_count() - DO i=0, arg_count - CALL get_command_argument(i, arg, status=status) - if (status .ne. 0) then - write (error_unit,*) 'get_command_argument failed: status = ', status, ' arg = ', i - stop 1 - end if - - if (i .eq. 0) then - executable_name = arg - else if (arg == '--fredb_id') then - write (output_unit,*) TRIM(fredb_id) - stop - end if - END DO - - if (arg_count .ge. 1) then - write (error_unit,*) 'Usage: '//TRIM(executable_name)//' [--fredb_id]' - stop 1 - end if - + use coupler_wrapper_mod + call fms_mpp_init() -!these clocks are on the global pelist + !these clocks are on the global pelist initClock = fms_mpp_clock_id( 'Initialization' ) call fms_mpp_clock_begin(initClock) @@ -1135,1196 +892,4 @@ program coupler_main !----------------------------------------------------------------------- -contains - -!####################################################################### - -!> \brief Initialize all defined exchange grids and all boundary maps - subroutine coupler_init - - use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_id,ensemble_pelist_setup - use ensemble_manager_mod, only : get_ensemble_size, get_ensemble_pelist - - -! -!----------------------------------------------------------------------- -! local parameters -!----------------------------------------------------------------------- -! - - character(len=64), parameter :: sub_name = 'coupler_init' - character(len=256), parameter :: error_header = & - '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):' - character(len=256), parameter :: note_header = & - '==>Note from ' // trim(mod_name) // '(' // trim(sub_name) // '):' - - integer :: ierr, io, m, i, outunit, logunit, errunit - integer :: date(6) - type (FmsTime_type) :: Run_length - character(len=9) :: month - integer :: pe, npes - - integer :: ens_siz(6), ensemble_size - - integer :: atmos_pe_start=0, atmos_pe_end=0, & - ocean_pe_start=0, ocean_pe_end=0 - integer :: n - integer :: diag_model_subset=DIAG_ALL - logical :: other_fields_exist - character(len=256) :: err_msg - integer :: date_restart(6) - character(len=64) :: filename, fieldname - integer :: id_restart, l - character(len=8) :: walldate - character(len=10) :: walltime - character(len=5) :: wallzone - integer :: wallvalues(8) - character(len=:), dimension(:), allocatable :: restart_file !< Restart file saved as a string - integer :: time_stamp_unit !< Unif of the time_stamp file - integer :: ascii_unit !< Unit of a dummy ascii file - - type(FmsCoupler1dBC_type), pointer :: & - gas_fields_atm => NULL(), & ! A pointer to the type describing the - ! atmospheric fields that will participate in the gas fluxes. - gas_fields_ocn => NULL(), & ! A pointer to the type describing the ocean - ! and ice surface fields that will participate in the gas fluxes. - gas_fluxes => NULL() ! A pointer to the type describing the - ! atmosphere-ocean gas and tracer fluxes. -!----------------------------------------------------------------------- - - outunit = fms_mpp_stdout() - errunit = fms_mpp_stderr() - logunit = fms_mpp_stdlog() - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Entering coupler_init at '& - //trim(walldate)//' '//trim(walltime) - endif - -!----- write version to logfile ------- - call fms_write_version_number(version, tag) - -!----- read namelist ------- - - read (fms_mpp_input_nml_file, coupler_nml, iostat=io) - ierr = check_nml_error (io, 'coupler_nml') - -!----- read date and calendar type from restart file ----- - if (fms2_io_file_exists('INPUT/coupler.res')) then - call fms2_io_ascii_read('INPUT/coupler.res', restart_file) - read(restart_file(1), *) calendar_type - read(restart_file(2), *) date_init - read(restart_file(3), *) date - deallocate(restart_file) - else - force_date_from_namelist = .true. - endif - -!----- use namelist value (either no restart or override flag on) --- - - if ( force_date_from_namelist ) then - - if ( sum(current_date) <= 0 ) then - call error_mesg ('program coupler', & - 'no namelist value for base_date or current_date', FATAL) - else - date = current_date - endif - -!----- override calendar type with namelist value ----- - - select case( fms_mpp_uppercase(trim(calendar)) ) - case( 'GREGORIAN' ) - calendar_type = GREGORIAN - case( 'JULIAN' ) - calendar_type = JULIAN - case( 'NOLEAP' ) - calendar_type = NOLEAP - case( 'THIRTY_DAY' ) - calendar_type = THIRTY_DAY_MONTHS - case( 'NO_CALENDAR' ) - calendar_type = NO_CALENDAR - end select - - endif - - call fms_time_manager_set_calendar_type (calendar_type, err_msg) - if (err_msg /= '') then - call fms_mpp_error(FATAL, 'ERROR in coupler_init: '//trim(err_msg)) - endif - - if (concurrent .AND. .NOT.(use_lag_fluxes .OR. concurrent_ice) ) & - call fms_mpp_error( WARNING, 'coupler_init: you have set concurrent=TRUE, & - & use_lag_fluxes=FALSE, and concurrent_ice=FALSE & - & in coupler_nml. When not using lag fluxes, components & - & will synchronize at two points, and thus run serially.' ) - if (concurrent_ice .AND. .NOT.slow_ice_with_ocean ) call fms_mpp_error(WARNING, & - 'coupler_init: concurrent_ice is true, but slow ice_with_ocean is & - & false in coupler_nml. These two flags should both be true to avoid & - & effectively serializing the run.' ) - if (use_lag_fluxes .AND. concurrent_ice ) call fms_mpp_error(WARNING, & - 'coupler_init: use_lag_fluxes and concurrent_ice are both true. & - & These two coupling options are intended to be exclusive.' ) - - !Check with the ensemble_manager module for the size of ensemble - !and PE counts for each member of the ensemble. - ! - !NOTE: ensemble_manager_init renames all the output files (restart and diagnostics) - ! to show which ensemble member they are coming from. - ! There also need to be restart files for each member of the ensemble in INPUT. - ! - !NOTE: if the ensemble_size=1 the input/output files will not be renamed. - ! - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting initializing ensemble_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_ensemble_manager_init() ! init pelists for ensembles - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing ensemble_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - ens_siz = get_ensemble_size() - ensemble_size = ens_siz(1) - npes = ens_siz(2) - - !Check for the consistency of PE counts - if (concurrent) then -!atmos_npes + ocean_npes must equal npes - if (atmos_npes.EQ.0 ) atmos_npes = npes - ocean_npes - if (ocean_npes.EQ.0 ) ocean_npes = npes - atmos_npes -!both must now be non-zero - if (atmos_npes.EQ.0 .OR. ocean_npes.EQ.0 ) & - call fms_mpp_error( FATAL, 'coupler_init: atmos_npes or ocean_npes must be specified for concurrent coupling.' ) - if (atmos_npes+ocean_npes.NE.npes ) & - call fms_mpp_error( FATAL, 'coupler_init: atmos_npes+ocean_npes must equal npes for concurrent coupling.' ) - else !serial timestepping - if ((atmos_npes.EQ.0) .and. (do_atmos .or. do_land .or. do_ice)) atmos_npes = npes - if ((ocean_npes.EQ.0) .and. (do_ocean)) ocean_npes = npes - if (max(atmos_npes,ocean_npes).EQ.npes) then !overlapping pelists - ! do nothing - else !disjoint pelists - if (atmos_npes+ocean_npes.NE.npes ) call fms_mpp_error( FATAL, & - 'coupler_init: atmos_npes+ocean_npes must equal npes for serial coupling on disjoint pelists.' ) - endif - endif - - if (land_npes == 0 ) land_npes = atmos_npes - if (land_npes > atmos_npes) call fms_mpp_error(FATAL, 'coupler_init: land_npes > atmos_npes') - - if (ice_npes == 0 ) ice_npes = atmos_npes - if (ice_npes > atmos_npes) call fms_mpp_error(FATAL, 'coupler_init: ice_npes > atmos_npes') - - allocate( Atm%pelist (atmos_npes) ) - allocate( Ocean%pelist(ocean_npes) ) - allocate( Land%pelist (land_npes) ) - allocate( Ice%fast_pelist(ice_npes) ) - - !Set up and declare all the needed pelists - call fms_ensemble_manager_ensemble_pelist_setup(concurrent, atmos_npes, ocean_npes, land_npes, ice_npes, & - Atm%pelist, Ocean%pelist, Land%pelist, Ice%fast_pelist) - -!set up affinities based on threads - - ensemble_id = get_ensemble_id() - - allocate(ensemble_pelist(1:ensemble_size,1:npes)) - call fms_ensemble_manager_get_ensemble_pelist(ensemble_pelist) - - Atm%pe = ANY(Atm%pelist .EQ. fms_mpp_pe()) - Ocean%is_ocean_pe = ANY(Ocean%pelist .EQ. fms_mpp_pe()) - Land%pe = ANY(Land%pelist .EQ. fms_mpp_pe()) - - Ice%shared_slow_fast_PEs = .not.slow_ice_with_ocean - ! However, if using a data atmosphere and slow_ice_with_ocean then shared_slow_fast_PEs - ! will be true. In this case, all procesors do the ocean, slow ice, and fast ice. - if (slow_ice_with_ocean.and.(.not.do_atmos)) Ice%shared_slow_fast_PEs = .true. - ! This is where different settings would be applied if the fast and slow - ! ice occurred on different PEs. - if (do_atmos) then - if (Ice%shared_slow_fast_PEs) then - ! Fast and slow ice processes occur on the same PEs. - allocate( Ice%pelist (ice_npes) ) - Ice%pelist(:) = Ice%fast_pelist(:) - allocate( Ice%slow_pelist(ice_npes) ) - Ice%slow_pelist(:) = Ice%fast_pelist(:) - if(concurrent) then - allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) - slow_ice_ocean_pelist(1:ice_npes) = Ice%slow_pelist(:) - slow_ice_ocean_pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) - else - if(ice_npes .GE. ocean_npes) then - allocate(slow_ice_ocean_pelist(ice_npes)) - slow_ice_ocean_pelist(:) = Ice%slow_pelist(:) - else - allocate(slow_ice_ocean_pelist(ocean_npes)) - slow_ice_ocean_pelist(:) = Ocean%pelist(:) - endif - endif - else - ! Fast ice processes occur a subset of the atmospheric PEs, while - ! slow ice processes occur on the ocean PEs. - allocate( Ice%slow_pelist(ocean_npes) ) - Ice%slow_pelist(:) = Ocean%pelist(:) - allocate( Ice%pelist (ice_npes+ocean_npes) ) - ! Set Ice%pelist() to be the union of Ice%fast_pelist and Ice%slow_pelist. - Ice%pelist(1:ice_npes) = Ice%fast_pelist(:) - Ice%pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) - allocate(slow_ice_ocean_pelist(ocean_npes)) - slow_ice_ocean_pelist(:) = Ocean%pelist(:) - endif - elseif (.not.do_atmos) then - ! In the no atmos cases, shared_slow_fast_PEs is not enough to distinguish - ! the slow and fast ice procesor layout; slow_ice_with_ocean should be used instead. - if (slow_ice_with_ocean) then - ! data atmos, using combined ice-ocean driver - ! Both fast ice and slow ice processes occur on the same PEs, - ! since the Atmos and Ocean PEs are shared - allocate( Ice%slow_pelist(ocean_npes) ) - Ice%slow_pelist(:) = Ocean%pelist(:) - allocate( Ice%pelist (ice_npes) ) - Ice%pelist(1:ice_npes) = Ice%fast_pelist(:) - allocate(slow_ice_ocean_pelist(ocean_npes)) - slow_ice_ocean_pelist(:) = Ocean%pelist(:) - else - ! data atmos, not using combined ice-ocean driver - allocate( Ice%pelist (ice_npes) ) - Ice%pelist(:) = Ice%fast_pelist(:) - allocate( Ice%slow_pelist(ice_npes) ) - Ice%slow_pelist(:) = Ice%fast_pelist(:) - if(ice_npes .GE. ocean_npes) then - allocate(slow_ice_ocean_pelist(ice_npes)) - slow_ice_ocean_pelist(:) = Ice%slow_pelist(:) - else - allocate(slow_ice_ocean_pelist(ocean_npes)) - slow_ice_ocean_pelist(:) = Ocean%pelist(:) - endif - endif - endif - Ice%fast_ice_pe = ANY(Ice%fast_pelist(:) .EQ. fms_mpp_pe()) - Ice%slow_ice_pe = ANY(Ice%slow_pelist(:) .EQ. fms_mpp_pe()) - Ice%pe = Ice%fast_ice_pe .OR. Ice%slow_ice_pe - call fms_mpp_declare_pelist(slow_ice_ocean_pelist) - !--- dynamic threading turned off when affinity placement is in use -!$ call omp_set_dynamic(.FALSE.) - !--- nested OpenMP enabled for OpenMP concurrent components -!$ call omp_set_max_active_levels(3) - - if (Atm%pe) then - call fms_mpp_set_current_pelist( Atm%pelist ) -!$ if (.not.do_concurrent_radiation) radiation_nthreads=atmos_nthreads -!$ if (do_concurrent_radiation) conc_nthreads=2 - !--- setting affinity - if (do_concurrent_radiation) then -!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads + radiation_nthreads) -!$ call omp_set_num_threads(atmos_nthreads+radiation_nthreads) - else -!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads) -!$ call omp_set_num_threads(atmos_nthreads) - endif - endif - - !--- initialization clock - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - id_atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - id_land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) - endif - if (Ice%pe) then - if (Ice%shared_slow_fast_PEs) then - call fms_mpp_set_current_pelist(Ice%pelist) - elseif (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - else - call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") - endif - id_ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - id_ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) - endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - id_flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) - - call fms_mpp_set_current_pelist() - mainClock = fms_mpp_clock_id( 'Main loop' ) - termClock = fms_mpp_clock_id( 'Termination' ) - - !Write out messages on root PEs - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - write( text,'(a,2i6,a,i2.2)' )'Atmos PE range: ', Atm%pelist(1) , Atm%pelist(atmos_npes) ,& - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - if (ocean_npes .gt. 0) then - write( text,'(a,2i6,a,i2.2)' )'Ocean PE range: ', Ocean%pelist(1), Ocean%pelist(ocean_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - else - write( text,'(a,i2.2)' )'Ocean PE range is not set (do_ocean=.false. and concurrent=.false.) for ens_', & - ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - endif - write( text,'(a,2i6,a,i2.2)' )'Land PE range: ', Land%pelist(1) , Land%pelist(land_npes) ,& - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - if (.not.concurrent_ice) then - write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - elseif (concurrent_ice) then - if (do_atmos) then - write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes+ocean_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - elseif ((.not.do_atmos)) then - write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - endif - call fms_mpp_error( NOTE, 'coupler_init: Running with CONCURRENT ICE coupling.' ) - write( text,'(a,2i6,a,i2.2)' )'slow Ice PE range: ', Ice%slow_pelist(1), Ice%slow_pelist(ocean_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - write( text,'(a,2i6,a,i2.2)' )'fast Ice PE range: ', Ice%fast_pelist(1), Ice%fast_pelist(ice_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - endif - - if (concurrent) then - call fms_mpp_error( NOTE, 'coupler_init: Running with CONCURRENT coupling.' ) - - write( logunit,'(a)' )'Using concurrent coupling...' - write( logunit,'(a,4i6)' ) & - 'atmos_pe_start, atmos_pe_end, ocean_pe_start, ocean_pe_end=', & - Atm%pelist(1) , Atm%pelist(atmos_npes), Ocean%pelist(1), Ocean%pelist(ocean_npes) - else - call fms_mpp_error( NOTE, 'coupler_init: Running with SERIAL coupling.' ) - endif - if (use_lag_fluxes) then - call fms_mpp_error( NOTE, 'coupler_init: Sending LAG fluxes to ocean.' ) - else - call fms_mpp_error( NOTE, 'coupler_init: Sending most recent fluxes to ocean.' ) - endif - if (concurrent_ice) call fms_mpp_error( NOTE, & - 'coupler_init: using lagged slow-ice coupling mode.') - if (combined_ice_and_ocean) call fms_mpp_error( NOTE, & - 'coupler_init: advancing the ocean and slow-ice in a single call.') - if (combined_ice_and_ocean .and. .not.concurrent_ice) call fms_mpp_error( FATAL, & - 'coupler_init: concurrent_ice must be true if combined_ice_and_ocean is true.') - if (combined_ice_and_ocean .and. .not.slow_ice_with_ocean) call fms_mpp_error( FATAL, & - 'coupler_init: slow_ice_with_ocean must be true if combined_ice_and_ocean is true.') - endif - -!----- write namelist to logfile ----- - if (fms_mpp_pe() == fms_mpp_root_pe() )write( logunit, nml=coupler_nml ) - -!----- write current/initial date actually used to logfile file ----- - - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) & - write( logunit, 16 )date(1),trim(fms_time_manager_month_name(date(2))),date(3:6) -16 format (' current date used = ',i4,1x,a,2i3,2(':',i2.2),' gmt') - -!----------------------------------------------------------------------- -!------ initialize diagnostics manager ------ - -!jwd Fork here is somewhat dangerous. It relies on "no side effects" from -! diag_manager_init. diag_manager_init or this section should be -! re-architected to guarantee this or remove this assumption. -! For instance, what follows assumes that get_base_date has the same -! time for both Atm and Ocean pes. While this should be the case, the -! possible error condition needs to be checked - - diag_model_subset=DIAG_ALL - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - if (atmos_npes /= npes) diag_model_subset = DIAG_OTHER ! change diag_model_subset from DIAG_ALL - elseif (Ocean%is_ocean_pe) then ! Error check above for disjoint pelists should catch any problem - call fms_mpp_set_current_pelist(Ocean%pelist) - ! The FMS diag manager has a convention that segregates files with "ocean" - ! in their names from the other files to handle long diag tables. This - ! does not work if the ice is on the ocean PEs. - if ((ocean_npes /= npes) .and. .not.slow_ice_with_ocean) & - diag_model_subset = DIAG_OCEAN ! change diag_model_subset from DIAG_ALL - endif - if ( fms_mpp_pe() == fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize diag_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - ! initialize diag_manager for processor subset output - call fms_diag_init(DIAG_MODEL_SUBSET=diag_model_subset, TIME_INIT=date) - call fms_memutils_print_memuse_stats( 'diag_manager_init' ) - if ( fms_mpp_pe() == fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing diag_manager at '& - //trim(walldate)//' '//trim(walltime) - endif -!----------------------------------------------------------------------- -!------ reset pelist to "full group" ------ - - call fms_mpp_set_current_pelist() -!----- always override initial/base date with diag_manager value ----- - - call fms_diag_get_base_date ( date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6) ) - -!----- use current date if no base date ------ - - if ( date_init(1) == 0 ) date_init = date - -!----- set initial and current time types ------ - - Time_init = fms_time_manager_set_date (date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6)) - - Time = fms_time_manager_set_date (date(1), date(2), date(3), & - date(4), date(5), date(6)) - - Time_start = Time - -!----- compute the ending time ----- - - Time_end = Time - do m=1,months - Time_end = Time_end + fms_time_manager_set_time(0,fms_time_manager_days_in_month(Time_end)) - enddo - Time_end = Time_end + fms_time_manager_set_time(hours*3600+minutes*60+seconds, days) - !Need to pass Time_end into diag_manager for multiple thread case. - call fms_diag_set_time_end(Time_end) - - Run_length = Time_end - Time - -!--- get the time that last intermediate restart file was written out. - if (fms2_io_file_exists('INPUT/coupler.intermediate.res')) then - call fms2_io_ascii_read('INPUT/coupler.intermediate.res', restart_file) - read(restart_file(1), *) date_restart - deallocate(restart_file) - else - date_restart = date - endif - - Time_restart_current = Time - if (ALL(restart_interval ==0)) then - Time_restart = fms_time_manager_increment_date(Time_end, 0, 0, 10, 0, 0, 0) ! no intermediate restart - else - Time_restart = fms_time_manager_set_date(date_restart(1), date_restart(2), date_restart(3), & - date_restart(4), date_restart(5), date_restart(6) ) - Time_restart = fms_time_manager_increment_date(Time_restart, restart_interval(1), restart_interval(2), & - restart_interval(3), restart_interval(4), restart_interval(5), restart_interval(6) ) - if (Time_restart <= Time) call fms_mpp_error(FATAL, & - '==>Error from program coupler: The first intermediate restart time is no larger than the start time') - endif - -!----------------------------------------------------------------------- -!----- write time stamps (for start time and end time) ------ - - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') - - month = fms_time_manager_month_name(date(2)) - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) - - call fms_time_manager_get_date (Time_end, date(1), date(2), date(3), & - date(4), date(5), date(6)) - month = fms_time_manager_month_name(date(2)) - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) - - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) close(time_stamp_unit) - -20 format (i6,5i4,2x,a3) - -!----------------------------------------------------------------------- -!----- compute the time steps ------ - - Time_step_cpld = fms_time_manager_set_time (dt_cpld ,0) - Time_step_atmos = fms_time_manager_set_time (dt_atmos,0) - -!----- determine maximum number of iterations per loop ------ - - num_cpld_calls = Run_length / Time_step_cpld - num_atmos_calls = Time_step_cpld / Time_step_atmos - -!----------------------------------------------------------------------- -!------------------- some error checks --------------------------------- - -!----- initial time cannot be greater than current time ------- - - if ( Time_init > Time ) call error_mesg ('program coupler', & - 'initial time is greater than current time', FATAL) - -!----- make sure run length is a multiple of ocean time step ------ - - if ( num_cpld_calls * Time_step_cpld /= Run_length ) & - call error_mesg ('program coupler', & - 'run length must be multiple of coupled time step', FATAL) - -! ---- make sure cpld time step is a multiple of atmos time step ---- - - if ( num_atmos_calls * Time_step_atmos /= Time_step_cpld ) & - call error_mesg ('program coupler', & - 'cpld time step is not a multiple of the atmos time step', FATAL) - -! -! Initialize the tracer manager. This needs to be done on all PEs, -! before the individual models are initialized. -! - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize tracer_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_tracer_manager_init() -! Initialize the gas-exchange fluxes so this information can be made -! available to the individual components. - call gas_exchange_init(gas_fields_atm, gas_fields_ocn, gas_fluxes) - call fms_coupler_types_init() - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing tracer_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - - - -!----------------------------------------------------------------------- -!------ initialize component models ------ -!------ grid info now comes from grid_spec file - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Beginning to initialize component models at '& - //trim(walldate)//' '//trim(walltime) - endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) -!---- atmosphere ---- - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize atmospheric model at '& - //trim(walldate)//' '//trim(walltime) - endif - - call fms_mpp_clock_begin(id_atmos_model_init) - - call atmos_model_init( Atm, Time_init, Time, Time_step_atmos, & - do_concurrent_radiation) - - call fms_mpp_clock_end(id_atmos_model_init) - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing atmospheric model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_memutils_print_memuse_stats( 'atmos_model_init' ) - call fms_data_override_init(Atm_domain_in = Atm%domain) - endif -!---- land ---------- - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize land model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_clock_begin(id_land_model_init) - call land_model_init( Atmos_land_boundary, Land, Time_init, Time, & - Time_step_atmos, Time_step_cpld ) - call fms_mpp_clock_end(id_land_model_init) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing land model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_memutils_print_memuse_stats( 'land_model_init' ) - call fms_data_override_init(Land_domain_in = Land%domain) -#ifndef _USE_LEGACY_LAND_ - call fms_data_override_init(Land_domainUG_in = Land%ug_domain) -#endif - endif -!---- ice ----------- - if (Ice%pe) then ! This occurs for all fast or slow ice PEs. - if (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - else - call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") - endif - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize ice model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_clock_begin(id_ice_model_init) - call ice_model_init(Ice, Time_init, Time, Time_step_atmos, & - Time_step_cpld, Verona_coupler=.false., & - concurrent_ice=concurrent_ice, & - gas_fluxes=gas_fluxes, gas_fields_ocn=gas_fields_ocn ) - call fms_mpp_clock_end(id_ice_model_init) - - ! This must be called using the union of the ice PE_lists. - call fms_mpp_set_current_pelist(Ice%pelist) - call share_ice_domains(Ice) - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing ice model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_memutils_print_memuse_stats( 'ice_model_init' ) - if (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - call fms_data_override_init(Ice_domain_in = Ice%domain) - endif - endif - -!---- ocean --------- - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize ocean model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_clock_begin(id_ocean_model_init) - call ocean_model_init( Ocean, Ocean_state, Time_init, Time, & - gas_fields_ocn=gas_fields_ocn ) - call fms_mpp_clock_end(id_ocean_model_init) - - if (concurrent) then - call fms_mpp_set_current_pelist( Ocean%pelist ) -!$ call fms_affinity_set('OCEAN', use_hyper_thread, ocean_nthreads) -!$ call omp_set_num_threads(ocean_nthreads) - else - ocean_nthreads = atmos_nthreads - !--- omp_num_threads has already been set by the Atmos-pes, but set again to ensure -!$ call omp_set_num_threads(ocean_nthreads) - endif - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing ocean model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_memutils_print_memuse_stats( 'ocean_model_init' ) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize data_override at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_data_override_init(Ocean_domain_in = Ocean%domain ) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing data_override at '& - //trim(walldate)//' '//trim(walltime) - endif - - if (combined_ice_and_ocean) & - call ice_ocean_driver_init(ice_ocean_driver_CS, Time_init, Time) - - endif ! end of Ocean%is_ocean_pe - -!--------------------------------------------- - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing component models at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - - call fms_mpp_domains_broadcast_domain(Ice%domain) - call fms_mpp_domains_broadcast_domain(Ice%slow_domain_NH) - call fms_mpp_domains_broadcast_domain(Ocean%domain) -!----------------------------------------------------------------------- -!---- initialize flux exchange module ---- - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize flux_exchange at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_clock_begin(id_flux_exchange_init) - call flux_exchange_init ( Time, Atm, Land, Ice, Ocean, Ocean_state,& - atmos_ice_boundary, land_ice_atmos_boundary, & - land_ice_boundary, ice_ocean_boundary, ocean_ice_boundary, & - do_ocean, slow_ice_ocean_pelist, dt_atmos=dt_atmos, dt_cpld=dt_cpld) - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - call fms_mpp_clock_end(id_flux_exchange_init) - call fms_mpp_set_current_pelist() - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finsihed initializing flux_exchange at '& - //trim(walldate)//' '//trim(walltime) - endif - - Time_atmos = Time - Time_ocean = Time - -! -! read in extra fields for the air-sea gas fluxes -! - if ( Ice%slow_ice_pe ) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - - call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & - num_ice_bc_restart, Ice%slow_domain_NH, to_read=.true., ocean_restart=.false., directory="INPUT/") - - ! Restore the fields from the restart files - do l = 1, num_ice_bc_restart - if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_read_restart(Ice_bc_restart(l)) - enddo - - ! Check whether the restarts were read successfully. - call fms_coupler_type_restore_state(Ice%ocean_fluxes, use_fms2_io=.true., & - test_by_field=.true.) - - do l = 1, num_ice_bc_restart - if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_close_file(Ice_bc_restart(l)) - enddo - endif !< ( Ice%slow_ice_pe ) - - if ( Ocean%is_ocean_pe ) then - call fms_mpp_set_current_pelist(Ocean%pelist) - - call fms_coupler_type_register_restarts(Ocean%fields, Ocn_bc_restart, & - num_ocn_bc_restart, Ocean%domain, to_read=.true., ocean_restart=.true., directory="INPUT/") - - ! Restore the fields from the restart files - do l = 1, num_ocn_bc_restart - if(fms2_io_check_if_open(Ocn_bc_restart(l))) call fms2_io_read_restart(Ocn_bc_restart(l)) - enddo - - ! Check whether the restarts were read successfully. - call fms_coupler_type_restore_state(Ocean%fields, use_fms2_io=.true., & - test_by_field=.true.) - - do l = 1, num_ocn_bc_restart - if(fms2_io_check_if_open(Ocn_bc_restart(l))) call fms2_io_close_file(Ocn_bc_restart(l)) - enddo - endif !< ( Ocean%is_ocean_pe ) - - call fms_mpp_set_current_pelist() - -!----------------------------------------------------------------------- -!---- open and close dummy file in restart dir to check if dir exists -- - - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) then - open(newunit = ascii_unit, file='RESTART/file', status='replace', form='formatted') - close(ascii_unit,status="delete") - endif - - ! Call to daig_grid_end to free up memory used during regional - ! output setup - CALL fms_diag_grid_end() - -!----------------------------------------------------------------------- - if ( do_endpoint_chksum ) then - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum('coupler_init+', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ice%slow_ice_PE) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum('coupler_init+', 0, Ocean, Ice_ocean_boundary) - endif - endif - - call fms_mpp_set_current_pelist() - call fms_memutils_print_memuse_stats('coupler_init') - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Exiting coupler_init at '& - //trim(walldate)//' '//trim(walltime) - endif - end subroutine coupler_init - -!####################################################################### - - subroutine coupler_end() - -!----------------------------------------------------------------------- - - if ( do_endpoint_chksum ) then - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum('coupler_end', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ice%slow_ice_PE) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum('coupler_end', 0, Ocean, Ice_ocean_boundary) - endif - endif - call fms_mpp_set_current_pelist() - -!----- check time versus expected ending time ---- - - if (Time /= Time_end) call error_mesg ('program coupler', & - 'final time does not match expected ending time', WARNING) - -!----------------------------------------------------------------------- -!the call to fms_io_exit has been moved here -!this will work for serial code or concurrent (disjoint pelists) -!but will fail on overlapping but unequal pelists - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_model_end (Ocean, Ocean_state, Time) - endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_model_end ( Atm ) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - call land_model_end (Atmos_land_boundary, Land) - endif - if (Ice%pe) then ! This happens on all fast or slow ice PEs. - if (Ice%slow_ice_PE) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - else ! This must be a fast ice PE. - call fms_mpp_set_current_pelist(Ice%fast_pelist) - endif - call ice_model_end (Ice) - endif - - !----- write restart file ------ - call coupler_restart(Time, Time_restart_current) - - call fms_diag_end (Time) -#ifdef use_deprecated_io - call fms_io_exit -#endif - call fms_mpp_set_current_pelist() - - -!----------------------------------------------------------------------- - - end subroutine coupler_end - - !>@brief Register the axis data as a variable in the netcdf file and add some dummy data. - !! This is needed so the combiner can work correctly when the io_layout is not 1,1 - subroutine add_domain_dimension_data(fileobj) - type(FmsNetcdfDomainFile_t) :: fileobj !< Fms2io domain decomposed fileobj - integer, dimension(:), allocatable :: buffer !< Buffer with axis data - integer :: is, ie !< Starting and Ending indices for data - - call fms2_io_get_global_io_domain_indices(fileobj, "xaxis_1", is, ie, indices=buffer) - call fms2_io_write_data(fileobj, "xaxis_1", buffer) - deallocate(buffer) - - call fms2_io_get_global_io_domain_indices(fileobj, "yaxis_1", is, ie, indices=buffer) - call fms2_io_write_data(fileobj, "yaxis_1", buffer) - deallocate(buffer) - - end subroutine add_domain_dimension_data - - - !> \brief Writing restart file that contains running time and restart file writing time. - subroutine coupler_restart(Time_run, Time_res, time_stamp) - type(FmsTime_type), intent(in) :: Time_run, Time_res - character(len=*), intent(in), optional :: time_stamp - character(len=128) :: file_run, file_res - integer :: yr, mon, day, hr, min, sec, date(6), n - integer :: restart_unit !< Unit for the coupler restart file - - call fms_mpp_set_current_pelist() - - ! write restart file - if (present(time_stamp)) then - file_run = 'RESTART/'//trim(time_stamp)//'.coupler.res' - file_res = 'RESTART/'//trim(time_stamp)//'.coupler.intermediate.res' - else - file_run = 'RESTART/coupler.res' - file_res = 'RESTART/coupler.intermediate.res' - endif - - !----- compute current date ------ - call fms_time_manager_get_date (Time_run, date(1), date(2), date(3), & - date(4), date(5), date(6)) - if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then - open(newunit = restart_unit, file=file_run, status='replace', form='formatted') - write(restart_unit, '(i6,8x,a)' )calendar_type, & - '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - - write(restart_unit, '(6i6,8x,a)' )date_init, & - 'Model start time: year, month, day, hour, minute, second' - write(restart_unit, '(6i6,8x,a)' )date, & - 'Current model time: year, month, day, hour, minute, second' - close(restart_unit) - endif - - if (Time_res > Time_start) then - if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then - open(newunit = restart_unit, file=file_res, status='replace', form='formatted') - call fms_time_manager_get_date(Time_res ,yr,mon,day,hr,min,sec) - write(restart_unit, '(6i6,8x,a)' )yr,mon,day,hr,min,sec, & - 'Current intermediate restart time: year, month, day, hour, minute, second' - close(restart_unit) - endif - endif - - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - if (associated(Ocn_bc_restart)) deallocate(Ocn_bc_restart) - - call fms_coupler_type_register_restarts(Ocean%fields, Ocn_bc_restart, & - num_ocn_bc_restart, Ocean%domain, to_read=.false., ocean_restart=.true., directory="RESTART/") - do n = 1, num_ocn_bc_restart - if (fms2_io_check_if_open(Ocn_bc_restart(n))) then - call fms2_io_write_restart(Ocn_bc_restart(n)) - call add_domain_dimension_data(Ocn_bc_restart(n)) - call fms2_io_close_file(Ocn_bc_restart(n)) - endif - enddo - endif !< (Ocean%is_ocean_pe) - - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - - if (associated(Ice_bc_restart)) deallocate(Ice_bc_restart) - call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & - num_ice_bc_restart, Ice%slow_domain_NH, to_read=.false., ocean_restart=.false., directory="RESTART/") - do n = 1, num_ice_bc_restart - if (fms2_io_check_if_open(Ice_bc_restart(n))) then - call fms2_io_write_restart(Ice_bc_restart(n)) - call add_domain_dimension_data(Ice_bc_restart(n)) - call fms2_io_close_file(Ice_bc_restart(n)) - endif - enddo - endif !< (Atm%pe) - - end subroutine coupler_restart - -!-------------------------------------------------------------------------- - -!> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(id, timestep) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - - type :: tracer_ind_type - integer :: atm, ice, lnd ! indices of the tracer in the respective models - end type tracer_ind_type - integer :: n_atm_tr, n_lnd_tr, n_exch_tr - integer :: n_atm_tr_tot, n_lnd_tr_tot - integer :: i, tr, n, m, outunit - type(tracer_ind_type), allocatable :: tr_table(:) - character(32) :: tr_name - - call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, & - num_prog=n_atm_tr) - call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, & - num_prog=n_lnd_tr) - - ! Assemble the table of tracer number translation by matching names of - ! prognostic tracers in the atmosphere and surface models; skip all atmos. - ! tracers that have no corresponding surface tracers. - allocate(tr_table(n_atm_tr)) - n = 1 - do i = 1,n_atm_tr - call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, i, tr_name ) - tr_table(n)%atm = i - tr_table(n)%ice = fms_tracer_manager_get_tracer_index ( MODEL_ICE, tr_name ) - tr_table(n)%lnd = fms_tracer_manager_get_tracer_index ( MODEL_LAND, tr_name ) - if (tr_table(n)%ice/=NO_TRACER .or. tr_table(n)%lnd/=NO_TRACER) n = n+1 - enddo - n_exch_tr = n-1 - -100 FORMAT("CHECKSUM::",A32," = ",Z20) -101 FORMAT("CHECKSUM::",A16,a,'%',a," = ",Z20) - - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - - outunit = fms_mpp_stdout() - write(outunit,*) 'BEGIN CHECKSUM(Atm):: ', id, timestep - write(outunit,100) 'atm%t_bot', fms_mpp_chksum(atm%t_bot) - write(outunit,100) 'atm%z_bot', fms_mpp_chksum(atm%z_bot) - write(outunit,100) 'atm%p_bot', fms_mpp_chksum(atm%p_bot) - write(outunit,100) 'atm%u_bot', fms_mpp_chksum(atm%u_bot) - write(outunit,100) 'atm%v_bot', fms_mpp_chksum(atm%v_bot) - write(outunit,100) 'atm%p_surf', fms_mpp_chksum(atm%p_surf) - write(outunit,100) 'atm%gust', fms_mpp_chksum(atm%gust) - do tr = 1,n_exch_tr - n = tr_table(tr)%atm - if (n /= NO_TRACER) then - call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) - write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(Atm%tr_bot(:,:,n)) - endif - enddo - - write(outunit,100) 'land%t_surf', fms_mpp_chksum(land%t_surf) - write(outunit,100) 'land%t_ca', fms_mpp_chksum(land%t_ca) - write(outunit,100) 'land%rough_mom', fms_mpp_chksum(land%rough_mom) - write(outunit,100) 'land%rough_heat', fms_mpp_chksum(land%rough_heat) - write(outunit,100) 'land%rough_scale', fms_mpp_chksum(land%rough_scale) - do tr = 1,n_exch_tr - n = tr_table(tr)%lnd - if (n /= NO_TRACER) then - call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) -#ifndef _USE_LEGACY_LAND_ - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,n)) -#else - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,:,n)) -#endif - endif - enddo - - write(outunit,100) 'ice%t_surf', fms_mpp_chksum(ice%t_surf) - write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(ice%rough_mom) - write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(ice%rough_heat) - write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(ice%rough_moist) - write(outunit,*) 'STOP CHECKSUM(Atm):: ', id, timestep - - !endif - - !if (Ocean%is_ocean_pe) then - !call mpp_set_current_pelist(Ocean%pelist) - - write(outunit,*) 'BEGIN CHECKSUM(Ice):: ', id, timestep - call fms_coupler_type_write_chksums(Ice%ocean_fields, outunit, 'ice%') - write(outunit,*) 'STOP CHECKSUM(Ice):: ', id, timestep - - endif - - deallocate(tr_table) - - call fms_mpp_set_current_pelist() - - end subroutine coupler_chksum - - !####################################################################### - -!> \brief This subroutine calls subroutine that will print out checksums of the elements -!! of the appropriate type. -!! -!! For coupled models typically these types are not defined on all processors. -!! It is assumed that the appropriate pelist has been set before entering this routine. -!! This can be achieved in the following way. -!! ~~~~~~~~~~{.f90} -!! if (Atm%pe) then -!! call mpp_set_current_pelist(Atm%pelist) -!! call atmos_ice_land_chksum('MAIN_LOOP-', nc) -!! endif -!! ~~~~~~~~~~ -!! If you are on the global pelist before you enter this routine using the above call, -!! you can return to the global pelist by invoking -!! ~~~~~~~~~~{.f90} -!! call mpp_set_current_pelist() -!! ~~~~~~~~~~ -!! after you exit. This is only necessary if you need to return to the global pelist. - subroutine atmos_ice_land_chksum(id, timestep, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, & - Atmos_land_boundary) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type (atmos_data_type), intent(in) :: Atm - type (land_data_type), intent(in) :: Land - type (ice_data_type), intent(in) :: Ice - type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary - type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary - - call atmos_data_type_chksum( id, timestep, Atm) - call lnd_ice_atm_bnd_type_chksum(id, timestep, Land_ice_atmos_boundary) - - if (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - call ice_data_type_chksum( id, timestep, Ice) - call atm_ice_bnd_type_chksum(id, timestep, Atmos_ice_boundary) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - call land_data_type_chksum( id, timestep, Land) - call atm_lnd_bnd_type_chksum(id, timestep, Atmos_land_boundary) - endif - - call fms_mpp_set_current_pelist(Atm%pelist) - - end subroutine atmos_ice_land_chksum - -!> \brief This subroutine calls subroutine that will print out checksums of the elements -!! of the appropriate type. -!! -!! For coupled models typically these types are not defined on all processors. -!! It is assumed that the appropriate pelist has been set before entering this routine. -!! This can be achieved in the following way. -!! ~~~~~~~~~~{.f90} -!! if (Ice%slow_ice_pe) then -!! call mpp_set_current_pelist(Ice%slow_pelist) -!! call slow_ice_chksum('MAIN_LOOP-', nc) -!! endif -!! ~~~~~~~~~~ -!! If you are on the global pelist before you enter this routine using the above call, -!! you can return to the global pelist by invoking -!! ~~~~~~~~~~{.f90} -!! call mpp_set_current_pelist() -!! ~~~~~~~~~~ -!! after you exit. This is only necessary if you need to return to the global pelist. - subroutine slow_ice_chksum(id, timestep, Ice, Ocean_ice_boundary) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ice_data_type), intent(in) :: Ice - type(ocean_ice_boundary_type), intent(in) :: Ocean_ice_boundary - - call ice_data_type_chksum( id, timestep, Ice) - call ocn_ice_bnd_type_chksum( id, timestep, Ocean_ice_boundary) - - end subroutine slow_ice_chksum - - -!> \brief This subroutine calls subroutine that will print out checksums of the elements -!! of the appropriate type. -!! -!! For coupled models typically these types are not defined on all processors. -!! It is assumed that the appropriate pelist has been set before entering this routine. -!! This can be achieved in the following way. -!! ~~~~~~~~~~{.f90} -!! if (Ocean%is_ocean_pe) then -!! call mpp_set_current_pelist(Ocean%pelist) -!! call ocean_chksum('MAIN_LOOP-', nc) -!! endif -!! ~~~~~~~~~~ -!! If you are on the global pelist before you enter this routine using the above call, -!! you can return to the global pelist by invoking -!! ~~~~~~~~~~{.f90} -!! call mpp_set_current_pelist() -!! ~~~~~~~~~~ -!! after you exit. This is only necessary if you need to return to the global pelist. - subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type (ocean_public_type), intent(in) :: Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - - call ocean_public_type_chksum(id, timestep, Ocean) - call ice_ocn_bnd_type_chksum( id, timestep, Ice_ocean_boundary) - - end subroutine ocean_chksum - - end program coupler_main From bbfe3b64eab85b5c3e8248f8effcbc6f9d788204 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 29 Jan 2024 08:09:19 -0500 Subject: [PATCH 02/78] add coupler_wrapper --- full/coupler_wrapper.F90 | 1424 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 1424 insertions(+) create mode 100644 full/coupler_wrapper.F90 diff --git a/full/coupler_wrapper.F90 b/full/coupler_wrapper.F90 new file mode 100644 index 00000000..f42207f8 --- /dev/null +++ b/full/coupler_wrapper.F90 @@ -0,0 +1,1424 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS) Coupler. +!* +!* FMS Coupler is free software: you can redistribute it and/or modify +!* it under the terms of the GNU Lesser General Public License as +!* published by the Free Software Foundation, either version 3 of the +!* License, or (at your option) any later version. +!* +!* FMS Coupler is distributed in the hope that it will be useful, but +!* WITHOUT ANY WARRANTY; without even the implied warranty of +!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +!* General Public License for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS Coupler. +!* If not, see . +!*********************************************************************** +module coupler_wrapper_mod + + use FMS !, status_fms=>status + use FMSconstants, only: fmsconstants_init + +#ifdef use_deprecated_io + use fms_io_mod, only: fms_io_exit +#endif + +! model interfaces used to couple the component models: +! atmosphere, land, ice, and ocean +! + + use atmos_model_mod, only: atmos_model_init, atmos_model_end + use atmos_model_mod, only: update_atmos_model_dynamics + use atmos_model_mod, only: update_atmos_model_down + use atmos_model_mod, only: update_atmos_model_up + use atmos_model_mod, only: atmos_data_type + use atmos_model_mod, only: land_ice_atmos_boundary_type + use atmos_model_mod, only: atmos_data_type_chksum + use atmos_model_mod, only: lnd_ice_atm_bnd_type_chksum + use atmos_model_mod, only: lnd_atm_bnd_type_chksum + use atmos_model_mod, only: ice_atm_bnd_type_chksum + use atmos_model_mod, only: atmos_model_restart + use atmos_model_mod, only: update_atmos_model_radiation + use atmos_model_mod, only: update_atmos_model_state + + use land_model_mod, only: land_model_init, land_model_end + use land_model_mod, only: land_data_type, atmos_land_boundary_type + use land_model_mod, only: update_land_model_fast, update_land_model_slow + use land_model_mod, only: atm_lnd_bnd_type_chksum + use land_model_mod, only: land_data_type_chksum + use land_model_mod, only: land_model_restart + + use ice_model_mod, only: ice_model_init, share_ice_domains, ice_model_end, ice_model_restart + use ice_model_mod, only: update_ice_model_fast, set_ice_surface_fields + use ice_model_mod, only: ice_data_type, land_ice_boundary_type + use ice_model_mod, only: ocean_ice_boundary_type, atmos_ice_boundary_type + use ice_model_mod, only: ice_data_type_chksum, ocn_ice_bnd_type_chksum + use ice_model_mod, only: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum + use ice_model_mod, only: unpack_ocean_ice_boundary, exchange_slow_to_fast_ice + use ice_model_mod, only: ice_model_fast_cleanup, unpack_land_ice_boundary + use ice_model_mod, only: exchange_fast_to_slow_ice, update_ice_model_slow + + use ocean_model_mod, only: update_ocean_model, ocean_model_init, ocean_model_end + use ocean_model_mod, only: ocean_public_type, ocean_state_type, ice_ocean_boundary_type + use ocean_model_mod, only: ocean_model_restart + use ocean_model_mod, only: ocean_public_type_chksum, ice_ocn_bnd_type_chksum + + use combined_ice_ocean_driver, only: update_slow_ice_and_ocean, ice_ocean_driver_type + use combined_ice_ocean_driver, only: ice_ocean_driver_init, ice_ocean_driver_end +! +! flux_ calls translate information between model grids - see flux_exchange.f90 +! + + use flux_exchange_mod, only: flux_exchange_init, gas_exchange_init, sfc_boundary_layer + use flux_exchange_mod, only: generate_sfc_xgrid, send_ice_mask_sic + use flux_exchange_mod, only: flux_down_from_atmos, flux_up_to_atmos + use flux_exchange_mod, only: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice + use flux_exchange_mod, only: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish + use flux_exchange_mod, only: flux_check_stocks, flux_init_stocks + use flux_exchange_mod, only: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks + use flux_exchange_mod, only: flux_atmos_to_ocean, flux_ex_arrays_dealloc + + use atmos_tracer_driver_mod, only: atmos_tracer_driver_gather_data + + use iso_fortran_env + + implicit none + +!----------------------------------------------------------------------- + + character(len=128) :: version = '$Id$' + character(len=128) :: tag = '$Name$' + +!----------------------------------------------------------------------- +!---- model defined-types ---- + + type (atmos_data_type) :: Atm + type (land_data_type) :: Land + type (ice_data_type) :: Ice + ! allow members of ocean type to be aliased (ap) + type (ocean_public_type), target :: Ocean + type (ocean_state_type), pointer :: Ocean_state => NULL() + + type(atmos_land_boundary_type) :: Atmos_land_boundary + type(atmos_ice_boundary_type) :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary + type(land_ice_boundary_type) :: Land_ice_boundary + type(ice_ocean_boundary_type) :: Ice_ocean_boundary + type(ocean_ice_boundary_type) :: Ocean_ice_boundary + type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() + +!----------------------------------------------------------------------- +! ----- coupled model time ----- + + type (FmsTime_type) :: Time, Time_init, Time_end, & + Time_step_atmos, Time_step_cpld + type(FmsTime_type) :: Time_atmos, Time_ocean + type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice + + integer :: num_atmos_calls, na + integer :: num_cpld_calls, nc + + type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() + type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() + + integer :: num_ice_bc_restart=0, num_ocn_bc_restart=0 + type(FmsTime_type) :: Time_restart, Time_restart_current, Time_start + character(len=32) :: timestamp + +! ----- coupled model initial date ----- + + integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) + integer :: calendar_type = INVALID_CALENDAR + +!----------------------------------------------------------------------- +!------ namelist interface ------- + + integer, dimension(6) :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) !< The time interval that write out intermediate restart file. + !! The format is (yr,mo,day,hr,min,sec). When restart_interval + !! is all zero, no intermediate restart file will be written out + integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See + !! force_date_from_namelist.) + character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are + !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. + !! The value 'no_calendar' cannot be used because the time_manager's date + !! functions are used. All values must be lower case. + logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date should override + !! the date in the restart file `INPUT/coupler.res`. If the restart file does not + !! exist then force_date_from_namelist has no effect, the value of current_date + !! will be used. + integer :: months=0 !< Number of months the current integration will be run + integer :: days=0 !< Number of days the current integration will be run + integer :: hours=0 !< Number of hours the current integration will be run + integer :: minutes=0 !< Number of minutes the current integration will be run + integer :: seconds=0 !< Number of seconds the current integration will be run + integer :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fat coupling with land and sea ice + integer :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must be an + !! integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. + integer :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere + integer :: ocean_npes=0 !< The number of MPI tasks to use for the ocean + integer :: ice_npes=0 !< The number of MPI tasks to use for the ice + integer :: land_npes=0 !< The number of MPI tasks to use for the land + integer :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere + integer :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean + integer :: radiation_nthreads=1 !< Number of threads to use for the radiation. + logical :: do_atmos =.true. !< Indicates if this component should be executed. If .FALSE., then execution is skipped. + !! This is used when ALL the output fields sent by this component to the coupler have been + !! overridden using the data_override feature. This is for advanced users only. + logical :: do_land =.true. !< See do_atmos + logical :: do_ice =.true. !< See do_atmos + logical :: do_ocean=.true. !< See do_atmos + logical :: do_flux =.true. !< See do_atmos + logical :: concurrent=.FALSE. !< If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate + !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. + !! If .FALSE., the execution is serial: call atmos... followed by call ocean... + logical :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently + logical :: use_lag_fluxes=.TRUE. !< If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. + !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog + !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable + !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there + !! is probably sufficient damping for MOM4. For more modern ocean models (such as + !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. + !! should be much more stable. + logical :: concurrent_ice=.FALSE. !< If .TRUE., the slow sea-ice is forced with the fluxes that were used for the + !! fast ice processes one timestep before. When used in conjuction with setting + !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and + !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can + !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. + logical :: slow_ice_with_ocean=.FALSE. !< If true, the slow sea-ice is advanced on the ocean processors. Otherwise + !! the slow sea-ice processes are on the same PEs as the fast sea-ice. + logical :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance + !! both the slow sea-ice and the ocean. slow_ice_with_ocean and + !! concurrent_ice must both be true if combined_ice_and_ocean is true. + logical :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. + logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. + logical :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. + integer :: check_stocks = 0 ! -1: never 0: at end of run only n>0: every n coupled steps + logical :: use_hyper_thread = .false. + + namelist /coupler_nml/ current_date, calendar, force_date_from_namelist, & + months, days, hours, minutes, seconds, dt_cpld, dt_atmos, & + do_atmos, do_land, do_ice, do_ocean, do_flux, & + atmos_npes, ocean_npes, ice_npes, land_npes, & + atmos_nthreads, ocean_nthreads, radiation_nthreads, & + concurrent, do_concurrent_radiation, use_lag_fluxes, & + check_stocks, restart_interval, do_debug, do_chksum, & + use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & + do_endpoint_chksum, combined_ice_and_ocean + + integer :: initClock, mainClock, termClock + + integer :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 + integer :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e + integer :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka + integer :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki + integer :: newClockj, newClockk, newClockl + + integer :: id_atmos_model_init, id_land_model_init, id_ice_model_init + integer :: id_ocean_model_init, id_flux_exchange_init + + character(len=80) :: text + character(len=48), parameter :: mod_name = 'coupler_main_mod' + + integer :: outunit + integer :: ensemble_id = 1 + integer, allocatable :: ensemble_pelist(:, :) + integer, allocatable :: slow_ice_ocean_pelist(:) + integer :: conc_nthreads = 1 + real :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 + +contains + +!####################################################################### + +!> \brief Initialize all defined exchange grids and all boundary maps + subroutine coupler_init + + use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_id,ensemble_pelist_setup + use ensemble_manager_mod, only : get_ensemble_size, get_ensemble_pelist + + +! +!----------------------------------------------------------------------- +! local parameters +!----------------------------------------------------------------------- +! + + character(len=64), parameter :: sub_name = 'coupler_init' + character(len=256), parameter :: error_header = & + '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):' + character(len=256), parameter :: note_header = & + '==>Note from ' // trim(mod_name) // '(' // trim(sub_name) // '):' + + integer :: ierr, io, m, i, outunit, logunit, errunit + integer :: date(6) + type (FmsTime_type) :: Run_length + character(len=9) :: month + integer :: pe, npes + + integer :: ens_siz(6), ensemble_size + + integer :: atmos_pe_start=0, atmos_pe_end=0, & + ocean_pe_start=0, ocean_pe_end=0 + integer :: n + integer :: diag_model_subset=DIAG_ALL + logical :: other_fields_exist + character(len=256) :: err_msg + integer :: date_restart(6) + character(len=64) :: filename, fieldname + integer :: id_restart, l + character(len=8) :: walldate + character(len=10) :: walltime + character(len=5) :: wallzone + integer :: wallvalues(8) + character(len=:), dimension(:), allocatable :: restart_file !< Restart file saved as a string + integer :: time_stamp_unit !< Unif of the time_stamp file + integer :: ascii_unit !< Unit of a dummy ascii file + + type(FmsCoupler1dBC_type), pointer :: & + gas_fields_atm => NULL(), & ! A pointer to the type describing the + ! atmospheric fields that will participate in the gas fluxes. + gas_fields_ocn => NULL(), & ! A pointer to the type describing the ocean + ! and ice surface fields that will participate in the gas fluxes. + gas_fluxes => NULL() ! A pointer to the type describing the + ! atmosphere-ocean gas and tracer fluxes. +!----------------------------------------------------------------------- + + outunit = fms_mpp_stdout() + errunit = fms_mpp_stderr() + logunit = fms_mpp_stdlog() + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Entering coupler_init at '& + //trim(walldate)//' '//trim(walltime) + endif + +!----- write version to logfile ------- + call fms_write_version_number(version, tag) + +!----- read namelist ------- + + read (fms_mpp_input_nml_file, coupler_nml, iostat=io) + ierr = check_nml_error (io, 'coupler_nml') + +!----- read date and calendar type from restart file ----- + if (fms2_io_file_exists('INPUT/coupler.res')) then + call fms2_io_ascii_read('INPUT/coupler.res', restart_file) + read(restart_file(1), *) calendar_type + read(restart_file(2), *) date_init + read(restart_file(3), *) date + deallocate(restart_file) + else + force_date_from_namelist = .true. + endif + +!----- use namelist value (either no restart or override flag on) --- + + if ( force_date_from_namelist ) then + + if ( sum(current_date) <= 0 ) then + call error_mesg ('program coupler', & + 'no namelist value for base_date or current_date', FATAL) + else + date = current_date + endif + +!----- override calendar type with namelist value ----- + + select case( fms_mpp_uppercase(trim(calendar)) ) + case( 'GREGORIAN' ) + calendar_type = GREGORIAN + case( 'JULIAN' ) + calendar_type = JULIAN + case( 'NOLEAP' ) + calendar_type = NOLEAP + case( 'THIRTY_DAY' ) + calendar_type = THIRTY_DAY_MONTHS + case( 'NO_CALENDAR' ) + calendar_type = NO_CALENDAR + end select + + endif + + call fms_time_manager_set_calendar_type (calendar_type, err_msg) + if (err_msg /= '') then + call fms_mpp_error(FATAL, 'ERROR in coupler_init: '//trim(err_msg)) + endif + + if (concurrent .AND. .NOT.(use_lag_fluxes .OR. concurrent_ice) ) & + call fms_mpp_error( WARNING, 'coupler_init: you have set concurrent=TRUE, & + & use_lag_fluxes=FALSE, and concurrent_ice=FALSE & + & in coupler_nml. When not using lag fluxes, components & + & will synchronize at two points, and thus run serially.' ) + if (concurrent_ice .AND. .NOT.slow_ice_with_ocean ) call fms_mpp_error(WARNING, & + 'coupler_init: concurrent_ice is true, but slow ice_with_ocean is & + & false in coupler_nml. These two flags should both be true to avoid & + & effectively serializing the run.' ) + if (use_lag_fluxes .AND. concurrent_ice ) call fms_mpp_error(WARNING, & + 'coupler_init: use_lag_fluxes and concurrent_ice are both true. & + & These two coupling options are intended to be exclusive.' ) + + !Check with the ensemble_manager module for the size of ensemble + !and PE counts for each member of the ensemble. + ! + !NOTE: ensemble_manager_init renames all the output files (restart and diagnostics) + ! to show which ensemble member they are coming from. + ! There also need to be restart files for each member of the ensemble in INPUT. + ! + !NOTE: if the ensemble_size=1 the input/output files will not be renamed. + ! + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting initializing ensemble_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_ensemble_manager_init() ! init pelists for ensembles + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing ensemble_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + ens_siz = get_ensemble_size() + ensemble_size = ens_siz(1) + npes = ens_siz(2) + + !Check for the consistency of PE counts + if (concurrent) then +!atmos_npes + ocean_npes must equal npes + if (atmos_npes.EQ.0 ) atmos_npes = npes - ocean_npes + if (ocean_npes.EQ.0 ) ocean_npes = npes - atmos_npes +!both must now be non-zero + if (atmos_npes.EQ.0 .OR. ocean_npes.EQ.0 ) & + call fms_mpp_error( FATAL, 'coupler_init: atmos_npes or ocean_npes must be specified for concurrent coupling.' ) + if (atmos_npes+ocean_npes.NE.npes ) & + call fms_mpp_error( FATAL, 'coupler_init: atmos_npes+ocean_npes must equal npes for concurrent coupling.' ) + else !serial timestepping + if ((atmos_npes.EQ.0) .and. (do_atmos .or. do_land .or. do_ice)) atmos_npes = npes + if ((ocean_npes.EQ.0) .and. (do_ocean)) ocean_npes = npes + if (max(atmos_npes,ocean_npes).EQ.npes) then !overlapping pelists + ! do nothing + else !disjoint pelists + if (atmos_npes+ocean_npes.NE.npes ) call fms_mpp_error( FATAL, & + 'coupler_init: atmos_npes+ocean_npes must equal npes for serial coupling on disjoint pelists.' ) + endif + endif + + if (land_npes == 0 ) land_npes = atmos_npes + if (land_npes > atmos_npes) call fms_mpp_error(FATAL, 'coupler_init: land_npes > atmos_npes') + + if (ice_npes == 0 ) ice_npes = atmos_npes + if (ice_npes > atmos_npes) call fms_mpp_error(FATAL, 'coupler_init: ice_npes > atmos_npes') + + allocate( Atm%pelist (atmos_npes) ) + allocate( Ocean%pelist(ocean_npes) ) + allocate( Land%pelist (land_npes) ) + allocate( Ice%fast_pelist(ice_npes) ) + + !Set up and declare all the needed pelists + call fms_ensemble_manager_ensemble_pelist_setup(concurrent, atmos_npes, ocean_npes, land_npes, ice_npes, & + Atm%pelist, Ocean%pelist, Land%pelist, Ice%fast_pelist) + +!set up affinities based on threads + + ensemble_id = get_ensemble_id() + + allocate(ensemble_pelist(1:ensemble_size,1:npes)) + call fms_ensemble_manager_get_ensemble_pelist(ensemble_pelist) + + Atm%pe = ANY(Atm%pelist .EQ. fms_mpp_pe()) + Ocean%is_ocean_pe = ANY(Ocean%pelist .EQ. fms_mpp_pe()) + Land%pe = ANY(Land%pelist .EQ. fms_mpp_pe()) + + Ice%shared_slow_fast_PEs = .not.slow_ice_with_ocean + ! However, if using a data atmosphere and slow_ice_with_ocean then shared_slow_fast_PEs + ! will be true. In this case, all procesors do the ocean, slow ice, and fast ice. + if (slow_ice_with_ocean.and.(.not.do_atmos)) Ice%shared_slow_fast_PEs = .true. + ! This is where different settings would be applied if the fast and slow + ! ice occurred on different PEs. + if (do_atmos) then + if (Ice%shared_slow_fast_PEs) then + ! Fast and slow ice processes occur on the same PEs. + allocate( Ice%pelist (ice_npes) ) + Ice%pelist(:) = Ice%fast_pelist(:) + allocate( Ice%slow_pelist(ice_npes) ) + Ice%slow_pelist(:) = Ice%fast_pelist(:) + if(concurrent) then + allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) + slow_ice_ocean_pelist(1:ice_npes) = Ice%slow_pelist(:) + slow_ice_ocean_pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) + else + if(ice_npes .GE. ocean_npes) then + allocate(slow_ice_ocean_pelist(ice_npes)) + slow_ice_ocean_pelist(:) = Ice%slow_pelist(:) + else + allocate(slow_ice_ocean_pelist(ocean_npes)) + slow_ice_ocean_pelist(:) = Ocean%pelist(:) + endif + endif + else + ! Fast ice processes occur a subset of the atmospheric PEs, while + ! slow ice processes occur on the ocean PEs. + allocate( Ice%slow_pelist(ocean_npes) ) + Ice%slow_pelist(:) = Ocean%pelist(:) + allocate( Ice%pelist (ice_npes+ocean_npes) ) + ! Set Ice%pelist() to be the union of Ice%fast_pelist and Ice%slow_pelist. + Ice%pelist(1:ice_npes) = Ice%fast_pelist(:) + Ice%pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) + allocate(slow_ice_ocean_pelist(ocean_npes)) + slow_ice_ocean_pelist(:) = Ocean%pelist(:) + endif + elseif (.not.do_atmos) then + ! In the no atmos cases, shared_slow_fast_PEs is not enough to distinguish + ! the slow and fast ice procesor layout; slow_ice_with_ocean should be used instead. + if (slow_ice_with_ocean) then + ! data atmos, using combined ice-ocean driver + ! Both fast ice and slow ice processes occur on the same PEs, + ! since the Atmos and Ocean PEs are shared + allocate( Ice%slow_pelist(ocean_npes) ) + Ice%slow_pelist(:) = Ocean%pelist(:) + allocate( Ice%pelist (ice_npes) ) + Ice%pelist(1:ice_npes) = Ice%fast_pelist(:) + allocate(slow_ice_ocean_pelist(ocean_npes)) + slow_ice_ocean_pelist(:) = Ocean%pelist(:) + else + ! data atmos, not using combined ice-ocean driver + allocate( Ice%pelist (ice_npes) ) + Ice%pelist(:) = Ice%fast_pelist(:) + allocate( Ice%slow_pelist(ice_npes) ) + Ice%slow_pelist(:) = Ice%fast_pelist(:) + if(ice_npes .GE. ocean_npes) then + allocate(slow_ice_ocean_pelist(ice_npes)) + slow_ice_ocean_pelist(:) = Ice%slow_pelist(:) + else + allocate(slow_ice_ocean_pelist(ocean_npes)) + slow_ice_ocean_pelist(:) = Ocean%pelist(:) + endif + endif + endif + Ice%fast_ice_pe = ANY(Ice%fast_pelist(:) .EQ. fms_mpp_pe()) + Ice%slow_ice_pe = ANY(Ice%slow_pelist(:) .EQ. fms_mpp_pe()) + Ice%pe = Ice%fast_ice_pe .OR. Ice%slow_ice_pe + call fms_mpp_declare_pelist(slow_ice_ocean_pelist) + !--- dynamic threading turned off when affinity placement is in use +!$ call omp_set_dynamic(.FALSE.) + !--- nested OpenMP enabled for OpenMP concurrent components +!$ call omp_set_max_active_levels(3) + + if (Atm%pe) then + call fms_mpp_set_current_pelist( Atm%pelist ) +!$ if (.not.do_concurrent_radiation) radiation_nthreads=atmos_nthreads +!$ if (do_concurrent_radiation) conc_nthreads=2 + !--- setting affinity + if (do_concurrent_radiation) then +!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads + radiation_nthreads) +!$ call omp_set_num_threads(atmos_nthreads+radiation_nthreads) + else +!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads) +!$ call omp_set_num_threads(atmos_nthreads) + endif + endif + + !--- initialization clock + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + id_atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + id_land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + endif + if (Ice%pe) then + if (Ice%shared_slow_fast_PEs) then + call fms_mpp_set_current_pelist(Ice%pelist) + elseif (Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + else + call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") + endif + id_ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + id_ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + endif + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + id_flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + + call fms_mpp_set_current_pelist() + mainClock = fms_mpp_clock_id( 'Main loop' ) + termClock = fms_mpp_clock_id( 'Termination' ) + + !Write out messages on root PEs + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + write( text,'(a,2i6,a,i2.2)' )'Atmos PE range: ', Atm%pelist(1) , Atm%pelist(atmos_npes) ,& + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + if (ocean_npes .gt. 0) then + write( text,'(a,2i6,a,i2.2)' )'Ocean PE range: ', Ocean%pelist(1), Ocean%pelist(ocean_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + else + write( text,'(a,i2.2)' )'Ocean PE range is not set (do_ocean=.false. and concurrent=.false.) for ens_', & + ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + endif + write( text,'(a,2i6,a,i2.2)' )'Land PE range: ', Land%pelist(1) , Land%pelist(land_npes) ,& + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + if (.not.concurrent_ice) then + write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + elseif (concurrent_ice) then + if (do_atmos) then + write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes+ocean_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + elseif ((.not.do_atmos)) then + write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + endif + call fms_mpp_error( NOTE, 'coupler_init: Running with CONCURRENT ICE coupling.' ) + write( text,'(a,2i6,a,i2.2)' )'slow Ice PE range: ', Ice%slow_pelist(1), Ice%slow_pelist(ocean_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + write( text,'(a,2i6,a,i2.2)' )'fast Ice PE range: ', Ice%fast_pelist(1), Ice%fast_pelist(ice_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + endif + + if (concurrent) then + call fms_mpp_error( NOTE, 'coupler_init: Running with CONCURRENT coupling.' ) + + write( logunit,'(a)' )'Using concurrent coupling...' + write( logunit,'(a,4i6)' ) & + 'atmos_pe_start, atmos_pe_end, ocean_pe_start, ocean_pe_end=', & + Atm%pelist(1) , Atm%pelist(atmos_npes), Ocean%pelist(1), Ocean%pelist(ocean_npes) + else + call fms_mpp_error( NOTE, 'coupler_init: Running with SERIAL coupling.' ) + endif + if (use_lag_fluxes) then + call fms_mpp_error( NOTE, 'coupler_init: Sending LAG fluxes to ocean.' ) + else + call fms_mpp_error( NOTE, 'coupler_init: Sending most recent fluxes to ocean.' ) + endif + if (concurrent_ice) call fms_mpp_error( NOTE, & + 'coupler_init: using lagged slow-ice coupling mode.') + if (combined_ice_and_ocean) call fms_mpp_error( NOTE, & + 'coupler_init: advancing the ocean and slow-ice in a single call.') + if (combined_ice_and_ocean .and. .not.concurrent_ice) call fms_mpp_error( FATAL, & + 'coupler_init: concurrent_ice must be true if combined_ice_and_ocean is true.') + if (combined_ice_and_ocean .and. .not.slow_ice_with_ocean) call fms_mpp_error( FATAL, & + 'coupler_init: slow_ice_with_ocean must be true if combined_ice_and_ocean is true.') + endif + +!----- write namelist to logfile ----- + if (fms_mpp_pe() == fms_mpp_root_pe() )write( logunit, nml=coupler_nml ) + +!----- write current/initial date actually used to logfile file ----- + + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) & + write( logunit, 16 )date(1),trim(fms_time_manager_month_name(date(2))),date(3:6) +16 format (' current date used = ',i4,1x,a,2i3,2(':',i2.2),' gmt') + +!----------------------------------------------------------------------- +!------ initialize diagnostics manager ------ + +!jwd Fork here is somewhat dangerous. It relies on "no side effects" from +! diag_manager_init. diag_manager_init or this section should be +! re-architected to guarantee this or remove this assumption. +! For instance, what follows assumes that get_base_date has the same +! time for both Atm and Ocean pes. While this should be the case, the +! possible error condition needs to be checked + + diag_model_subset=DIAG_ALL + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + if (atmos_npes /= npes) diag_model_subset = DIAG_OTHER ! change diag_model_subset from DIAG_ALL + elseif (Ocean%is_ocean_pe) then ! Error check above for disjoint pelists should catch any problem + call fms_mpp_set_current_pelist(Ocean%pelist) + ! The FMS diag manager has a convention that segregates files with "ocean" + ! in their names from the other files to handle long diag tables. This + ! does not work if the ice is on the ocean PEs. + if ((ocean_npes /= npes) .and. .not.slow_ice_with_ocean) & + diag_model_subset = DIAG_OCEAN ! change diag_model_subset from DIAG_ALL + endif + if ( fms_mpp_pe() == fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize diag_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + ! initialize diag_manager for processor subset output + call fms_diag_init(DIAG_MODEL_SUBSET=diag_model_subset, TIME_INIT=date) + call fms_memutils_print_memuse_stats( 'diag_manager_init' ) + if ( fms_mpp_pe() == fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing diag_manager at '& + //trim(walldate)//' '//trim(walltime) + endif +!----------------------------------------------------------------------- +!------ reset pelist to "full group" ------ + + call fms_mpp_set_current_pelist() +!----- always override initial/base date with diag_manager value ----- + + call fms_diag_get_base_date ( date_init(1), date_init(2), date_init(3), & + date_init(4), date_init(5), date_init(6) ) + +!----- use current date if no base date ------ + + if ( date_init(1) == 0 ) date_init = date + +!----- set initial and current time types ------ + + Time_init = fms_time_manager_set_date (date_init(1), date_init(2), date_init(3), & + date_init(4), date_init(5), date_init(6)) + + Time = fms_time_manager_set_date (date(1), date(2), date(3), & + date(4), date(5), date(6)) + + Time_start = Time + +!----- compute the ending time ----- + + Time_end = Time + do m=1,months + Time_end = Time_end + fms_time_manager_set_time(0,fms_time_manager_days_in_month(Time_end)) + enddo + Time_end = Time_end + fms_time_manager_set_time(hours*3600+minutes*60+seconds, days) + !Need to pass Time_end into diag_manager for multiple thread case. + call fms_diag_set_time_end(Time_end) + + Run_length = Time_end - Time + +!--- get the time that last intermediate restart file was written out. + if (fms2_io_file_exists('INPUT/coupler.intermediate.res')) then + call fms2_io_ascii_read('INPUT/coupler.intermediate.res', restart_file) + read(restart_file(1), *) date_restart + deallocate(restart_file) + else + date_restart = date + endif + + Time_restart_current = Time + if (ALL(restart_interval ==0)) then + Time_restart = fms_time_manager_increment_date(Time_end, 0, 0, 10, 0, 0, 0) ! no intermediate restart + else + Time_restart = fms_time_manager_set_date(date_restart(1), date_restart(2), date_restart(3), & + date_restart(4), date_restart(5), date_restart(6) ) + Time_restart = fms_time_manager_increment_date(Time_restart, restart_interval(1), restart_interval(2), & + restart_interval(3), restart_interval(4), restart_interval(5), restart_interval(6) ) + if (Time_restart <= Time) call fms_mpp_error(FATAL, & + '==>Error from program coupler: The first intermediate restart time is no larger than the start time') + endif + +!----------------------------------------------------------------------- +!----- write time stamps (for start time and end time) ------ + + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') + + month = fms_time_manager_month_name(date(2)) + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) + + call fms_time_manager_get_date (Time_end, date(1), date(2), date(3), & + date(4), date(5), date(6)) + month = fms_time_manager_month_name(date(2)) + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) + + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) close(time_stamp_unit) + +20 format (i6,5i4,2x,a3) + +!----------------------------------------------------------------------- +!----- compute the time steps ------ + + Time_step_cpld = fms_time_manager_set_time (dt_cpld ,0) + Time_step_atmos = fms_time_manager_set_time (dt_atmos,0) + +!----- determine maximum number of iterations per loop ------ + + num_cpld_calls = Run_length / Time_step_cpld + num_atmos_calls = Time_step_cpld / Time_step_atmos + +!----------------------------------------------------------------------- +!------------------- some error checks --------------------------------- + +!----- initial time cannot be greater than current time ------- + + if ( Time_init > Time ) call error_mesg ('program coupler', & + 'initial time is greater than current time', FATAL) + +!----- make sure run length is a multiple of ocean time step ------ + + if ( num_cpld_calls * Time_step_cpld /= Run_length ) & + call error_mesg ('program coupler', & + 'run length must be multiple of coupled time step', FATAL) + +! ---- make sure cpld time step is a multiple of atmos time step ---- + + if ( num_atmos_calls * Time_step_atmos /= Time_step_cpld ) & + call error_mesg ('program coupler', & + 'cpld time step is not a multiple of the atmos time step', FATAL) + +! +! Initialize the tracer manager. This needs to be done on all PEs, +! before the individual models are initialized. +! + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize tracer_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_tracer_manager_init() +! Initialize the gas-exchange fluxes so this information can be made +! available to the individual components. + call gas_exchange_init(gas_fields_atm, gas_fields_ocn, gas_fluxes) + call fms_coupler_types_init() + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing tracer_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + + + +!----------------------------------------------------------------------- +!------ initialize component models ------ +!------ grid info now comes from grid_spec file + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Beginning to initialize component models at '& + //trim(walldate)//' '//trim(walltime) + endif + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) +!---- atmosphere ---- + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize atmospheric model at '& + //trim(walldate)//' '//trim(walltime) + endif + + call fms_mpp_clock_begin(id_atmos_model_init) + + call atmos_model_init( Atm, Time_init, Time, Time_step_atmos, & + do_concurrent_radiation) + + call fms_mpp_clock_end(id_atmos_model_init) + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing atmospheric model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_memutils_print_memuse_stats( 'atmos_model_init' ) + call fms_data_override_init(Atm_domain_in = Atm%domain) + endif +!---- land ---------- + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize land model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_clock_begin(id_land_model_init) + call land_model_init( Atmos_land_boundary, Land, Time_init, Time, & + Time_step_atmos, Time_step_cpld ) + call fms_mpp_clock_end(id_land_model_init) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing land model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_memutils_print_memuse_stats( 'land_model_init' ) + call fms_data_override_init(Land_domain_in = Land%domain) +#ifndef _USE_LEGACY_LAND_ + call fms_data_override_init(Land_domainUG_in = Land%ug_domain) +#endif + endif +!---- ice ----------- + if (Ice%pe) then ! This occurs for all fast or slow ice PEs. + if (Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + else + call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") + endif + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize ice model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_clock_begin(id_ice_model_init) + call ice_model_init(Ice, Time_init, Time, Time_step_atmos, & + Time_step_cpld, Verona_coupler=.false., & + concurrent_ice=concurrent_ice, & + gas_fluxes=gas_fluxes, gas_fields_ocn=gas_fields_ocn ) + call fms_mpp_clock_end(id_ice_model_init) + + ! This must be called using the union of the ice PE_lists. + call fms_mpp_set_current_pelist(Ice%pelist) + call share_ice_domains(Ice) + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing ice model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_memutils_print_memuse_stats( 'ice_model_init' ) + if (Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(Ice%fast_pelist) + call fms_data_override_init(Ice_domain_in = Ice%domain) + endif + endif + +!---- ocean --------- + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize ocean model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_clock_begin(id_ocean_model_init) + call ocean_model_init( Ocean, Ocean_state, Time_init, Time, & + gas_fields_ocn=gas_fields_ocn ) + call fms_mpp_clock_end(id_ocean_model_init) + + if (concurrent) then + call fms_mpp_set_current_pelist( Ocean%pelist ) +!$ call fms_affinity_set('OCEAN', use_hyper_thread, ocean_nthreads) +!$ call omp_set_num_threads(ocean_nthreads) + else + ocean_nthreads = atmos_nthreads + !--- omp_num_threads has already been set by the Atmos-pes, but set again to ensure +!$ call omp_set_num_threads(ocean_nthreads) + endif + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing ocean model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_memutils_print_memuse_stats( 'ocean_model_init' ) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize data_override at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_data_override_init(Ocean_domain_in = Ocean%domain ) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing data_override at '& + //trim(walldate)//' '//trim(walltime) + endif + + if (combined_ice_and_ocean) & + call ice_ocean_driver_init(ice_ocean_driver_CS, Time_init, Time) + + endif ! end of Ocean%is_ocean_pe + +!--------------------------------------------- + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing component models at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + + call fms_mpp_domains_broadcast_domain(Ice%domain) + call fms_mpp_domains_broadcast_domain(Ice%slow_domain_NH) + call fms_mpp_domains_broadcast_domain(Ocean%domain) +!----------------------------------------------------------------------- +!---- initialize flux exchange module ---- + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize flux_exchange at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_clock_begin(id_flux_exchange_init) + call flux_exchange_init ( Time, Atm, Land, Ice, Ocean, Ocean_state,& + atmos_ice_boundary, land_ice_atmos_boundary, & + land_ice_boundary, ice_ocean_boundary, ocean_ice_boundary, & + do_ocean, slow_ice_ocean_pelist, dt_atmos=dt_atmos, dt_cpld=dt_cpld) + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + call fms_mpp_clock_end(id_flux_exchange_init) + call fms_mpp_set_current_pelist() + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finsihed initializing flux_exchange at '& + //trim(walldate)//' '//trim(walltime) + endif + + Time_atmos = Time + Time_ocean = Time + +! +! read in extra fields for the air-sea gas fluxes +! + if ( Ice%slow_ice_pe ) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + + call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & + num_ice_bc_restart, Ice%slow_domain_NH, to_read=.true., ocean_restart=.false., directory="INPUT/") + + ! Restore the fields from the restart files + do l = 1, num_ice_bc_restart + if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_read_restart(Ice_bc_restart(l)) + enddo + + ! Check whether the restarts were read successfully. + call fms_coupler_type_restore_state(Ice%ocean_fluxes, use_fms2_io=.true., & + test_by_field=.true.) + + do l = 1, num_ice_bc_restart + if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_close_file(Ice_bc_restart(l)) + enddo + endif !< ( Ice%slow_ice_pe ) + + if ( Ocean%is_ocean_pe ) then + call fms_mpp_set_current_pelist(Ocean%pelist) + + call fms_coupler_type_register_restarts(Ocean%fields, Ocn_bc_restart, & + num_ocn_bc_restart, Ocean%domain, to_read=.true., ocean_restart=.true., directory="INPUT/") + + ! Restore the fields from the restart files + do l = 1, num_ocn_bc_restart + if(fms2_io_check_if_open(Ocn_bc_restart(l))) call fms2_io_read_restart(Ocn_bc_restart(l)) + enddo + + ! Check whether the restarts were read successfully. + call fms_coupler_type_restore_state(Ocean%fields, use_fms2_io=.true., & + test_by_field=.true.) + + do l = 1, num_ocn_bc_restart + if(fms2_io_check_if_open(Ocn_bc_restart(l))) call fms2_io_close_file(Ocn_bc_restart(l)) + enddo + endif !< ( Ocean%is_ocean_pe ) + + call fms_mpp_set_current_pelist() + +!----------------------------------------------------------------------- +!---- open and close dummy file in restart dir to check if dir exists -- + + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) then + open(newunit = ascii_unit, file='RESTART/file', status='replace', form='formatted') + close(ascii_unit,status="delete") + endif + + ! Call to daig_grid_end to free up memory used during regional + ! output setup + CALL fms_diag_grid_end() + +!----------------------------------------------------------------------- + if ( do_endpoint_chksum ) then + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum('coupler_init+', 0, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ice%slow_ice_PE) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_chksum('coupler_init+', 0, Ocean, Ice_ocean_boundary) + endif + endif + + call fms_mpp_set_current_pelist() + call fms_memutils_print_memuse_stats('coupler_init') + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Exiting coupler_init at '& + //trim(walldate)//' '//trim(walltime) + endif + end subroutine coupler_init + +!####################################################################### + + subroutine coupler_end() + +!----------------------------------------------------------------------- + + if ( do_endpoint_chksum ) then + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum('coupler_end', 0, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ice%slow_ice_PE) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + call slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_chksum('coupler_end', 0, Ocean, Ice_ocean_boundary) + endif + endif + call fms_mpp_set_current_pelist() + +!----- check time versus expected ending time ---- + + if (Time /= Time_end) call error_mesg ('program coupler', & + 'final time does not match expected ending time', WARNING) + +!----------------------------------------------------------------------- +!the call to fms_io_exit has been moved here +!this will work for serial code or concurrent (disjoint pelists) +!but will fail on overlapping but unequal pelists + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_model_end (Ocean, Ocean_state, Time) + endif + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_model_end ( Atm ) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + call land_model_end (Atmos_land_boundary, Land) + endif + if (Ice%pe) then ! This happens on all fast or slow ice PEs. + if (Ice%slow_ice_PE) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + else ! This must be a fast ice PE. + call fms_mpp_set_current_pelist(Ice%fast_pelist) + endif + call ice_model_end (Ice) + endif + + !----- write restart file ------ + call coupler_restart(Time, Time_restart_current) + + call fms_diag_end (Time) +#ifdef use_deprecated_io + call fms_io_exit +#endif + call fms_mpp_set_current_pelist() + + +!----------------------------------------------------------------------- + + end subroutine coupler_end + + !>@brief Register the axis data as a variable in the netcdf file and add some dummy data. + !! This is needed so the combiner can work correctly when the io_layout is not 1,1 + subroutine add_domain_dimension_data(fileobj) + type(FmsNetcdfDomainFile_t) :: fileobj !< Fms2io domain decomposed fileobj + integer, dimension(:), allocatable :: buffer !< Buffer with axis data + integer :: is, ie !< Starting and Ending indices for data + + call fms2_io_get_global_io_domain_indices(fileobj, "xaxis_1", is, ie, indices=buffer) + call fms2_io_write_data(fileobj, "xaxis_1", buffer) + deallocate(buffer) + + call fms2_io_get_global_io_domain_indices(fileobj, "yaxis_1", is, ie, indices=buffer) + call fms2_io_write_data(fileobj, "yaxis_1", buffer) + deallocate(buffer) + + end subroutine add_domain_dimension_data + + + !> \brief Writing restart file that contains running time and restart file writing time. + subroutine coupler_restart(Time_run, Time_res, time_stamp) + type(FmsTime_type), intent(in) :: Time_run, Time_res + character(len=*), intent(in), optional :: time_stamp + character(len=128) :: file_run, file_res + integer :: yr, mon, day, hr, min, sec, date(6), n + integer :: restart_unit !< Unit for the coupler restart file + + call fms_mpp_set_current_pelist() + + ! write restart file + if (present(time_stamp)) then + file_run = 'RESTART/'//trim(time_stamp)//'.coupler.res' + file_res = 'RESTART/'//trim(time_stamp)//'.coupler.intermediate.res' + else + file_run = 'RESTART/coupler.res' + file_res = 'RESTART/coupler.intermediate.res' + endif + + !----- compute current date ------ + call fms_time_manager_get_date (Time_run, date(1), date(2), date(3), & + date(4), date(5), date(6)) + if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then + open(newunit = restart_unit, file=file_run, status='replace', form='formatted') + write(restart_unit, '(i6,8x,a)' )calendar_type, & + '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' + + write(restart_unit, '(6i6,8x,a)' )date_init, & + 'Model start time: year, month, day, hour, minute, second' + write(restart_unit, '(6i6,8x,a)' )date, & + 'Current model time: year, month, day, hour, minute, second' + close(restart_unit) + endif + + if (Time_res > Time_start) then + if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then + open(newunit = restart_unit, file=file_res, status='replace', form='formatted') + call fms_time_manager_get_date(Time_res ,yr,mon,day,hr,min,sec) + write(restart_unit, '(6i6,8x,a)' )yr,mon,day,hr,min,sec, & + 'Current intermediate restart time: year, month, day, hour, minute, second' + close(restart_unit) + endif + endif + + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + if (associated(Ocn_bc_restart)) deallocate(Ocn_bc_restart) + + call fms_coupler_type_register_restarts(Ocean%fields, Ocn_bc_restart, & + num_ocn_bc_restart, Ocean%domain, to_read=.false., ocean_restart=.true., directory="RESTART/") + do n = 1, num_ocn_bc_restart + if (fms2_io_check_if_open(Ocn_bc_restart(n))) then + call fms2_io_write_restart(Ocn_bc_restart(n)) + call add_domain_dimension_data(Ocn_bc_restart(n)) + call fms2_io_close_file(Ocn_bc_restart(n)) + endif + enddo + endif !< (Ocean%is_ocean_pe) + + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + + if (associated(Ice_bc_restart)) deallocate(Ice_bc_restart) + call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & + num_ice_bc_restart, Ice%slow_domain_NH, to_read=.false., ocean_restart=.false., directory="RESTART/") + do n = 1, num_ice_bc_restart + if (fms2_io_check_if_open(Ice_bc_restart(n))) then + call fms2_io_write_restart(Ice_bc_restart(n)) + call add_domain_dimension_data(Ice_bc_restart(n)) + call fms2_io_close_file(Ice_bc_restart(n)) + endif + enddo + endif !< (Atm%pe) + + end subroutine coupler_restart + +!-------------------------------------------------------------------------- + +!> \brief Print out checksums for several atm, land and ice variables + subroutine coupler_chksum(id, timestep) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + + type :: tracer_ind_type + integer :: atm, ice, lnd ! indices of the tracer in the respective models + end type tracer_ind_type + integer :: n_atm_tr, n_lnd_tr, n_exch_tr + integer :: n_atm_tr_tot, n_lnd_tr_tot + integer :: i, tr, n, m, outunit + type(tracer_ind_type), allocatable :: tr_table(:) + character(32) :: tr_name + + call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, & + num_prog=n_atm_tr) + call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, & + num_prog=n_lnd_tr) + + ! Assemble the table of tracer number translation by matching names of + ! prognostic tracers in the atmosphere and surface models; skip all atmos. + ! tracers that have no corresponding surface tracers. + allocate(tr_table(n_atm_tr)) + n = 1 + do i = 1,n_atm_tr + call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, i, tr_name ) + tr_table(n)%atm = i + tr_table(n)%ice = fms_tracer_manager_get_tracer_index ( MODEL_ICE, tr_name ) + tr_table(n)%lnd = fms_tracer_manager_get_tracer_index ( MODEL_LAND, tr_name ) + if (tr_table(n)%ice/=NO_TRACER .or. tr_table(n)%lnd/=NO_TRACER) n = n+1 + enddo + n_exch_tr = n-1 + +100 FORMAT("CHECKSUM::",A32," = ",Z20) +101 FORMAT("CHECKSUM::",A16,a,'%',a," = ",Z20) + + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + + outunit = fms_mpp_stdout() + write(outunit,*) 'BEGIN CHECKSUM(Atm):: ', id, timestep + write(outunit,100) 'atm%t_bot', fms_mpp_chksum(atm%t_bot) + write(outunit,100) 'atm%z_bot', fms_mpp_chksum(atm%z_bot) + write(outunit,100) 'atm%p_bot', fms_mpp_chksum(atm%p_bot) + write(outunit,100) 'atm%u_bot', fms_mpp_chksum(atm%u_bot) + write(outunit,100) 'atm%v_bot', fms_mpp_chksum(atm%v_bot) + write(outunit,100) 'atm%p_surf', fms_mpp_chksum(atm%p_surf) + write(outunit,100) 'atm%gust', fms_mpp_chksum(atm%gust) + do tr = 1,n_exch_tr + n = tr_table(tr)%atm + if (n /= NO_TRACER) then + call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) + write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(Atm%tr_bot(:,:,n)) + endif + enddo + + write(outunit,100) 'land%t_surf', fms_mpp_chksum(land%t_surf) + write(outunit,100) 'land%t_ca', fms_mpp_chksum(land%t_ca) + write(outunit,100) 'land%rough_mom', fms_mpp_chksum(land%rough_mom) + write(outunit,100) 'land%rough_heat', fms_mpp_chksum(land%rough_heat) + write(outunit,100) 'land%rough_scale', fms_mpp_chksum(land%rough_scale) + do tr = 1,n_exch_tr + n = tr_table(tr)%lnd + if (n /= NO_TRACER) then + call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) +#ifndef _USE_LEGACY_LAND_ + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,n)) +#else + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,:,n)) +#endif + endif + enddo + + write(outunit,100) 'ice%t_surf', fms_mpp_chksum(ice%t_surf) + write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(ice%rough_mom) + write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(ice%rough_heat) + write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(ice%rough_moist) + write(outunit,*) 'STOP CHECKSUM(Atm):: ', id, timestep + + !endif + + !if (Ocean%is_ocean_pe) then + !call mpp_set_current_pelist(Ocean%pelist) + + write(outunit,*) 'BEGIN CHECKSUM(Ice):: ', id, timestep + call fms_coupler_type_write_chksums(Ice%ocean_fields, outunit, 'ice%') + write(outunit,*) 'STOP CHECKSUM(Ice):: ', id, timestep + + endif + + deallocate(tr_table) + + call fms_mpp_set_current_pelist() + + end subroutine coupler_chksum + + !####################################################################### + +!> \brief This subroutine calls subroutine that will print out checksums of the elements +!! of the appropriate type. +!! +!! For coupled models typically these types are not defined on all processors. +!! It is assumed that the appropriate pelist has been set before entering this routine. +!! This can be achieved in the following way. +!! ~~~~~~~~~~{.f90} +!! if (Atm%pe) then +!! call mpp_set_current_pelist(Atm%pelist) +!! call atmos_ice_land_chksum('MAIN_LOOP-', nc) +!! endif +!! ~~~~~~~~~~ +!! If you are on the global pelist before you enter this routine using the above call, +!! you can return to the global pelist by invoking +!! ~~~~~~~~~~{.f90} +!! call mpp_set_current_pelist() +!! ~~~~~~~~~~ +!! after you exit. This is only necessary if you need to return to the global pelist. + subroutine atmos_ice_land_chksum(id, timestep, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, & + Atmos_land_boundary) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type (atmos_data_type), intent(in) :: Atm + type (land_data_type), intent(in) :: Land + type (ice_data_type), intent(in) :: Ice + type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary + type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary + type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary + + call atmos_data_type_chksum( id, timestep, Atm) + call lnd_ice_atm_bnd_type_chksum(id, timestep, Land_ice_atmos_boundary) + + if (Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(Ice%fast_pelist) + call ice_data_type_chksum( id, timestep, Ice) + call atm_ice_bnd_type_chksum(id, timestep, Atmos_ice_boundary) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + call land_data_type_chksum( id, timestep, Land) + call atm_lnd_bnd_type_chksum(id, timestep, Atmos_land_boundary) + endif + + call fms_mpp_set_current_pelist(Atm%pelist) + + end subroutine atmos_ice_land_chksum + +!> \brief This subroutine calls subroutine that will print out checksums of the elements +!! of the appropriate type. +!! +!! For coupled models typically these types are not defined on all processors. +!! It is assumed that the appropriate pelist has been set before entering this routine. +!! This can be achieved in the following way. +!! ~~~~~~~~~~{.f90} +!! if (Ice%slow_ice_pe) then +!! call mpp_set_current_pelist(Ice%slow_pelist) +!! call slow_ice_chksum('MAIN_LOOP-', nc) +!! endif +!! ~~~~~~~~~~ +!! If you are on the global pelist before you enter this routine using the above call, +!! you can return to the global pelist by invoking +!! ~~~~~~~~~~{.f90} +!! call mpp_set_current_pelist() +!! ~~~~~~~~~~ +!! after you exit. This is only necessary if you need to return to the global pelist. + subroutine slow_ice_chksum(id, timestep, Ice, Ocean_ice_boundary) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type(ice_data_type), intent(in) :: Ice + type(ocean_ice_boundary_type), intent(in) :: Ocean_ice_boundary + + call ice_data_type_chksum( id, timestep, Ice) + call ocn_ice_bnd_type_chksum( id, timestep, Ocean_ice_boundary) + + end subroutine slow_ice_chksum + + +!> \brief This subroutine calls subroutine that will print out checksums of the elements +!! of the appropriate type. +!! +!! For coupled models typically these types are not defined on all processors. +!! It is assumed that the appropriate pelist has been set before entering this routine. +!! This can be achieved in the following way. +!! ~~~~~~~~~~{.f90} +!! if (Ocean%is_ocean_pe) then +!! call mpp_set_current_pelist(Ocean%pelist) +!! call ocean_chksum('MAIN_LOOP-', nc) +!! endif +!! ~~~~~~~~~~ +!! If you are on the global pelist before you enter this routine using the above call, +!! you can return to the global pelist by invoking +!! ~~~~~~~~~~{.f90} +!! call mpp_set_current_pelist() +!! ~~~~~~~~~~ +!! after you exit. This is only necessary if you need to return to the global pelist. + subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type (ocean_public_type), intent(in) :: Ocean + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + + call ocean_public_type_chksum(id, timestep, Ocean) + call ice_ocn_bnd_type_chksum( id, timestep, Ice_ocean_boundary) + + end subroutine ocean_chksum + + +end module coupler_wrapper_mod From cae99f484389776dd7e3b81fa677d81789176e6f Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 5 Feb 2024 13:19:34 -0500 Subject: [PATCH 03/78] add clocks, might not compile --- full/coupler_main.F90 | 232 +++---- full/coupler_wrapper.F90 | 1424 -------------------------------------- 2 files changed, 91 insertions(+), 1565 deletions(-) delete mode 100644 full/coupler_wrapper.F90 diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 5dd93a4f..5326521f 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -331,14 +331,11 @@ !! This error should probably not occur because of checks done at initialization time. program coupler_main - !--- F90 module for OpenMP - use omp_lib - use coupler_wrapper_mod + use omp_lib !< F90 module for OpenMP + use full_coupler_mod call fms_mpp_init() - !these clocks are on the global pelist - initClock = fms_mpp_clock_id( 'Initialization' ) - call fms_mpp_clock_begin(initClock) + call fms_mpp_clock_begin(full_coupler_clocks%initialization) call fms_init call fmsconstants_init @@ -346,12 +343,11 @@ program coupler_main call coupler_init if (do_chksum) call coupler_chksum('coupler_init+', 0) - + call fms_mpp_set_current_pelist() + call fms_mpp_clock_end(full_coupler_clocks%initialization) !end initialization - call fms_mpp_clock_end (initClock) !end initialization - - call fms_mpp_clock_begin(mainClock) !begin main loop + call fms_mpp_clock_begin(full_coupler_clocks_clocks%main) !begin main loop !----------------------------------------------------------------------- !------ ocean/slow-ice integration loop ------ @@ -361,61 +357,7 @@ program coupler_main call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state) endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - newClock1 = fms_mpp_clock_id( 'generate_sfc_xgrid' ) - endif - if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - newClock2 = fms_mpp_clock_id( 'flux_ocean_to_ice' ) - newClock3 = fms_mpp_clock_id( 'flux_ice_to_ocean' ) - endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - newClock5 = fms_mpp_clock_id( 'ATM' ) - newClock7 = fms_mpp_clock_id( ' ATM: atmos loop' ) - newClocka = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) - newClockb = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) - newClockl = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') - if (.not. do_concurrent_radiation) then - newClockj = fms_mpp_clock_id( ' A-L: serial radiation' ) - endif - newClockc = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) - newClockd = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) - newClocke = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) - newClockf = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) - newClockg = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) - newClockh = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) - if (do_concurrent_radiation) then - newClockj = fms_mpp_clock_id( ' A-L: concurrent radiation' ) - newClocki = fms_mpp_clock_id( ' A-L: concurrent atmos' ) - endif - newClockk = fms_mpp_clock_id( ' A-L: update_atmos_model_state') - newClock8 = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) - newClock9 = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) - endif - if (Ice%pe) then - if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) - newClock6f = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) - newClock10f = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) - - if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) - newClock6s = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) - newClock10s = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) - newClock11 = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) - - call fms_mpp_set_current_pelist(Ice%pelist) - newClock6e = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) - newClock10e = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - newClock12 = fms_mpp_clock_id( 'OCN' ) - endif - call fms_mpp_set_current_pelist() - newClock4 = fms_mpp_clock_id( 'flux_check_stocks' ) - newClock13 = fms_mpp_clock_id( 'intermediate restart' ) - newClock14 = fms_mpp_clock_id( 'final flux_check_stocks' ) + call full_coupler_set_clock_ids(clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) do nc = 1, num_cpld_calls if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc) @@ -440,21 +382,21 @@ program coupler_main ! With concurrent_ice, these only occur on the ocean PEs. if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then ! If the slow ice is on a subset of the ocean PEs, use the ocean PElist. - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - call fms_mpp_clock_begin(newClock2) - !Redistribute quantities from Ocean to Ocean_ice_boundary - !Ice intent is In. - !Ice is used only for accessing Ice%area and knowing if we are on an Ice pe + call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) + call fms_mpp_clock_begin(full_coupler_clocks%flux_ocean_to_ice) + !Redistribute quantities from Ocean to Ocean_ice_boundary + !Ice intent is In. + !Ice is used only for accessing Ice%area and knowing if we are on an Ice pe call flux_ocean_to_ice( Time, Ocean, Ice, Ocean_ice_boundary ) Time_flux_ocean_to_ice = Time - call fms_mpp_clock_end(newClock2) + call fms_mpp_clock_end(full_coupler_clocks%flux_ocean_to_ice) ! Update Ice_ocean_boundary; the first iteration is supplied by restarts if (use_lag_fluxes) then - call fms_mpp_clock_begin(newClock3) + call fms_mpp_clock_begin(full_coupler_clocks%flux_ice_to_icean) call flux_ice_to_ocean( Time, Ice, Ocean, Ice_ocean_boundary ) Time_flux_ice_to_ocean = Time - call fms_mpp_clock_end(newClock3) + call fms_mpp_clock_end(clocks%flux%flux_ice_to_ocean) endif endif @@ -475,46 +417,46 @@ program coupler_main ! To print the value of frazil heat flux at the right time the following block ! needs to sit here rather than at the end of the coupler loop. if (check_stocks > 0) then - call fms_mpp_clock_begin(newClock4) + call fms_mpp_clock_begin(full_coupler_clocks%flux_check_stocks) if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then call fms_mpp_set_current_pelist() call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) endif - call fms_mpp_clock_end(newClock4) + call fms_mpp_clock_end(full_coupler_clocks%flux_check_stocks) endif if (do_ice .and. Ice%pe) then if (Ice%slow_ice_pe) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call fms_mpp_clock_begin(newClock6s) + call fms_mpp_clock_begin(full_coupler_clocks%set_ice_surface_slow) ! This may do data override or diagnostics on Ice_ocean_boundary. call flux_ocean_to_ice_finish( Time_flux_ocean_to_ice, Ice, Ocean_Ice_Boundary ) call unpack_ocean_ice_boundary( Ocean_ice_boundary, Ice ) if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, Ice, Ocean_ice_boundary) - call fms_mpp_clock_end(newClock6s) + call fms_mpp_clock_end(full_coupler_clocks%set_ice_surface_slow) endif ! This could be a point where the model is serialized if the fast and ! slow ice are on different PEs. if (.not.Ice%shared_slow_fast_PEs) call fms_mpp_set_current_pelist(Ice%pelist) - call fms_mpp_clock_begin(newClock6e) + call fms_mpp_clock_begin(full_coupler_clocks%set_ice_surface_exchange) call exchange_slow_to_fast_ice(Ice) - call fms_mpp_clock_end(newClock6e) + call fms_mpp_clock_end(full_coupler_clocks%set_ice_surface_exchange) if (concurrent_ice) then ! This call occurs all ice PEs. - call fms_mpp_clock_begin(newClock10e) + call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_slow_exchange) call exchange_fast_to_slow_ice(Ice) - call fms_mpp_clock_end(newClock10e) + call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_slow_exchange) endif if (Ice%fast_ice_pe) then if (.not.Ice%shared_slow_fast_PEs) call fms_mpp_set_current_pelist(Ice%fast_pelist) - call fms_mpp_clock_begin(newClock6f) + call fms_mpp_clock_begin(full_coupler_clocks%set_ice_surface_fast) call set_ice_surface_fields(Ice) - call fms_mpp_clock_end(newClock6f) + call fms_mpp_clock_end(full_coupler_clocks%set_ice_surface_fast) endif endif @@ -522,19 +464,19 @@ program coupler_main if (.NOT.(do_ice .and. Ice%pe) .OR. (ice_npes .NE. atmos_npes)) & call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_begin(newClock5) + call fms_mpp_clock_begin(full_coupler_clocks%atm) if (do_chksum) call atmos_ice_land_chksum('set_ice_surface+', nc, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - call fms_mpp_clock_begin(newClock1) + call fms_mpp_clock_begin(full_coupler_clocks%generate_sfc_xgrid) call generate_sfc_xgrid( Land, Ice ) - call fms_mpp_clock_end(newClock1) + call fms_mpp_clock_end(full_coupler_clocks%generate_sfc_xgrid) call send_ice_mask_sic(Time) !----------------------------------------------------------------------- ! ------ atmos/fast-land/fast-ice integration loop ------- - call fms_mpp_clock_begin(newClock7) + call fms_mpp_clock_begin(full_coupler_clocks%atmos_loop) do na = 1, num_atmos_calls if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) @@ -542,18 +484,18 @@ program coupler_main Time_atmos = Time_atmos + Time_step_atmos if (do_atmos) then - call fms_mpp_clock_begin(newClocka) + call fms_mpp_clock_begin(full_coupler_clocks%atmos_tracer_driver_gather_data) call atmos_tracer_driver_gather_data(Atm%fields, Atm%tr_bot) - call fms_mpp_clock_end(newClocka) + call fms_mpp_clock_end(full_coupler_clocks%atmos_tracer_driver_gather_data) endif if (do_flux) then - call fms_mpp_clock_begin(newClockb) + call fms_mpp_clock_begin(full_coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( REAL(dt_atmos), Time_atmos, & Atm, Land, Ice, Land_ice_atmos_boundary ) if (do_chksum) call atmos_ice_land_chksum('sfc+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - call fms_mpp_clock_end(newClockb) + call fms_mpp_clock_end(full_coupler_clocks%sfc_boundary_layer) endif !$OMP PARALLEL & @@ -564,7 +506,11 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki, newClockj, newClockl) +!$OMP& SHARED(full_coupler_clocks%update_atmos_model_down, full_coupler_clocks%flux_down_from_atmos) & +!&OMP& SHARED(full_coupler_clocks%update_land_model_fast, full_coupler_clocks%update_ice_model_fast) & +!&OMP& SHARED(full_coupler_clocks%flux_up_to_atmos, full_coupler_clocks%update_atmos_model_up) & +!&OMP& SHARED(full_coupler_clocks%concurrent_atmos, full_coupler_clocks%concurrent_radiation) & +!&OMP& SHARED(full_coupler_clocks%newClock%update_atmos_model_dynamics) !$ if (omp_get_thread_num() == 0) then !$OMP PARALLEL & !$OMP& NUM_THREADS(1) & @@ -574,17 +520,21 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki, newClockj, newClockl) +!$OMP& SHARED(full_coupler_clocks%update_atmos_model_down, full_coupler_clocks%flux_down_from_atmos) & +!&OMP& SHARED(full_coupler_clocks%update_land_model_fast, full_coupler_clocks%update_ice_model_fast) & +!&OMP& SHARED(full_coupler_clocks%flux_up_to_atmos, full_coupler_clocks%update_atmos_model_up) & +!&OMP& SHARED(full_coupler_clocks%concurrent_atmos, full_coupler_clocks%concurrent_radiation) & +!&OMP& SHARED(full_coupler_clocks%newClock%update_atmos_model_dynamics) !$ call omp_set_num_threads(atmos_nthreads) !$ dsec=omp_get_wtime() - if (do_concurrent_radiation) call fms_mpp_clock_begin(newClocki) + if (do_concurrent_radiation) call fms_mpp_clock_begin(full_coupler_clocks%concurrent_atmos) ! ---- atmosphere dynamics ---- if (do_atmos) then - call fms_mpp_clock_begin(newClockl) + call fms_mpp_clock_begin(full_coupler_clocks%update_atmos_model_dynamics) call update_atmos_model_dynamics( Atm ) - call fms_mpp_clock_end(newClockl) + call fms_mpp_clock_end(full_coupler_clocks%update_atmos_model_dynamics) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', (nc-1)*num_atmos_calls+na, & Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) @@ -592,9 +542,9 @@ program coupler_main ! ---- SERIAL atmosphere radiation ---- if (.not.do_concurrent_radiation) then - call fms_mpp_clock_begin(newClockj) + call fms_mpp_clock_begin(full_coupler_clocks%concurrent_radiation) call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(newClockj) + call fms_mpp_clock_end(full_coupler_clocks%concurrent_radiation) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)', (nc-1)*num_atmos_calls+na, & Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) @@ -602,61 +552,61 @@ program coupler_main ! ---- atmosphere down ---- if (do_atmos) then - call fms_mpp_clock_begin(newClockc) + call fms_mpp_clock_begin(full_coupler_clocks%update_atmos_model_down) call update_atmos_model_down( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(newClockc) + call fms_mpp_clock_end(full_coupler_clocks%update_atmos_model_down) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_down+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update down') - call fms_mpp_clock_begin(newClockd) + call fms_mpp_clock_begin(full_coupler_clocks%flux_down_from_atmos) call flux_down_from_atmos( Time_atmos, Atm, Land, Ice, & Land_ice_atmos_boundary, & Atmos_land_boundary, & Atmos_ice_boundary ) - call fms_mpp_clock_end(newClockd) + call fms_mpp_clock_end(full_coupler_clocks%flux_down_from_atmos) if (do_chksum) call atmos_ice_land_chksum('flux_down_from_atmos+', (nc-1)*num_atmos_calls+na, Atm, Land, & Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) ! -------------------------------------------------------------- ! ---- land model ---- - call fms_mpp_clock_begin(newClocke) + call fms_mpp_clock_begin(full_coupler_clocks%update_land_model_fast) if (do_land .AND. land%pe) then if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) call update_land_model_fast( Atmos_land_boundary, Land ) endif if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(newClocke) + call fms_mpp_clock_end(full_coupler_clocks%update_land_model_fast) if (do_chksum) call atmos_ice_land_chksum('update_land_fast+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update land') ! ---- ice model ---- - call fms_mpp_clock_begin(newClockf) + call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_fast) if (do_ice .AND. Ice%fast_ice_pe) then if (ice_npes .NE. atmos_npes)call fms_mpp_set_current_pelist(Ice%fast_pelist) call update_ice_model_fast( Atmos_ice_boundary, Ice ) endif if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(newClockf) + call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_fast) if (do_chksum) call atmos_ice_land_chksum('update_ice_fast+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') ! -------------------------------------------------------------- ! ---- atmosphere up ---- - call fms_mpp_clock_begin(newClockg) + call fms_mpp_clock_begin(full_coupler_clocks%flux_up_to_atmos) call flux_up_to_atmos( Time_atmos, Land, Ice, Land_ice_atmos_boundary, & Atmos_land_boundary, Atmos_ice_boundary ) - call fms_mpp_clock_end(newClockg) + call fms_mpp_clock_end(full_coupler_clocks%flux_up_to_atmos) if (do_chksum) call atmos_ice_land_chksum('flux_up2atmos+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - call fms_mpp_clock_begin(newClockh) + call fms_mpp_clock_begin(full_coupler_clocks%update_atmos_model_up) if (do_atmos) & call update_atmos_model_up( Land_ice_atmos_boundary, Atm) - call fms_mpp_clock_end(newClockh) + call fms_mpp_clock_end(full_coupler_clocks%update_atmos_model_up) if (do_chksum) call atmos_ice_land_chksum('update_atmos_up+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update up') @@ -666,7 +616,7 @@ program coupler_main call flux_ex_arrays_dealloc !-------------- - if (do_concurrent_radiation) call fms_mpp_clock_end(newClocki) + if (do_concurrent_radiation) call fms_mpp_clock_end(full_coupler_clocks%concurrent_atmos) !$ omp_sec(1) = omp_sec(1) + (omp_get_wtime() - dsec) !$OMP END PARALLEL !$ endif @@ -683,9 +633,9 @@ program coupler_main !$ call omp_set_num_threads(radiation_nthreads) !$ dsec=omp_get_wtime() - call fms_mpp_clock_begin(newClockj) + call fms_mpp_clock_begin(full_coupler_clocks%concurrent_radiation) call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(newClockj) + call fms_mpp_clock_end(full_coupler_clocks%concurrent_radiation) !$ omp_sec(2) = omp_sec(2) + (omp_get_wtime() - dsec) !---CANNOT PUT AN MPP_CHKSUM HERE AS IT REQUIRES THE ABILITY TO HAVE TWO DIFFERENT OPENMP THREADS !---INSIDE OF MPI AT THE SAME TIME WHICH IS NOT CURRENTLY ALLOWED @@ -701,18 +651,18 @@ program coupler_main !$ if (do_concurrent_radiation) imb_sec(2) = imb_sec(2) + omp_get_wtime() !$ call omp_set_num_threads(atmos_nthreads+(conc_nthreads-1)*radiation_nthreads) - call fms_mpp_clock_begin(newClockk) + call fms_mpp_clock_begin(full_coupler_clocks%update_atmos_model_state) call update_atmos_model_state( Atm ) if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_state+', (nc-1)*num_atmos_calls+na, Atm, Land, & Ice,Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update state') - call fms_mpp_clock_end(newClockk) + call fms_mpp_clock_end(full_coupler_clocks%update_atmos_model_state) enddo ! end of na (fast loop) - call fms_mpp_clock_end(newClock7) + call fms_mpp_clock_end(full_coupler_clocks%atmos_loop) - call fms_mpp_clock_begin(newClock8) + call fms_mpp_clock_begin(full_coupler_clocks%update_land_model_slow) ! ------ end of atmospheric time step loop ----- if (do_land .AND. Land%pe) then if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) @@ -720,47 +670,47 @@ program coupler_main endif if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) !----------------------------------------------------------------------- - call fms_mpp_clock_end(newClock8) + call fms_mpp_clock_end(full_coupler_clocks%update_land_model_slow) if (do_chksum) call atmos_ice_land_chksum('update_land_slow+', nc, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) ! ! need flux call to put runoff and p_surf on ice grid ! - call fms_mpp_clock_begin(newClock9) + call fms_mpp_clock_begin(full_coupler_clocks%flux_land_to_ice) call flux_land_to_ice( Time, Land, Ice, Land_ice_boundary ) - call fms_mpp_clock_end(newClock9) + call fms_mpp_clock_end(full_coupler_clocks%flux_land_to_ice) if (do_chksum) call atmos_ice_land_chksum('fluxlnd2ice+', nc, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) Atmos_ice_boundary%p = 0.0 ! call flux_atmos_to_ice_slow ? Time = Time_atmos - call fms_mpp_clock_end(newClock5) + call fms_mpp_clock_end(full_coupler_clocks%atm) endif !Atm%pe block if(Atm%pe) then - call fms_mpp_clock_begin(newClock5) !Ice is still using ATM pelist and need to be included in ATM clock - !ATM clock is used for load-balancing the coupled models + call fms_mpp_clock_begin(full_coupler_clocks%atm) !Ice is still using ATM pelist and need to be included in ATM clock + !ATM clock is used for load-balancing the coupled models endif if (do_ice .and. Ice%pe) then if (Ice%fast_ice_PE) then if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Ice%fast_pelist) - call fms_mpp_clock_begin(newClock10f) + call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_slow_fast) ! These two calls occur on whichever PEs handle the fast ice processess. call ice_model_fast_cleanup(Ice) call unpack_land_ice_boundary(Ice, Land_ice_boundary) - call fms_mpp_clock_end(newClock10f) + call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_slow_fast) endif if (.not.concurrent_ice) then ! This could be a point where the model is serialized. if (.not.Ice%shared_slow_fast_PEs) call fms_mpp_set_current_pelist(Ice%pelist) ! This call occurs all ice PEs. - call fms_mpp_clock_begin(newClock10e) + call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_slow_exchange) call exchange_fast_to_slow_ice(Ice) - call fms_mpp_clock_end(newClock10e) + call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_slow_exchange) endif ! ------ slow-ice model ------ @@ -768,13 +718,13 @@ program coupler_main ! This call occurs on whichever PEs handle the slow ice processess. if (Ice%slow_ice_PE .and. .not.combined_ice_and_ocean) then if (slow_ice_with_ocean) call fms_mpp_set_current_pelist(Ice%slow_pelist) - call fms_mpp_clock_begin(newClock10s) + call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_slow_slow) call update_ice_model_slow(Ice) - call fms_mpp_clock_begin(newClock11) + call fms_mpp_clock_begin(full_coupler_clocks%flux_ice_to_ocean_stocks) call flux_ice_to_ocean_stocks(Ice) - call fms_mpp_clock_end(newClock11) - call fms_mpp_clock_end(newClock10s) + call fms_mpp_clock_end(full_coupler_clocks%flux_ice_to_ocean_stocks) + call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_slow_slow) endif if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, Ice, Ocean_ice_boundary) @@ -782,7 +732,7 @@ program coupler_main if(Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(newClock5) + call fms_mpp_clock_end(full_coupler_clocks%atm) endif ! Update Ice_ocean_boundary using the newly calculated fluxes. @@ -794,16 +744,16 @@ program coupler_main if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then ! If the slow ice is on a subset of the ocean PEs, use the ocean PElist. call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - call fms_mpp_clock_begin(newClock3) + call fms_mpp_clock_begin(full_coupler_clocks%flux_ice_to_ocean) call flux_ice_to_ocean( Time, Ice, Ocean, Ice_ocean_boundary ) Time_flux_ice_to_ocean = Time - call fms_mpp_clock_end(newClock3) + call fms_mpp_clock_end(full_coupler_clocks%flux_ice_to_ocean) endif endif if (Ocean%is_ocean_pe) then call fms_mpp_set_current_pelist(Ocean%pelist) - call fms_mpp_clock_begin(newClock12) + call fms_mpp_clock_begin(full_coupler_clocks%ocean) ! This may do data override or diagnostics on Ice_ocean_boundary. call flux_ice_to_ocean_finish(Time_flux_ice_to_ocean, Ice_ocean_boundary) @@ -830,7 +780,7 @@ program coupler_main Time_ocean = Time_ocean + Time_step_cpld Time = Time_ocean - call fms_mpp_clock_end(newClock12) + call fms_mpp_clock_end(full_coupler_clocks%ocean) endif !--- write out intermediate restart file when needed. @@ -870,22 +820,22 @@ program coupler_main 102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) call fms_mpp_set_current_pelist() - call fms_mpp_clock_begin(newClock14) + call fms_mpp_clock_begin(full_coupler_clocks%final_flux_check_stocks) if (check_stocks >= 0) then call fms_mpp_set_current_pelist() call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) endif - call fms_mpp_clock_end(newClock14) + call fms_mpp_clock_end(full_coupler_clocks%final_flux_check_stocks) call fms_mpp_set_current_pelist() !----------------------------------------------------------------------- - call fms_mpp_clock_end(mainClock) - call fms_mpp_clock_begin(termClock) + call fms_mpp_clock_end(full_coupler_clocks%main) + call fms_mpp_clock_begin(full_coupler_clocks%termination) if (do_chksum) call coupler_chksum('coupler_end-', nc) call coupler_end - call fms_mpp_clock_end(termClock) + call fms_mpp_clock_end(full_coupler_clocks%termination) call fms_memutils_print_memuse_stats( 'Memory HiWaterMark', always=.TRUE. ) call fms_end diff --git a/full/coupler_wrapper.F90 b/full/coupler_wrapper.F90 deleted file mode 100644 index f42207f8..00000000 --- a/full/coupler_wrapper.F90 +++ /dev/null @@ -1,1424 +0,0 @@ -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the GFDL Flexible Modeling System (FMS) Coupler. -!* -!* FMS Coupler is free software: you can redistribute it and/or modify -!* it under the terms of the GNU Lesser General Public License as -!* published by the Free Software Foundation, either version 3 of the -!* License, or (at your option) any later version. -!* -!* FMS Coupler is distributed in the hope that it will be useful, but -!* WITHOUT ANY WARRANTY; without even the implied warranty of -!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -!* General Public License for more details. -!* -!* You should have received a copy of the GNU Lesser General Public -!* License along with FMS Coupler. -!* If not, see . -!*********************************************************************** -module coupler_wrapper_mod - - use FMS !, status_fms=>status - use FMSconstants, only: fmsconstants_init - -#ifdef use_deprecated_io - use fms_io_mod, only: fms_io_exit -#endif - -! model interfaces used to couple the component models: -! atmosphere, land, ice, and ocean -! - - use atmos_model_mod, only: atmos_model_init, atmos_model_end - use atmos_model_mod, only: update_atmos_model_dynamics - use atmos_model_mod, only: update_atmos_model_down - use atmos_model_mod, only: update_atmos_model_up - use atmos_model_mod, only: atmos_data_type - use atmos_model_mod, only: land_ice_atmos_boundary_type - use atmos_model_mod, only: atmos_data_type_chksum - use atmos_model_mod, only: lnd_ice_atm_bnd_type_chksum - use atmos_model_mod, only: lnd_atm_bnd_type_chksum - use atmos_model_mod, only: ice_atm_bnd_type_chksum - use atmos_model_mod, only: atmos_model_restart - use atmos_model_mod, only: update_atmos_model_radiation - use atmos_model_mod, only: update_atmos_model_state - - use land_model_mod, only: land_model_init, land_model_end - use land_model_mod, only: land_data_type, atmos_land_boundary_type - use land_model_mod, only: update_land_model_fast, update_land_model_slow - use land_model_mod, only: atm_lnd_bnd_type_chksum - use land_model_mod, only: land_data_type_chksum - use land_model_mod, only: land_model_restart - - use ice_model_mod, only: ice_model_init, share_ice_domains, ice_model_end, ice_model_restart - use ice_model_mod, only: update_ice_model_fast, set_ice_surface_fields - use ice_model_mod, only: ice_data_type, land_ice_boundary_type - use ice_model_mod, only: ocean_ice_boundary_type, atmos_ice_boundary_type - use ice_model_mod, only: ice_data_type_chksum, ocn_ice_bnd_type_chksum - use ice_model_mod, only: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum - use ice_model_mod, only: unpack_ocean_ice_boundary, exchange_slow_to_fast_ice - use ice_model_mod, only: ice_model_fast_cleanup, unpack_land_ice_boundary - use ice_model_mod, only: exchange_fast_to_slow_ice, update_ice_model_slow - - use ocean_model_mod, only: update_ocean_model, ocean_model_init, ocean_model_end - use ocean_model_mod, only: ocean_public_type, ocean_state_type, ice_ocean_boundary_type - use ocean_model_mod, only: ocean_model_restart - use ocean_model_mod, only: ocean_public_type_chksum, ice_ocn_bnd_type_chksum - - use combined_ice_ocean_driver, only: update_slow_ice_and_ocean, ice_ocean_driver_type - use combined_ice_ocean_driver, only: ice_ocean_driver_init, ice_ocean_driver_end -! -! flux_ calls translate information between model grids - see flux_exchange.f90 -! - - use flux_exchange_mod, only: flux_exchange_init, gas_exchange_init, sfc_boundary_layer - use flux_exchange_mod, only: generate_sfc_xgrid, send_ice_mask_sic - use flux_exchange_mod, only: flux_down_from_atmos, flux_up_to_atmos - use flux_exchange_mod, only: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice - use flux_exchange_mod, only: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish - use flux_exchange_mod, only: flux_check_stocks, flux_init_stocks - use flux_exchange_mod, only: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks - use flux_exchange_mod, only: flux_atmos_to_ocean, flux_ex_arrays_dealloc - - use atmos_tracer_driver_mod, only: atmos_tracer_driver_gather_data - - use iso_fortran_env - - implicit none - -!----------------------------------------------------------------------- - - character(len=128) :: version = '$Id$' - character(len=128) :: tag = '$Name$' - -!----------------------------------------------------------------------- -!---- model defined-types ---- - - type (atmos_data_type) :: Atm - type (land_data_type) :: Land - type (ice_data_type) :: Ice - ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target :: Ocean - type (ocean_state_type), pointer :: Ocean_state => NULL() - - type(atmos_land_boundary_type) :: Atmos_land_boundary - type(atmos_ice_boundary_type) :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary - type(land_ice_boundary_type) :: Land_ice_boundary - type(ice_ocean_boundary_type) :: Ice_ocean_boundary - type(ocean_ice_boundary_type) :: Ocean_ice_boundary - type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() - -!----------------------------------------------------------------------- -! ----- coupled model time ----- - - type (FmsTime_type) :: Time, Time_init, Time_end, & - Time_step_atmos, Time_step_cpld - type(FmsTime_type) :: Time_atmos, Time_ocean - type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice - - integer :: num_atmos_calls, na - integer :: num_cpld_calls, nc - - type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() - type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() - - integer :: num_ice_bc_restart=0, num_ocn_bc_restart=0 - type(FmsTime_type) :: Time_restart, Time_restart_current, Time_start - character(len=32) :: timestamp - -! ----- coupled model initial date ----- - - integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) - integer :: calendar_type = INVALID_CALENDAR - -!----------------------------------------------------------------------- -!------ namelist interface ------- - - integer, dimension(6) :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) !< The time interval that write out intermediate restart file. - !! The format is (yr,mo,day,hr,min,sec). When restart_interval - !! is all zero, no intermediate restart file will be written out - integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See - !! force_date_from_namelist.) - character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are - !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. - !! The value 'no_calendar' cannot be used because the time_manager's date - !! functions are used. All values must be lower case. - logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date should override - !! the date in the restart file `INPUT/coupler.res`. If the restart file does not - !! exist then force_date_from_namelist has no effect, the value of current_date - !! will be used. - integer :: months=0 !< Number of months the current integration will be run - integer :: days=0 !< Number of days the current integration will be run - integer :: hours=0 !< Number of hours the current integration will be run - integer :: minutes=0 !< Number of minutes the current integration will be run - integer :: seconds=0 !< Number of seconds the current integration will be run - integer :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fat coupling with land and sea ice - integer :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must be an - !! integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. - integer :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere - integer :: ocean_npes=0 !< The number of MPI tasks to use for the ocean - integer :: ice_npes=0 !< The number of MPI tasks to use for the ice - integer :: land_npes=0 !< The number of MPI tasks to use for the land - integer :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere - integer :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean - integer :: radiation_nthreads=1 !< Number of threads to use for the radiation. - logical :: do_atmos =.true. !< Indicates if this component should be executed. If .FALSE., then execution is skipped. - !! This is used when ALL the output fields sent by this component to the coupler have been - !! overridden using the data_override feature. This is for advanced users only. - logical :: do_land =.true. !< See do_atmos - logical :: do_ice =.true. !< See do_atmos - logical :: do_ocean=.true. !< See do_atmos - logical :: do_flux =.true. !< See do_atmos - logical :: concurrent=.FALSE. !< If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate - !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. - !! If .FALSE., the execution is serial: call atmos... followed by call ocean... - logical :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently - logical :: use_lag_fluxes=.TRUE. !< If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. - !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog - !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable - !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there - !! is probably sufficient damping for MOM4. For more modern ocean models (such as - !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. - !! should be much more stable. - logical :: concurrent_ice=.FALSE. !< If .TRUE., the slow sea-ice is forced with the fluxes that were used for the - !! fast ice processes one timestep before. When used in conjuction with setting - !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and - !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can - !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. - logical :: slow_ice_with_ocean=.FALSE. !< If true, the slow sea-ice is advanced on the ocean processors. Otherwise - !! the slow sea-ice processes are on the same PEs as the fast sea-ice. - logical :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance - !! both the slow sea-ice and the ocean. slow_ice_with_ocean and - !! concurrent_ice must both be true if combined_ice_and_ocean is true. - logical :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. - logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. - logical :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. - integer :: check_stocks = 0 ! -1: never 0: at end of run only n>0: every n coupled steps - logical :: use_hyper_thread = .false. - - namelist /coupler_nml/ current_date, calendar, force_date_from_namelist, & - months, days, hours, minutes, seconds, dt_cpld, dt_atmos, & - do_atmos, do_land, do_ice, do_ocean, do_flux, & - atmos_npes, ocean_npes, ice_npes, land_npes, & - atmos_nthreads, ocean_nthreads, radiation_nthreads, & - concurrent, do_concurrent_radiation, use_lag_fluxes, & - check_stocks, restart_interval, do_debug, do_chksum, & - use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & - do_endpoint_chksum, combined_ice_and_ocean - - integer :: initClock, mainClock, termClock - - integer :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 - integer :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e - integer :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka - integer :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki - integer :: newClockj, newClockk, newClockl - - integer :: id_atmos_model_init, id_land_model_init, id_ice_model_init - integer :: id_ocean_model_init, id_flux_exchange_init - - character(len=80) :: text - character(len=48), parameter :: mod_name = 'coupler_main_mod' - - integer :: outunit - integer :: ensemble_id = 1 - integer, allocatable :: ensemble_pelist(:, :) - integer, allocatable :: slow_ice_ocean_pelist(:) - integer :: conc_nthreads = 1 - real :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 - -contains - -!####################################################################### - -!> \brief Initialize all defined exchange grids and all boundary maps - subroutine coupler_init - - use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_id,ensemble_pelist_setup - use ensemble_manager_mod, only : get_ensemble_size, get_ensemble_pelist - - -! -!----------------------------------------------------------------------- -! local parameters -!----------------------------------------------------------------------- -! - - character(len=64), parameter :: sub_name = 'coupler_init' - character(len=256), parameter :: error_header = & - '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):' - character(len=256), parameter :: note_header = & - '==>Note from ' // trim(mod_name) // '(' // trim(sub_name) // '):' - - integer :: ierr, io, m, i, outunit, logunit, errunit - integer :: date(6) - type (FmsTime_type) :: Run_length - character(len=9) :: month - integer :: pe, npes - - integer :: ens_siz(6), ensemble_size - - integer :: atmos_pe_start=0, atmos_pe_end=0, & - ocean_pe_start=0, ocean_pe_end=0 - integer :: n - integer :: diag_model_subset=DIAG_ALL - logical :: other_fields_exist - character(len=256) :: err_msg - integer :: date_restart(6) - character(len=64) :: filename, fieldname - integer :: id_restart, l - character(len=8) :: walldate - character(len=10) :: walltime - character(len=5) :: wallzone - integer :: wallvalues(8) - character(len=:), dimension(:), allocatable :: restart_file !< Restart file saved as a string - integer :: time_stamp_unit !< Unif of the time_stamp file - integer :: ascii_unit !< Unit of a dummy ascii file - - type(FmsCoupler1dBC_type), pointer :: & - gas_fields_atm => NULL(), & ! A pointer to the type describing the - ! atmospheric fields that will participate in the gas fluxes. - gas_fields_ocn => NULL(), & ! A pointer to the type describing the ocean - ! and ice surface fields that will participate in the gas fluxes. - gas_fluxes => NULL() ! A pointer to the type describing the - ! atmosphere-ocean gas and tracer fluxes. -!----------------------------------------------------------------------- - - outunit = fms_mpp_stdout() - errunit = fms_mpp_stderr() - logunit = fms_mpp_stdlog() - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Entering coupler_init at '& - //trim(walldate)//' '//trim(walltime) - endif - -!----- write version to logfile ------- - call fms_write_version_number(version, tag) - -!----- read namelist ------- - - read (fms_mpp_input_nml_file, coupler_nml, iostat=io) - ierr = check_nml_error (io, 'coupler_nml') - -!----- read date and calendar type from restart file ----- - if (fms2_io_file_exists('INPUT/coupler.res')) then - call fms2_io_ascii_read('INPUT/coupler.res', restart_file) - read(restart_file(1), *) calendar_type - read(restart_file(2), *) date_init - read(restart_file(3), *) date - deallocate(restart_file) - else - force_date_from_namelist = .true. - endif - -!----- use namelist value (either no restart or override flag on) --- - - if ( force_date_from_namelist ) then - - if ( sum(current_date) <= 0 ) then - call error_mesg ('program coupler', & - 'no namelist value for base_date or current_date', FATAL) - else - date = current_date - endif - -!----- override calendar type with namelist value ----- - - select case( fms_mpp_uppercase(trim(calendar)) ) - case( 'GREGORIAN' ) - calendar_type = GREGORIAN - case( 'JULIAN' ) - calendar_type = JULIAN - case( 'NOLEAP' ) - calendar_type = NOLEAP - case( 'THIRTY_DAY' ) - calendar_type = THIRTY_DAY_MONTHS - case( 'NO_CALENDAR' ) - calendar_type = NO_CALENDAR - end select - - endif - - call fms_time_manager_set_calendar_type (calendar_type, err_msg) - if (err_msg /= '') then - call fms_mpp_error(FATAL, 'ERROR in coupler_init: '//trim(err_msg)) - endif - - if (concurrent .AND. .NOT.(use_lag_fluxes .OR. concurrent_ice) ) & - call fms_mpp_error( WARNING, 'coupler_init: you have set concurrent=TRUE, & - & use_lag_fluxes=FALSE, and concurrent_ice=FALSE & - & in coupler_nml. When not using lag fluxes, components & - & will synchronize at two points, and thus run serially.' ) - if (concurrent_ice .AND. .NOT.slow_ice_with_ocean ) call fms_mpp_error(WARNING, & - 'coupler_init: concurrent_ice is true, but slow ice_with_ocean is & - & false in coupler_nml. These two flags should both be true to avoid & - & effectively serializing the run.' ) - if (use_lag_fluxes .AND. concurrent_ice ) call fms_mpp_error(WARNING, & - 'coupler_init: use_lag_fluxes and concurrent_ice are both true. & - & These two coupling options are intended to be exclusive.' ) - - !Check with the ensemble_manager module for the size of ensemble - !and PE counts for each member of the ensemble. - ! - !NOTE: ensemble_manager_init renames all the output files (restart and diagnostics) - ! to show which ensemble member they are coming from. - ! There also need to be restart files for each member of the ensemble in INPUT. - ! - !NOTE: if the ensemble_size=1 the input/output files will not be renamed. - ! - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting initializing ensemble_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_ensemble_manager_init() ! init pelists for ensembles - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing ensemble_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - ens_siz = get_ensemble_size() - ensemble_size = ens_siz(1) - npes = ens_siz(2) - - !Check for the consistency of PE counts - if (concurrent) then -!atmos_npes + ocean_npes must equal npes - if (atmos_npes.EQ.0 ) atmos_npes = npes - ocean_npes - if (ocean_npes.EQ.0 ) ocean_npes = npes - atmos_npes -!both must now be non-zero - if (atmos_npes.EQ.0 .OR. ocean_npes.EQ.0 ) & - call fms_mpp_error( FATAL, 'coupler_init: atmos_npes or ocean_npes must be specified for concurrent coupling.' ) - if (atmos_npes+ocean_npes.NE.npes ) & - call fms_mpp_error( FATAL, 'coupler_init: atmos_npes+ocean_npes must equal npes for concurrent coupling.' ) - else !serial timestepping - if ((atmos_npes.EQ.0) .and. (do_atmos .or. do_land .or. do_ice)) atmos_npes = npes - if ((ocean_npes.EQ.0) .and. (do_ocean)) ocean_npes = npes - if (max(atmos_npes,ocean_npes).EQ.npes) then !overlapping pelists - ! do nothing - else !disjoint pelists - if (atmos_npes+ocean_npes.NE.npes ) call fms_mpp_error( FATAL, & - 'coupler_init: atmos_npes+ocean_npes must equal npes for serial coupling on disjoint pelists.' ) - endif - endif - - if (land_npes == 0 ) land_npes = atmos_npes - if (land_npes > atmos_npes) call fms_mpp_error(FATAL, 'coupler_init: land_npes > atmos_npes') - - if (ice_npes == 0 ) ice_npes = atmos_npes - if (ice_npes > atmos_npes) call fms_mpp_error(FATAL, 'coupler_init: ice_npes > atmos_npes') - - allocate( Atm%pelist (atmos_npes) ) - allocate( Ocean%pelist(ocean_npes) ) - allocate( Land%pelist (land_npes) ) - allocate( Ice%fast_pelist(ice_npes) ) - - !Set up and declare all the needed pelists - call fms_ensemble_manager_ensemble_pelist_setup(concurrent, atmos_npes, ocean_npes, land_npes, ice_npes, & - Atm%pelist, Ocean%pelist, Land%pelist, Ice%fast_pelist) - -!set up affinities based on threads - - ensemble_id = get_ensemble_id() - - allocate(ensemble_pelist(1:ensemble_size,1:npes)) - call fms_ensemble_manager_get_ensemble_pelist(ensemble_pelist) - - Atm%pe = ANY(Atm%pelist .EQ. fms_mpp_pe()) - Ocean%is_ocean_pe = ANY(Ocean%pelist .EQ. fms_mpp_pe()) - Land%pe = ANY(Land%pelist .EQ. fms_mpp_pe()) - - Ice%shared_slow_fast_PEs = .not.slow_ice_with_ocean - ! However, if using a data atmosphere and slow_ice_with_ocean then shared_slow_fast_PEs - ! will be true. In this case, all procesors do the ocean, slow ice, and fast ice. - if (slow_ice_with_ocean.and.(.not.do_atmos)) Ice%shared_slow_fast_PEs = .true. - ! This is where different settings would be applied if the fast and slow - ! ice occurred on different PEs. - if (do_atmos) then - if (Ice%shared_slow_fast_PEs) then - ! Fast and slow ice processes occur on the same PEs. - allocate( Ice%pelist (ice_npes) ) - Ice%pelist(:) = Ice%fast_pelist(:) - allocate( Ice%slow_pelist(ice_npes) ) - Ice%slow_pelist(:) = Ice%fast_pelist(:) - if(concurrent) then - allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) - slow_ice_ocean_pelist(1:ice_npes) = Ice%slow_pelist(:) - slow_ice_ocean_pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) - else - if(ice_npes .GE. ocean_npes) then - allocate(slow_ice_ocean_pelist(ice_npes)) - slow_ice_ocean_pelist(:) = Ice%slow_pelist(:) - else - allocate(slow_ice_ocean_pelist(ocean_npes)) - slow_ice_ocean_pelist(:) = Ocean%pelist(:) - endif - endif - else - ! Fast ice processes occur a subset of the atmospheric PEs, while - ! slow ice processes occur on the ocean PEs. - allocate( Ice%slow_pelist(ocean_npes) ) - Ice%slow_pelist(:) = Ocean%pelist(:) - allocate( Ice%pelist (ice_npes+ocean_npes) ) - ! Set Ice%pelist() to be the union of Ice%fast_pelist and Ice%slow_pelist. - Ice%pelist(1:ice_npes) = Ice%fast_pelist(:) - Ice%pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) - allocate(slow_ice_ocean_pelist(ocean_npes)) - slow_ice_ocean_pelist(:) = Ocean%pelist(:) - endif - elseif (.not.do_atmos) then - ! In the no atmos cases, shared_slow_fast_PEs is not enough to distinguish - ! the slow and fast ice procesor layout; slow_ice_with_ocean should be used instead. - if (slow_ice_with_ocean) then - ! data atmos, using combined ice-ocean driver - ! Both fast ice and slow ice processes occur on the same PEs, - ! since the Atmos and Ocean PEs are shared - allocate( Ice%slow_pelist(ocean_npes) ) - Ice%slow_pelist(:) = Ocean%pelist(:) - allocate( Ice%pelist (ice_npes) ) - Ice%pelist(1:ice_npes) = Ice%fast_pelist(:) - allocate(slow_ice_ocean_pelist(ocean_npes)) - slow_ice_ocean_pelist(:) = Ocean%pelist(:) - else - ! data atmos, not using combined ice-ocean driver - allocate( Ice%pelist (ice_npes) ) - Ice%pelist(:) = Ice%fast_pelist(:) - allocate( Ice%slow_pelist(ice_npes) ) - Ice%slow_pelist(:) = Ice%fast_pelist(:) - if(ice_npes .GE. ocean_npes) then - allocate(slow_ice_ocean_pelist(ice_npes)) - slow_ice_ocean_pelist(:) = Ice%slow_pelist(:) - else - allocate(slow_ice_ocean_pelist(ocean_npes)) - slow_ice_ocean_pelist(:) = Ocean%pelist(:) - endif - endif - endif - Ice%fast_ice_pe = ANY(Ice%fast_pelist(:) .EQ. fms_mpp_pe()) - Ice%slow_ice_pe = ANY(Ice%slow_pelist(:) .EQ. fms_mpp_pe()) - Ice%pe = Ice%fast_ice_pe .OR. Ice%slow_ice_pe - call fms_mpp_declare_pelist(slow_ice_ocean_pelist) - !--- dynamic threading turned off when affinity placement is in use -!$ call omp_set_dynamic(.FALSE.) - !--- nested OpenMP enabled for OpenMP concurrent components -!$ call omp_set_max_active_levels(3) - - if (Atm%pe) then - call fms_mpp_set_current_pelist( Atm%pelist ) -!$ if (.not.do_concurrent_radiation) radiation_nthreads=atmos_nthreads -!$ if (do_concurrent_radiation) conc_nthreads=2 - !--- setting affinity - if (do_concurrent_radiation) then -!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads + radiation_nthreads) -!$ call omp_set_num_threads(atmos_nthreads+radiation_nthreads) - else -!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads) -!$ call omp_set_num_threads(atmos_nthreads) - endif - endif - - !--- initialization clock - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - id_atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - id_land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) - endif - if (Ice%pe) then - if (Ice%shared_slow_fast_PEs) then - call fms_mpp_set_current_pelist(Ice%pelist) - elseif (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - else - call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") - endif - id_ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - id_ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) - endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - id_flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) - - call fms_mpp_set_current_pelist() - mainClock = fms_mpp_clock_id( 'Main loop' ) - termClock = fms_mpp_clock_id( 'Termination' ) - - !Write out messages on root PEs - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - write( text,'(a,2i6,a,i2.2)' )'Atmos PE range: ', Atm%pelist(1) , Atm%pelist(atmos_npes) ,& - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - if (ocean_npes .gt. 0) then - write( text,'(a,2i6,a,i2.2)' )'Ocean PE range: ', Ocean%pelist(1), Ocean%pelist(ocean_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - else - write( text,'(a,i2.2)' )'Ocean PE range is not set (do_ocean=.false. and concurrent=.false.) for ens_', & - ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - endif - write( text,'(a,2i6,a,i2.2)' )'Land PE range: ', Land%pelist(1) , Land%pelist(land_npes) ,& - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - if (.not.concurrent_ice) then - write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - elseif (concurrent_ice) then - if (do_atmos) then - write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes+ocean_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - elseif ((.not.do_atmos)) then - write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - endif - call fms_mpp_error( NOTE, 'coupler_init: Running with CONCURRENT ICE coupling.' ) - write( text,'(a,2i6,a,i2.2)' )'slow Ice PE range: ', Ice%slow_pelist(1), Ice%slow_pelist(ocean_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - write( text,'(a,2i6,a,i2.2)' )'fast Ice PE range: ', Ice%fast_pelist(1), Ice%fast_pelist(ice_npes), & - ' ens_', ensemble_id - call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) - endif - - if (concurrent) then - call fms_mpp_error( NOTE, 'coupler_init: Running with CONCURRENT coupling.' ) - - write( logunit,'(a)' )'Using concurrent coupling...' - write( logunit,'(a,4i6)' ) & - 'atmos_pe_start, atmos_pe_end, ocean_pe_start, ocean_pe_end=', & - Atm%pelist(1) , Atm%pelist(atmos_npes), Ocean%pelist(1), Ocean%pelist(ocean_npes) - else - call fms_mpp_error( NOTE, 'coupler_init: Running with SERIAL coupling.' ) - endif - if (use_lag_fluxes) then - call fms_mpp_error( NOTE, 'coupler_init: Sending LAG fluxes to ocean.' ) - else - call fms_mpp_error( NOTE, 'coupler_init: Sending most recent fluxes to ocean.' ) - endif - if (concurrent_ice) call fms_mpp_error( NOTE, & - 'coupler_init: using lagged slow-ice coupling mode.') - if (combined_ice_and_ocean) call fms_mpp_error( NOTE, & - 'coupler_init: advancing the ocean and slow-ice in a single call.') - if (combined_ice_and_ocean .and. .not.concurrent_ice) call fms_mpp_error( FATAL, & - 'coupler_init: concurrent_ice must be true if combined_ice_and_ocean is true.') - if (combined_ice_and_ocean .and. .not.slow_ice_with_ocean) call fms_mpp_error( FATAL, & - 'coupler_init: slow_ice_with_ocean must be true if combined_ice_and_ocean is true.') - endif - -!----- write namelist to logfile ----- - if (fms_mpp_pe() == fms_mpp_root_pe() )write( logunit, nml=coupler_nml ) - -!----- write current/initial date actually used to logfile file ----- - - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) & - write( logunit, 16 )date(1),trim(fms_time_manager_month_name(date(2))),date(3:6) -16 format (' current date used = ',i4,1x,a,2i3,2(':',i2.2),' gmt') - -!----------------------------------------------------------------------- -!------ initialize diagnostics manager ------ - -!jwd Fork here is somewhat dangerous. It relies on "no side effects" from -! diag_manager_init. diag_manager_init or this section should be -! re-architected to guarantee this or remove this assumption. -! For instance, what follows assumes that get_base_date has the same -! time for both Atm and Ocean pes. While this should be the case, the -! possible error condition needs to be checked - - diag_model_subset=DIAG_ALL - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - if (atmos_npes /= npes) diag_model_subset = DIAG_OTHER ! change diag_model_subset from DIAG_ALL - elseif (Ocean%is_ocean_pe) then ! Error check above for disjoint pelists should catch any problem - call fms_mpp_set_current_pelist(Ocean%pelist) - ! The FMS diag manager has a convention that segregates files with "ocean" - ! in their names from the other files to handle long diag tables. This - ! does not work if the ice is on the ocean PEs. - if ((ocean_npes /= npes) .and. .not.slow_ice_with_ocean) & - diag_model_subset = DIAG_OCEAN ! change diag_model_subset from DIAG_ALL - endif - if ( fms_mpp_pe() == fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize diag_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - ! initialize diag_manager for processor subset output - call fms_diag_init(DIAG_MODEL_SUBSET=diag_model_subset, TIME_INIT=date) - call fms_memutils_print_memuse_stats( 'diag_manager_init' ) - if ( fms_mpp_pe() == fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing diag_manager at '& - //trim(walldate)//' '//trim(walltime) - endif -!----------------------------------------------------------------------- -!------ reset pelist to "full group" ------ - - call fms_mpp_set_current_pelist() -!----- always override initial/base date with diag_manager value ----- - - call fms_diag_get_base_date ( date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6) ) - -!----- use current date if no base date ------ - - if ( date_init(1) == 0 ) date_init = date - -!----- set initial and current time types ------ - - Time_init = fms_time_manager_set_date (date_init(1), date_init(2), date_init(3), & - date_init(4), date_init(5), date_init(6)) - - Time = fms_time_manager_set_date (date(1), date(2), date(3), & - date(4), date(5), date(6)) - - Time_start = Time - -!----- compute the ending time ----- - - Time_end = Time - do m=1,months - Time_end = Time_end + fms_time_manager_set_time(0,fms_time_manager_days_in_month(Time_end)) - enddo - Time_end = Time_end + fms_time_manager_set_time(hours*3600+minutes*60+seconds, days) - !Need to pass Time_end into diag_manager for multiple thread case. - call fms_diag_set_time_end(Time_end) - - Run_length = Time_end - Time - -!--- get the time that last intermediate restart file was written out. - if (fms2_io_file_exists('INPUT/coupler.intermediate.res')) then - call fms2_io_ascii_read('INPUT/coupler.intermediate.res', restart_file) - read(restart_file(1), *) date_restart - deallocate(restart_file) - else - date_restart = date - endif - - Time_restart_current = Time - if (ALL(restart_interval ==0)) then - Time_restart = fms_time_manager_increment_date(Time_end, 0, 0, 10, 0, 0, 0) ! no intermediate restart - else - Time_restart = fms_time_manager_set_date(date_restart(1), date_restart(2), date_restart(3), & - date_restart(4), date_restart(5), date_restart(6) ) - Time_restart = fms_time_manager_increment_date(Time_restart, restart_interval(1), restart_interval(2), & - restart_interval(3), restart_interval(4), restart_interval(5), restart_interval(6) ) - if (Time_restart <= Time) call fms_mpp_error(FATAL, & - '==>Error from program coupler: The first intermediate restart time is no larger than the start time') - endif - -!----------------------------------------------------------------------- -!----- write time stamps (for start time and end time) ------ - - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') - - month = fms_time_manager_month_name(date(2)) - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) - - call fms_time_manager_get_date (Time_end, date(1), date(2), date(3), & - date(4), date(5), date(6)) - month = fms_time_manager_month_name(date(2)) - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) - - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) close(time_stamp_unit) - -20 format (i6,5i4,2x,a3) - -!----------------------------------------------------------------------- -!----- compute the time steps ------ - - Time_step_cpld = fms_time_manager_set_time (dt_cpld ,0) - Time_step_atmos = fms_time_manager_set_time (dt_atmos,0) - -!----- determine maximum number of iterations per loop ------ - - num_cpld_calls = Run_length / Time_step_cpld - num_atmos_calls = Time_step_cpld / Time_step_atmos - -!----------------------------------------------------------------------- -!------------------- some error checks --------------------------------- - -!----- initial time cannot be greater than current time ------- - - if ( Time_init > Time ) call error_mesg ('program coupler', & - 'initial time is greater than current time', FATAL) - -!----- make sure run length is a multiple of ocean time step ------ - - if ( num_cpld_calls * Time_step_cpld /= Run_length ) & - call error_mesg ('program coupler', & - 'run length must be multiple of coupled time step', FATAL) - -! ---- make sure cpld time step is a multiple of atmos time step ---- - - if ( num_atmos_calls * Time_step_atmos /= Time_step_cpld ) & - call error_mesg ('program coupler', & - 'cpld time step is not a multiple of the atmos time step', FATAL) - -! -! Initialize the tracer manager. This needs to be done on all PEs, -! before the individual models are initialized. -! - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize tracer_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_tracer_manager_init() -! Initialize the gas-exchange fluxes so this information can be made -! available to the individual components. - call gas_exchange_init(gas_fields_atm, gas_fields_ocn, gas_fluxes) - call fms_coupler_types_init() - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing tracer_manager at '& - //trim(walldate)//' '//trim(walltime) - endif - - - -!----------------------------------------------------------------------- -!------ initialize component models ------ -!------ grid info now comes from grid_spec file - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Beginning to initialize component models at '& - //trim(walldate)//' '//trim(walltime) - endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) -!---- atmosphere ---- - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize atmospheric model at '& - //trim(walldate)//' '//trim(walltime) - endif - - call fms_mpp_clock_begin(id_atmos_model_init) - - call atmos_model_init( Atm, Time_init, Time, Time_step_atmos, & - do_concurrent_radiation) - - call fms_mpp_clock_end(id_atmos_model_init) - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing atmospheric model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_memutils_print_memuse_stats( 'atmos_model_init' ) - call fms_data_override_init(Atm_domain_in = Atm%domain) - endif -!---- land ---------- - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize land model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_clock_begin(id_land_model_init) - call land_model_init( Atmos_land_boundary, Land, Time_init, Time, & - Time_step_atmos, Time_step_cpld ) - call fms_mpp_clock_end(id_land_model_init) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing land model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_memutils_print_memuse_stats( 'land_model_init' ) - call fms_data_override_init(Land_domain_in = Land%domain) -#ifndef _USE_LEGACY_LAND_ - call fms_data_override_init(Land_domainUG_in = Land%ug_domain) -#endif - endif -!---- ice ----------- - if (Ice%pe) then ! This occurs for all fast or slow ice PEs. - if (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - else - call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") - endif - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize ice model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_clock_begin(id_ice_model_init) - call ice_model_init(Ice, Time_init, Time, Time_step_atmos, & - Time_step_cpld, Verona_coupler=.false., & - concurrent_ice=concurrent_ice, & - gas_fluxes=gas_fluxes, gas_fields_ocn=gas_fields_ocn ) - call fms_mpp_clock_end(id_ice_model_init) - - ! This must be called using the union of the ice PE_lists. - call fms_mpp_set_current_pelist(Ice%pelist) - call share_ice_domains(Ice) - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing ice model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_memutils_print_memuse_stats( 'ice_model_init' ) - if (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - call fms_data_override_init(Ice_domain_in = Ice%domain) - endif - endif - -!---- ocean --------- - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize ocean model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_clock_begin(id_ocean_model_init) - call ocean_model_init( Ocean, Ocean_state, Time_init, Time, & - gas_fields_ocn=gas_fields_ocn ) - call fms_mpp_clock_end(id_ocean_model_init) - - if (concurrent) then - call fms_mpp_set_current_pelist( Ocean%pelist ) -!$ call fms_affinity_set('OCEAN', use_hyper_thread, ocean_nthreads) -!$ call omp_set_num_threads(ocean_nthreads) - else - ocean_nthreads = atmos_nthreads - !--- omp_num_threads has already been set by the Atmos-pes, but set again to ensure -!$ call omp_set_num_threads(ocean_nthreads) - endif - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing ocean model at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_memutils_print_memuse_stats( 'ocean_model_init' ) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize data_override at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_data_override_init(Ocean_domain_in = Ocean%domain ) - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing data_override at '& - //trim(walldate)//' '//trim(walltime) - endif - - if (combined_ice_and_ocean) & - call ice_ocean_driver_init(ice_ocean_driver_CS, Time_init, Time) - - endif ! end of Ocean%is_ocean_pe - -!--------------------------------------------- - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finished initializing component models at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - - call fms_mpp_domains_broadcast_domain(Ice%domain) - call fms_mpp_domains_broadcast_domain(Ice%slow_domain_NH) - call fms_mpp_domains_broadcast_domain(Ocean%domain) -!----------------------------------------------------------------------- -!---- initialize flux exchange module ---- - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Starting to initialize flux_exchange at '& - //trim(walldate)//' '//trim(walltime) - endif - call fms_mpp_clock_begin(id_flux_exchange_init) - call flux_exchange_init ( Time, Atm, Land, Ice, Ocean, Ocean_state,& - atmos_ice_boundary, land_ice_atmos_boundary, & - land_ice_boundary, ice_ocean_boundary, ocean_ice_boundary, & - do_ocean, slow_ice_ocean_pelist, dt_atmos=dt_atmos, dt_cpld=dt_cpld) - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - call fms_mpp_clock_end(id_flux_exchange_init) - call fms_mpp_set_current_pelist() - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Finsihed initializing flux_exchange at '& - //trim(walldate)//' '//trim(walltime) - endif - - Time_atmos = Time - Time_ocean = Time - -! -! read in extra fields for the air-sea gas fluxes -! - if ( Ice%slow_ice_pe ) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - - call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & - num_ice_bc_restart, Ice%slow_domain_NH, to_read=.true., ocean_restart=.false., directory="INPUT/") - - ! Restore the fields from the restart files - do l = 1, num_ice_bc_restart - if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_read_restart(Ice_bc_restart(l)) - enddo - - ! Check whether the restarts were read successfully. - call fms_coupler_type_restore_state(Ice%ocean_fluxes, use_fms2_io=.true., & - test_by_field=.true.) - - do l = 1, num_ice_bc_restart - if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_close_file(Ice_bc_restart(l)) - enddo - endif !< ( Ice%slow_ice_pe ) - - if ( Ocean%is_ocean_pe ) then - call fms_mpp_set_current_pelist(Ocean%pelist) - - call fms_coupler_type_register_restarts(Ocean%fields, Ocn_bc_restart, & - num_ocn_bc_restart, Ocean%domain, to_read=.true., ocean_restart=.true., directory="INPUT/") - - ! Restore the fields from the restart files - do l = 1, num_ocn_bc_restart - if(fms2_io_check_if_open(Ocn_bc_restart(l))) call fms2_io_read_restart(Ocn_bc_restart(l)) - enddo - - ! Check whether the restarts were read successfully. - call fms_coupler_type_restore_state(Ocean%fields, use_fms2_io=.true., & - test_by_field=.true.) - - do l = 1, num_ocn_bc_restart - if(fms2_io_check_if_open(Ocn_bc_restart(l))) call fms2_io_close_file(Ocn_bc_restart(l)) - enddo - endif !< ( Ocean%is_ocean_pe ) - - call fms_mpp_set_current_pelist() - -!----------------------------------------------------------------------- -!---- open and close dummy file in restart dir to check if dir exists -- - - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) then - open(newunit = ascii_unit, file='RESTART/file', status='replace', form='formatted') - close(ascii_unit,status="delete") - endif - - ! Call to daig_grid_end to free up memory used during regional - ! output setup - CALL fms_diag_grid_end() - -!----------------------------------------------------------------------- - if ( do_endpoint_chksum ) then - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum('coupler_init+', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ice%slow_ice_PE) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum('coupler_init+', 0, Ocean, Ice_ocean_boundary) - endif - endif - - call fms_mpp_set_current_pelist() - call fms_memutils_print_memuse_stats('coupler_init') - - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then - call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) - write(errunit,*) 'Exiting coupler_init at '& - //trim(walldate)//' '//trim(walltime) - endif - end subroutine coupler_init - -!####################################################################### - - subroutine coupler_end() - -!----------------------------------------------------------------------- - - if ( do_endpoint_chksum ) then - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum('coupler_end', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ice%slow_ice_PE) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum('coupler_end', 0, Ocean, Ice_ocean_boundary) - endif - endif - call fms_mpp_set_current_pelist() - -!----- check time versus expected ending time ---- - - if (Time /= Time_end) call error_mesg ('program coupler', & - 'final time does not match expected ending time', WARNING) - -!----------------------------------------------------------------------- -!the call to fms_io_exit has been moved here -!this will work for serial code or concurrent (disjoint pelists) -!but will fail on overlapping but unequal pelists - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_model_end (Ocean, Ocean_state, Time) - endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_model_end ( Atm ) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - call land_model_end (Atmos_land_boundary, Land) - endif - if (Ice%pe) then ! This happens on all fast or slow ice PEs. - if (Ice%slow_ice_PE) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - else ! This must be a fast ice PE. - call fms_mpp_set_current_pelist(Ice%fast_pelist) - endif - call ice_model_end (Ice) - endif - - !----- write restart file ------ - call coupler_restart(Time, Time_restart_current) - - call fms_diag_end (Time) -#ifdef use_deprecated_io - call fms_io_exit -#endif - call fms_mpp_set_current_pelist() - - -!----------------------------------------------------------------------- - - end subroutine coupler_end - - !>@brief Register the axis data as a variable in the netcdf file and add some dummy data. - !! This is needed so the combiner can work correctly when the io_layout is not 1,1 - subroutine add_domain_dimension_data(fileobj) - type(FmsNetcdfDomainFile_t) :: fileobj !< Fms2io domain decomposed fileobj - integer, dimension(:), allocatable :: buffer !< Buffer with axis data - integer :: is, ie !< Starting and Ending indices for data - - call fms2_io_get_global_io_domain_indices(fileobj, "xaxis_1", is, ie, indices=buffer) - call fms2_io_write_data(fileobj, "xaxis_1", buffer) - deallocate(buffer) - - call fms2_io_get_global_io_domain_indices(fileobj, "yaxis_1", is, ie, indices=buffer) - call fms2_io_write_data(fileobj, "yaxis_1", buffer) - deallocate(buffer) - - end subroutine add_domain_dimension_data - - - !> \brief Writing restart file that contains running time and restart file writing time. - subroutine coupler_restart(Time_run, Time_res, time_stamp) - type(FmsTime_type), intent(in) :: Time_run, Time_res - character(len=*), intent(in), optional :: time_stamp - character(len=128) :: file_run, file_res - integer :: yr, mon, day, hr, min, sec, date(6), n - integer :: restart_unit !< Unit for the coupler restart file - - call fms_mpp_set_current_pelist() - - ! write restart file - if (present(time_stamp)) then - file_run = 'RESTART/'//trim(time_stamp)//'.coupler.res' - file_res = 'RESTART/'//trim(time_stamp)//'.coupler.intermediate.res' - else - file_run = 'RESTART/coupler.res' - file_res = 'RESTART/coupler.intermediate.res' - endif - - !----- compute current date ------ - call fms_time_manager_get_date (Time_run, date(1), date(2), date(3), & - date(4), date(5), date(6)) - if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then - open(newunit = restart_unit, file=file_run, status='replace', form='formatted') - write(restart_unit, '(i6,8x,a)' )calendar_type, & - '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - - write(restart_unit, '(6i6,8x,a)' )date_init, & - 'Model start time: year, month, day, hour, minute, second' - write(restart_unit, '(6i6,8x,a)' )date, & - 'Current model time: year, month, day, hour, minute, second' - close(restart_unit) - endif - - if (Time_res > Time_start) then - if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then - open(newunit = restart_unit, file=file_res, status='replace', form='formatted') - call fms_time_manager_get_date(Time_res ,yr,mon,day,hr,min,sec) - write(restart_unit, '(6i6,8x,a)' )yr,mon,day,hr,min,sec, & - 'Current intermediate restart time: year, month, day, hour, minute, second' - close(restart_unit) - endif - endif - - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - if (associated(Ocn_bc_restart)) deallocate(Ocn_bc_restart) - - call fms_coupler_type_register_restarts(Ocean%fields, Ocn_bc_restart, & - num_ocn_bc_restart, Ocean%domain, to_read=.false., ocean_restart=.true., directory="RESTART/") - do n = 1, num_ocn_bc_restart - if (fms2_io_check_if_open(Ocn_bc_restart(n))) then - call fms2_io_write_restart(Ocn_bc_restart(n)) - call add_domain_dimension_data(Ocn_bc_restart(n)) - call fms2_io_close_file(Ocn_bc_restart(n)) - endif - enddo - endif !< (Ocean%is_ocean_pe) - - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - - if (associated(Ice_bc_restart)) deallocate(Ice_bc_restart) - call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & - num_ice_bc_restart, Ice%slow_domain_NH, to_read=.false., ocean_restart=.false., directory="RESTART/") - do n = 1, num_ice_bc_restart - if (fms2_io_check_if_open(Ice_bc_restart(n))) then - call fms2_io_write_restart(Ice_bc_restart(n)) - call add_domain_dimension_data(Ice_bc_restart(n)) - call fms2_io_close_file(Ice_bc_restart(n)) - endif - enddo - endif !< (Atm%pe) - - end subroutine coupler_restart - -!-------------------------------------------------------------------------- - -!> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(id, timestep) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - - type :: tracer_ind_type - integer :: atm, ice, lnd ! indices of the tracer in the respective models - end type tracer_ind_type - integer :: n_atm_tr, n_lnd_tr, n_exch_tr - integer :: n_atm_tr_tot, n_lnd_tr_tot - integer :: i, tr, n, m, outunit - type(tracer_ind_type), allocatable :: tr_table(:) - character(32) :: tr_name - - call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, & - num_prog=n_atm_tr) - call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, & - num_prog=n_lnd_tr) - - ! Assemble the table of tracer number translation by matching names of - ! prognostic tracers in the atmosphere and surface models; skip all atmos. - ! tracers that have no corresponding surface tracers. - allocate(tr_table(n_atm_tr)) - n = 1 - do i = 1,n_atm_tr - call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, i, tr_name ) - tr_table(n)%atm = i - tr_table(n)%ice = fms_tracer_manager_get_tracer_index ( MODEL_ICE, tr_name ) - tr_table(n)%lnd = fms_tracer_manager_get_tracer_index ( MODEL_LAND, tr_name ) - if (tr_table(n)%ice/=NO_TRACER .or. tr_table(n)%lnd/=NO_TRACER) n = n+1 - enddo - n_exch_tr = n-1 - -100 FORMAT("CHECKSUM::",A32," = ",Z20) -101 FORMAT("CHECKSUM::",A16,a,'%',a," = ",Z20) - - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - - outunit = fms_mpp_stdout() - write(outunit,*) 'BEGIN CHECKSUM(Atm):: ', id, timestep - write(outunit,100) 'atm%t_bot', fms_mpp_chksum(atm%t_bot) - write(outunit,100) 'atm%z_bot', fms_mpp_chksum(atm%z_bot) - write(outunit,100) 'atm%p_bot', fms_mpp_chksum(atm%p_bot) - write(outunit,100) 'atm%u_bot', fms_mpp_chksum(atm%u_bot) - write(outunit,100) 'atm%v_bot', fms_mpp_chksum(atm%v_bot) - write(outunit,100) 'atm%p_surf', fms_mpp_chksum(atm%p_surf) - write(outunit,100) 'atm%gust', fms_mpp_chksum(atm%gust) - do tr = 1,n_exch_tr - n = tr_table(tr)%atm - if (n /= NO_TRACER) then - call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) - write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(Atm%tr_bot(:,:,n)) - endif - enddo - - write(outunit,100) 'land%t_surf', fms_mpp_chksum(land%t_surf) - write(outunit,100) 'land%t_ca', fms_mpp_chksum(land%t_ca) - write(outunit,100) 'land%rough_mom', fms_mpp_chksum(land%rough_mom) - write(outunit,100) 'land%rough_heat', fms_mpp_chksum(land%rough_heat) - write(outunit,100) 'land%rough_scale', fms_mpp_chksum(land%rough_scale) - do tr = 1,n_exch_tr - n = tr_table(tr)%lnd - if (n /= NO_TRACER) then - call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) -#ifndef _USE_LEGACY_LAND_ - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,n)) -#else - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,:,n)) -#endif - endif - enddo - - write(outunit,100) 'ice%t_surf', fms_mpp_chksum(ice%t_surf) - write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(ice%rough_mom) - write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(ice%rough_heat) - write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(ice%rough_moist) - write(outunit,*) 'STOP CHECKSUM(Atm):: ', id, timestep - - !endif - - !if (Ocean%is_ocean_pe) then - !call mpp_set_current_pelist(Ocean%pelist) - - write(outunit,*) 'BEGIN CHECKSUM(Ice):: ', id, timestep - call fms_coupler_type_write_chksums(Ice%ocean_fields, outunit, 'ice%') - write(outunit,*) 'STOP CHECKSUM(Ice):: ', id, timestep - - endif - - deallocate(tr_table) - - call fms_mpp_set_current_pelist() - - end subroutine coupler_chksum - - !####################################################################### - -!> \brief This subroutine calls subroutine that will print out checksums of the elements -!! of the appropriate type. -!! -!! For coupled models typically these types are not defined on all processors. -!! It is assumed that the appropriate pelist has been set before entering this routine. -!! This can be achieved in the following way. -!! ~~~~~~~~~~{.f90} -!! if (Atm%pe) then -!! call mpp_set_current_pelist(Atm%pelist) -!! call atmos_ice_land_chksum('MAIN_LOOP-', nc) -!! endif -!! ~~~~~~~~~~ -!! If you are on the global pelist before you enter this routine using the above call, -!! you can return to the global pelist by invoking -!! ~~~~~~~~~~{.f90} -!! call mpp_set_current_pelist() -!! ~~~~~~~~~~ -!! after you exit. This is only necessary if you need to return to the global pelist. - subroutine atmos_ice_land_chksum(id, timestep, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, & - Atmos_land_boundary) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type (atmos_data_type), intent(in) :: Atm - type (land_data_type), intent(in) :: Land - type (ice_data_type), intent(in) :: Ice - type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary - type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary - - call atmos_data_type_chksum( id, timestep, Atm) - call lnd_ice_atm_bnd_type_chksum(id, timestep, Land_ice_atmos_boundary) - - if (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - call ice_data_type_chksum( id, timestep, Ice) - call atm_ice_bnd_type_chksum(id, timestep, Atmos_ice_boundary) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - call land_data_type_chksum( id, timestep, Land) - call atm_lnd_bnd_type_chksum(id, timestep, Atmos_land_boundary) - endif - - call fms_mpp_set_current_pelist(Atm%pelist) - - end subroutine atmos_ice_land_chksum - -!> \brief This subroutine calls subroutine that will print out checksums of the elements -!! of the appropriate type. -!! -!! For coupled models typically these types are not defined on all processors. -!! It is assumed that the appropriate pelist has been set before entering this routine. -!! This can be achieved in the following way. -!! ~~~~~~~~~~{.f90} -!! if (Ice%slow_ice_pe) then -!! call mpp_set_current_pelist(Ice%slow_pelist) -!! call slow_ice_chksum('MAIN_LOOP-', nc) -!! endif -!! ~~~~~~~~~~ -!! If you are on the global pelist before you enter this routine using the above call, -!! you can return to the global pelist by invoking -!! ~~~~~~~~~~{.f90} -!! call mpp_set_current_pelist() -!! ~~~~~~~~~~ -!! after you exit. This is only necessary if you need to return to the global pelist. - subroutine slow_ice_chksum(id, timestep, Ice, Ocean_ice_boundary) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ice_data_type), intent(in) :: Ice - type(ocean_ice_boundary_type), intent(in) :: Ocean_ice_boundary - - call ice_data_type_chksum( id, timestep, Ice) - call ocn_ice_bnd_type_chksum( id, timestep, Ocean_ice_boundary) - - end subroutine slow_ice_chksum - - -!> \brief This subroutine calls subroutine that will print out checksums of the elements -!! of the appropriate type. -!! -!! For coupled models typically these types are not defined on all processors. -!! It is assumed that the appropriate pelist has been set before entering this routine. -!! This can be achieved in the following way. -!! ~~~~~~~~~~{.f90} -!! if (Ocean%is_ocean_pe) then -!! call mpp_set_current_pelist(Ocean%pelist) -!! call ocean_chksum('MAIN_LOOP-', nc) -!! endif -!! ~~~~~~~~~~ -!! If you are on the global pelist before you enter this routine using the above call, -!! you can return to the global pelist by invoking -!! ~~~~~~~~~~{.f90} -!! call mpp_set_current_pelist() -!! ~~~~~~~~~~ -!! after you exit. This is only necessary if you need to return to the global pelist. - subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type (ocean_public_type), intent(in) :: Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - - call ocean_public_type_chksum(id, timestep, Ocean) - call ice_ocn_bnd_type_chksum( id, timestep, Ice_ocean_boundary) - - end subroutine ocean_chksum - - -end module coupler_wrapper_mod From 5c0e8492fd4be352c372352455d5b4667ef52a24 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 5 Feb 2024 13:38:16 -0500 Subject: [PATCH 04/78] add full_coupler_mod --- full/full_coupler_mod.F90 | 1524 +++++++++++++++++++++++++++++++++++++ 1 file changed, 1524 insertions(+) create mode 100644 full/full_coupler_mod.F90 diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 new file mode 100644 index 00000000..2d52ea08 --- /dev/null +++ b/full/full_coupler_mod.F90 @@ -0,0 +1,1524 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS) Coupler. +!* +!* FMS Coupler is free software: you can redistribute it and/or modify +!* it under the terms of the GNU Lesser General Public License as +!* published by the Free Software Foundation, either version 3 of the +!* License, or (at your option) any later version. +!* +!* FMS Coupler is distributed in the hope that it will be useful, but +!* WITHOUT ANY WARRANTY; without even the implied warranty of +!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +!* General Public License for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS Coupler. +!* If not, see . +!*********************************************************************** +module full_coupler_mod + + use FMS !, status_fms=>status + use FMSconstants, only: fmsconstants_init + +#ifdef use_deprecated_io + use fms_io_mod, only: fms_io_exit +#endif + +! model interfaces used to couple the component models: +! atmosphere, land, ice, and ocean +! + + use atmos_model_mod, only: atmos_model_init, atmos_model_end + use atmos_model_mod, only: update_atmos_model_dynamics + use atmos_model_mod, only: update_atmos_model_down + use atmos_model_mod, only: update_atmos_model_up + use atmos_model_mod, only: atmos_data_type + use atmos_model_mod, only: land_ice_atmos_boundary_type + use atmos_model_mod, only: atmos_data_type_chksum + use atmos_model_mod, only: lnd_ice_atm_bnd_type_chksum + use atmos_model_mod, only: lnd_atm_bnd_type_chksum + use atmos_model_mod, only: ice_atm_bnd_type_chksum + use atmos_model_mod, only: atmos_model_restart + use atmos_model_mod, only: update_atmos_model_radiation + use atmos_model_mod, only: update_atmos_model_state + + use land_model_mod, only: land_model_init, land_model_end + use land_model_mod, only: land_data_type, atmos_land_boundary_type + use land_model_mod, only: update_land_model_fast, update_land_model_slow + use land_model_mod, only: atm_lnd_bnd_type_chksum + use land_model_mod, only: land_data_type_chksum + use land_model_mod, only: land_model_restart + + use ice_model_mod, only: ice_model_init, share_ice_domains, ice_model_end, ice_model_restart + use ice_model_mod, only: update_ice_model_fast, set_ice_surface_fields + use ice_model_mod, only: ice_data_type, land_ice_boundary_type + use ice_model_mod, only: ocean_ice_boundary_type, atmos_ice_boundary_type + use ice_model_mod, only: ice_data_type_chksum, ocn_ice_bnd_type_chksum + use ice_model_mod, only: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum + use ice_model_mod, only: unpack_ocean_ice_boundary, exchange_slow_to_fast_ice + use ice_model_mod, only: ice_model_fast_cleanup, unpack_land_ice_boundary + use ice_model_mod, only: exchange_fast_to_slow_ice, update_ice_model_slow + + use ocean_model_mod, only: update_ocean_model, ocean_model_init, ocean_model_end + use ocean_model_mod, only: ocean_public_type, ocean_state_type, ice_ocean_boundary_type + use ocean_model_mod, only: ocean_model_restart + use ocean_model_mod, only: ocean_public_type_chksum, ice_ocn_bnd_type_chksum + + use combined_ice_ocean_driver, only: update_slow_ice_and_ocean, ice_ocean_driver_type + use combined_ice_ocean_driver, only: ice_ocean_driver_init, ice_ocean_driver_end +! +! flux_ calls translate information between model grids - see flux_exchange.f90 +! + + use flux_exchange_mod, only: flux_exchange_init, gas_exchange_init, sfc_boundary_layer + use flux_exchange_mod, only: generate_sfc_xgrid, send_ice_mask_sic + use flux_exchange_mod, only: flux_down_from_atmos, flux_up_to_atmos + use flux_exchange_mod, only: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice + use flux_exchange_mod, only: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish + use flux_exchange_mod, only: flux_check_stocks, flux_init_stocks + use flux_exchange_mod, only: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks + use flux_exchange_mod, only: flux_atmos_to_ocean, flux_ex_arrays_dealloc + + use atmos_tracer_driver_mod, only: atmos_tracer_driver_gather_data + + use iso_fortran_env + + implicit none + +!----------------------------------------------------------------------- + + character(len=128) :: version = '$Id$' + character(len=128) :: tag = '$Name$' + +!----------------------------------------------------------------------- +!---- model defined-types ---- + + type (atmos_data_type) :: Atm + type (land_data_type) :: Land + type (ice_data_type) :: Ice + ! allow members of ocean type to be aliased (ap) + type (ocean_public_type), target :: Ocean + type (ocean_state_type), pointer :: Ocean_state => NULL() + + type(atmos_land_boundary_type) :: Atmos_land_boundary + type(atmos_ice_boundary_type) :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary + type(land_ice_boundary_type) :: Land_ice_boundary + type(ice_ocean_boundary_type) :: Ice_ocean_boundary + type(ocean_ice_boundary_type) :: Ocean_ice_boundary + type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() + +!----------------------------------------------------------------------- +! ----- coupled model time ----- + + type (FmsTime_type) :: Time, Time_init, Time_end, & + Time_step_atmos, Time_step_cpld + type(FmsTime_type) :: Time_atmos, Time_ocean + type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice + + integer :: num_atmos_calls, na + integer :: num_cpld_calls, nc + + type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() + type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() + + integer :: num_ice_bc_restart=0, num_ocn_bc_restart=0 + type(FmsTime_type) :: Time_restart, Time_restart_current, Time_start + character(len=32) :: timestamp + +! ----- coupled model initial date ----- + + integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) + integer :: calendar_type = INVALID_CALENDAR + +!----------------------------------------------------------------------- +!------ namelist interface ------- + + integer, dimension(6) :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) !< The time interval that write out intermediate restart file. + !! The format is (yr,mo,day,hr,min,sec). When restart_interval + !! is all zero, no intermediate restart file will be written out + integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See + !! force_date_from_namelist.) + character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are + !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. + !! The value 'no_calendar' cannot be used because the time_manager's date + !! functions are used. All values must be lower case. + logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date should override + !! the date in the restart file `INPUT/coupler.res`. If the restart file does not + !! exist then force_date_from_namelist has no effect, the value of current_date + !! will be used. + integer :: months=0 !< Number of months the current integration will be run + integer :: days=0 !< Number of days the current integration will be run + integer :: hours=0 !< Number of hours the current integration will be run + integer :: minutes=0 !< Number of minutes the current integration will be run + integer :: seconds=0 !< Number of seconds the current integration will be run + integer :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fat coupling with land and sea ice + integer :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must be an + !! integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. + integer :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere + integer :: ocean_npes=0 !< The number of MPI tasks to use for the ocean + integer :: ice_npes=0 !< The number of MPI tasks to use for the ice + integer :: land_npes=0 !< The number of MPI tasks to use for the land + integer :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere + integer :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean + integer :: radiation_nthreads=1 !< Number of threads to use for the radiation. + logical :: do_atmos =.true. !< Indicates if this component should be executed. If .FALSE., then execution is skipped. + !! This is used when ALL the output fields sent by this component to the coupler have been + !! overridden using the data_override feature. This is for advanced users only. + logical :: do_land =.true. !< See do_atmos + logical :: do_ice =.true. !< See do_atmos + logical :: do_ocean=.true. !< See do_atmos + logical :: do_flux =.true. !< See do_atmos + logical :: concurrent=.FALSE. !< If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate + !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. + !! If .FALSE., the execution is serial: call atmos... followed by call ocean... + logical :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently + logical :: use_lag_fluxes=.TRUE. !< If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. + !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog + !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable + !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there + !! is probably sufficient damping for MOM4. For more modern ocean models (such as + !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. + !! should be much more stable. + logical :: concurrent_ice=.FALSE. !< If .TRUE., the slow sea-ice is forced with the fluxes that were used for the + !! fast ice processes one timestep before. When used in conjuction with setting + !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and + !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can + !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. + logical :: slow_ice_with_ocean=.FALSE. !< If true, the slow sea-ice is advanced on the ocean processors. Otherwise + !! the slow sea-ice processes are on the same PEs as the fast sea-ice. + logical :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance + !! both the slow sea-ice and the ocean. slow_ice_with_ocean and + !! concurrent_ice must both be true if combined_ice_and_ocean is true. + logical :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. + logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. + logical :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. + integer :: check_stocks = 0 ! -1: never 0: at end of run only n>0: every n coupled steps + logical :: use_hyper_thread = .false. + + namelist /coupler_nml/ current_date, calendar, force_date_from_namelist, & + months, days, hours, minutes, seconds, dt_cpld, dt_atmos, & + do_atmos, do_land, do_ice, do_ocean, do_flux, & + atmos_npes, ocean_npes, ice_npes, land_npes, & + atmos_nthreads, ocean_nthreads, radiation_nthreads, & + concurrent, do_concurrent_radiation, use_lag_fluxes, & + check_stocks, restart_interval, do_debug, do_chksum, & + use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & + do_endpoint_chksum, combined_ice_and_ocean + + type full_coupler_clock_type + integer :: initialization + integer :: main + integer :: generate_sfc_xgrid + integer :: flux_ocean_to_ice + integer :: flux_ice_to_ocean + integer :: atm + integer :: atmos_loop + integer :: atmos_tracer_driver_gather_data + integer :: sfc_boundary_layer + integer :: update_atmos_model_dynamics + integer :: serial_radiation + integer :: update_atmos_model_down + integer :: flux_down_from_atmos + integer :: update_land_model_fast + integer :: update_ice_model_fast + integer :: flux_up_to_atmos + integer :: update_atmos_model_up + integer :: concurrent_radiation + integer :: concurrent_atmos + integer :: update_atmos_model_state + integer :: update_land_model_slow + integer :: flux_land_to_ice + integer :: set_ice_surface_fast + integer :: update_ice_model_slow_fast + integer :: set_ice_surface_slow + integer :: update_ice_model_slow_slow + integer :: flux_ice_to_ocean_stocks + integer :: set_ice_surface_exchange + integer :: update_ice_model_slow_exchange + integer :: ocean + integer :: flux_check_stocks + integer :: intermediate_restart + integer :: final_flux_check_stocks + integer :: termination + integer :: atmos_model_init + integer :: land_model_init + integer :: ice_model_init + integer :: ocean_model_init + integer :: flux_exchange_init + end type full_coupler_clock_type + + type(full_coupler_clock_type) :: full_coupler_clocks + + character(len=80) :: text + character(len=48), parameter :: mod_name = 'coupler_main_mod' + + integer :: outunit + integer :: ensemble_id = 1 + integer, allocatable :: ensemble_pelist(:, :) + integer, allocatable :: slow_ice_ocean_pelist(:) + integer :: conc_nthreads = 1 + real :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 + +contains + +!####################################################################### + +!> \brief Initialize all defined exchange grids and all boundary maps + subroutine coupler_init + + use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_id,ensemble_pelist_setup + use ensemble_manager_mod, only : get_ensemble_size, get_ensemble_pelist + + +! +!----------------------------------------------------------------------- +! local parameters +!----------------------------------------------------------------------- +! + + character(len=64), parameter :: sub_name = 'coupler_init' + character(len=256), parameter :: error_header = & + '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):' + character(len=256), parameter :: note_header = & + '==>Note from ' // trim(mod_name) // '(' // trim(sub_name) // '):' + + integer :: ierr, io, m, i, outunit, logunit, errunit + integer :: date(6) + type (FmsTime_type) :: Run_length + character(len=9) :: month + integer :: pe, npes + + integer :: ens_siz(6), ensemble_size + + integer :: atmos_pe_start=0, atmos_pe_end=0, & + ocean_pe_start=0, ocean_pe_end=0 + integer :: n + integer :: diag_model_subset=DIAG_ALL + logical :: other_fields_exist + character(len=256) :: err_msg + integer :: date_restart(6) + character(len=64) :: filename, fieldname + integer :: id_restart, l + character(len=8) :: walldate + character(len=10) :: walltime + character(len=5) :: wallzone + integer :: wallvalues(8) + character(len=:), dimension(:), allocatable :: restart_file !< Restart file saved as a string + integer :: time_stamp_unit !< Unif of the time_stamp file + integer :: ascii_unit !< Unit of a dummy ascii file + + type(FmsCoupler1dBC_type), pointer :: & + gas_fields_atm => NULL(), & ! A pointer to the type describing the + ! atmospheric fields that will participate in the gas fluxes. + gas_fields_ocn => NULL(), & ! A pointer to the type describing the ocean + ! and ice surface fields that will participate in the gas fluxes. + gas_fluxes => NULL() ! A pointer to the type describing the + ! atmosphere-ocean gas and tracer fluxes. +!----------------------------------------------------------------------- + + outunit = fms_mpp_stdout() + errunit = fms_mpp_stderr() + logunit = fms_mpp_stdlog() + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Entering coupler_init at '& + //trim(walldate)//' '//trim(walltime) + endif + +!----- write version to logfile ------- + call fms_write_version_number(version, tag) + +!----- read namelist ------- + + read (fms_mpp_input_nml_file, coupler_nml, iostat=io) + ierr = check_nml_error (io, 'coupler_nml') + +!----- read date and calendar type from restart file ----- + if (fms2_io_file_exists('INPUT/coupler.res')) then + call fms2_io_ascii_read('INPUT/coupler.res', restart_file) + read(restart_file(1), *) calendar_type + read(restart_file(2), *) date_init + read(restart_file(3), *) date + deallocate(restart_file) + else + force_date_from_namelist = .true. + endif + +!----- use namelist value (either no restart or override flag on) --- + + if ( force_date_from_namelist ) then + + if ( sum(current_date) <= 0 ) then + call error_mesg ('program coupler', & + 'no namelist value for base_date or current_date', FATAL) + else + date = current_date + endif + +!----- override calendar type with namelist value ----- + + select case( fms_mpp_uppercase(trim(calendar)) ) + case( 'GREGORIAN' ) + calendar_type = GREGORIAN + case( 'JULIAN' ) + calendar_type = JULIAN + case( 'NOLEAP' ) + calendar_type = NOLEAP + case( 'THIRTY_DAY' ) + calendar_type = THIRTY_DAY_MONTHS + case( 'NO_CALENDAR' ) + calendar_type = NO_CALENDAR + end select + + endif + + call fms_time_manager_set_calendar_type (calendar_type, err_msg) + if (err_msg /= '') then + call fms_mpp_error(FATAL, 'ERROR in coupler_init: '//trim(err_msg)) + endif + + if (concurrent .AND. .NOT.(use_lag_fluxes .OR. concurrent_ice) ) & + call fms_mpp_error( WARNING, 'coupler_init: you have set concurrent=TRUE, & + & use_lag_fluxes=FALSE, and concurrent_ice=FALSE & + & in coupler_nml. When not using lag fluxes, components & + & will synchronize at two points, and thus run serially.' ) + if (concurrent_ice .AND. .NOT.slow_ice_with_ocean ) call fms_mpp_error(WARNING, & + 'coupler_init: concurrent_ice is true, but slow ice_with_ocean is & + & false in coupler_nml. These two flags should both be true to avoid & + & effectively serializing the run.' ) + if (use_lag_fluxes .AND. concurrent_ice ) call fms_mpp_error(WARNING, & + 'coupler_init: use_lag_fluxes and concurrent_ice are both true. & + & These two coupling options are intended to be exclusive.' ) + + !Check with the ensemble_manager module for the size of ensemble + !and PE counts for each member of the ensemble. + ! + !NOTE: ensemble_manager_init renames all the output files (restart and diagnostics) + ! to show which ensemble member they are coming from. + ! There also need to be restart files for each member of the ensemble in INPUT. + ! + !NOTE: if the ensemble_size=1 the input/output files will not be renamed. + ! + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting initializing ensemble_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_ensemble_manager_init() ! init pelists for ensembles + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing ensemble_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + ens_siz = get_ensemble_size() + ensemble_size = ens_siz(1) + npes = ens_siz(2) + + !Check for the consistency of PE counts + if (concurrent) then +!atmos_npes + ocean_npes must equal npes + if (atmos_npes.EQ.0 ) atmos_npes = npes - ocean_npes + if (ocean_npes.EQ.0 ) ocean_npes = npes - atmos_npes +!both must now be non-zero + if (atmos_npes.EQ.0 .OR. ocean_npes.EQ.0 ) & + call fms_mpp_error( FATAL, 'coupler_init: atmos_npes or ocean_npes must be specified for concurrent coupling.' ) + if (atmos_npes+ocean_npes.NE.npes ) & + call fms_mpp_error( FATAL, 'coupler_init: atmos_npes+ocean_npes must equal npes for concurrent coupling.' ) + else !serial timestepping + if ((atmos_npes.EQ.0) .and. (do_atmos .or. do_land .or. do_ice)) atmos_npes = npes + if ((ocean_npes.EQ.0) .and. (do_ocean)) ocean_npes = npes + if (max(atmos_npes,ocean_npes).EQ.npes) then !overlapping pelists + ! do nothing + else !disjoint pelists + if (atmos_npes+ocean_npes.NE.npes ) call fms_mpp_error( FATAL, & + 'coupler_init: atmos_npes+ocean_npes must equal npes for serial coupling on disjoint pelists.' ) + endif + endif + + if (land_npes == 0 ) land_npes = atmos_npes + if (land_npes > atmos_npes) call fms_mpp_error(FATAL, 'coupler_init: land_npes > atmos_npes') + + if (ice_npes == 0 ) ice_npes = atmos_npes + if (ice_npes > atmos_npes) call fms_mpp_error(FATAL, 'coupler_init: ice_npes > atmos_npes') + + allocate( Atm%pelist (atmos_npes) ) + allocate( Ocean%pelist(ocean_npes) ) + allocate( Land%pelist (land_npes) ) + allocate( Ice%fast_pelist(ice_npes) ) + + !Set up and declare all the needed pelists + call fms_ensemble_manager_ensemble_pelist_setup(concurrent, atmos_npes, ocean_npes, land_npes, ice_npes, & + Atm%pelist, Ocean%pelist, Land%pelist, Ice%fast_pelist) + +!set up affinities based on threads + + ensemble_id = get_ensemble_id() + + allocate(ensemble_pelist(1:ensemble_size,1:npes)) + call fms_ensemble_manager_get_ensemble_pelist(ensemble_pelist) + + Atm%pe = ANY(Atm%pelist .EQ. fms_mpp_pe()) + Ocean%is_ocean_pe = ANY(Ocean%pelist .EQ. fms_mpp_pe()) + Land%pe = ANY(Land%pelist .EQ. fms_mpp_pe()) + + Ice%shared_slow_fast_PEs = .not.slow_ice_with_ocean + ! However, if using a data atmosphere and slow_ice_with_ocean then shared_slow_fast_PEs + ! will be true. In this case, all procesors do the ocean, slow ice, and fast ice. + if (slow_ice_with_ocean.and.(.not.do_atmos)) Ice%shared_slow_fast_PEs = .true. + ! This is where different settings would be applied if the fast and slow + ! ice occurred on different PEs. + if (do_atmos) then + if (Ice%shared_slow_fast_PEs) then + ! Fast and slow ice processes occur on the same PEs. + allocate( Ice%pelist (ice_npes) ) + Ice%pelist(:) = Ice%fast_pelist(:) + allocate( Ice%slow_pelist(ice_npes) ) + Ice%slow_pelist(:) = Ice%fast_pelist(:) + if(concurrent) then + allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) + slow_ice_ocean_pelist(1:ice_npes) = Ice%slow_pelist(:) + slow_ice_ocean_pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) + else + if(ice_npes .GE. ocean_npes) then + allocate(slow_ice_ocean_pelist(ice_npes)) + slow_ice_ocean_pelist(:) = Ice%slow_pelist(:) + else + allocate(slow_ice_ocean_pelist(ocean_npes)) + slow_ice_ocean_pelist(:) = Ocean%pelist(:) + endif + endif + else + ! Fast ice processes occur a subset of the atmospheric PEs, while + ! slow ice processes occur on the ocean PEs. + allocate( Ice%slow_pelist(ocean_npes) ) + Ice%slow_pelist(:) = Ocean%pelist(:) + allocate( Ice%pelist (ice_npes+ocean_npes) ) + ! Set Ice%pelist() to be the union of Ice%fast_pelist and Ice%slow_pelist. + Ice%pelist(1:ice_npes) = Ice%fast_pelist(:) + Ice%pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) + allocate(slow_ice_ocean_pelist(ocean_npes)) + slow_ice_ocean_pelist(:) = Ocean%pelist(:) + endif + elseif (.not.do_atmos) then + ! In the no atmos cases, shared_slow_fast_PEs is not enough to distinguish + ! the slow and fast ice procesor layout; slow_ice_with_ocean should be used instead. + if (slow_ice_with_ocean) then + ! data atmos, using combined ice-ocean driver + ! Both fast ice and slow ice processes occur on the same PEs, + ! since the Atmos and Ocean PEs are shared + allocate( Ice%slow_pelist(ocean_npes) ) + Ice%slow_pelist(:) = Ocean%pelist(:) + allocate( Ice%pelist (ice_npes) ) + Ice%pelist(1:ice_npes) = Ice%fast_pelist(:) + allocate(slow_ice_ocean_pelist(ocean_npes)) + slow_ice_ocean_pelist(:) = Ocean%pelist(:) + else + ! data atmos, not using combined ice-ocean driver + allocate( Ice%pelist (ice_npes) ) + Ice%pelist(:) = Ice%fast_pelist(:) + allocate( Ice%slow_pelist(ice_npes) ) + Ice%slow_pelist(:) = Ice%fast_pelist(:) + if(ice_npes .GE. ocean_npes) then + allocate(slow_ice_ocean_pelist(ice_npes)) + slow_ice_ocean_pelist(:) = Ice%slow_pelist(:) + else + allocate(slow_ice_ocean_pelist(ocean_npes)) + slow_ice_ocean_pelist(:) = Ocean%pelist(:) + endif + endif + endif + Ice%fast_ice_pe = ANY(Ice%fast_pelist(:) .EQ. fms_mpp_pe()) + Ice%slow_ice_pe = ANY(Ice%slow_pelist(:) .EQ. fms_mpp_pe()) + Ice%pe = Ice%fast_ice_pe .OR. Ice%slow_ice_pe + call fms_mpp_declare_pelist(slow_ice_ocean_pelist) + !--- dynamic threading turned off when affinity placement is in use +!$ call omp_set_dynamic(.FALSE.) + !--- nested OpenMP enabled for OpenMP concurrent components +!$ call omp_set_max_active_levels(3) + + if (Atm%pe) then + call fms_mpp_set_current_pelist( Atm%pelist ) +!$ if (.not.do_concurrent_radiation) radiation_nthreads=atmos_nthreads +!$ if (do_concurrent_radiation) conc_nthreads=2 + !--- setting affinity + if (do_concurrent_radiation) then +!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads + radiation_nthreads) +!$ call omp_set_num_threads(atmos_nthreads+radiation_nthreads) + else +!$ call fms_affinity_set('ATMOS', use_hyper_thread, atmos_nthreads) +!$ call omp_set_num_threads(atmos_nthreads) + endif + endif + + !Write out messages on root PEs + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + write( text,'(a,2i6,a,i2.2)' )'Atmos PE range: ', Atm%pelist(1) , Atm%pelist(atmos_npes) ,& + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + if (ocean_npes .gt. 0) then + write( text,'(a,2i6,a,i2.2)' )'Ocean PE range: ', Ocean%pelist(1), Ocean%pelist(ocean_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + else + write( text,'(a,i2.2)' )'Ocean PE range is not set (do_ocean=.false. and concurrent=.false.) for ens_', & + ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + endif + write( text,'(a,2i6,a,i2.2)' )'Land PE range: ', Land%pelist(1) , Land%pelist(land_npes) ,& + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + if (.not.concurrent_ice) then + write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + elseif (concurrent_ice) then + if (do_atmos) then + write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes+ocean_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + elseif ((.not.do_atmos)) then + write( text,'(a,2i6,a,i2.2)' )'Ice PE range: ', Ice%pelist(1), Ice%pelist(ice_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + endif + call fms_mpp_error( NOTE, 'coupler_init: Running with CONCURRENT ICE coupling.' ) + write( text,'(a,2i6,a,i2.2)' )'slow Ice PE range: ', Ice%slow_pelist(1), Ice%slow_pelist(ocean_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + write( text,'(a,2i6,a,i2.2)' )'fast Ice PE range: ', Ice%fast_pelist(1), Ice%fast_pelist(ice_npes), & + ' ens_', ensemble_id + call fms_mpp_error( NOTE, 'coupler_init: '//trim(text) ) + endif + + if (concurrent) then + call fms_mpp_error( NOTE, 'coupler_init: Running with CONCURRENT coupling.' ) + + write( logunit,'(a)' )'Using concurrent coupling...' + write( logunit,'(a,4i6)' ) & + 'atmos_pe_start, atmos_pe_end, ocean_pe_start, ocean_pe_end=', & + Atm%pelist(1) , Atm%pelist(atmos_npes), Ocean%pelist(1), Ocean%pelist(ocean_npes) + else + call fms_mpp_error( NOTE, 'coupler_init: Running with SERIAL coupling.' ) + endif + if (use_lag_fluxes) then + call fms_mpp_error( NOTE, 'coupler_init: Sending LAG fluxes to ocean.' ) + else + call fms_mpp_error( NOTE, 'coupler_init: Sending most recent fluxes to ocean.' ) + endif + if (concurrent_ice) call fms_mpp_error( NOTE, & + 'coupler_init: using lagged slow-ice coupling mode.') + if (combined_ice_and_ocean) call fms_mpp_error( NOTE, & + 'coupler_init: advancing the ocean and slow-ice in a single call.') + if (combined_ice_and_ocean .and. .not.concurrent_ice) call fms_mpp_error( FATAL, & + 'coupler_init: concurrent_ice must be true if combined_ice_and_ocean is true.') + if (combined_ice_and_ocean .and. .not.slow_ice_with_ocean) call fms_mpp_error( FATAL, & + 'coupler_init: slow_ice_with_ocean must be true if combined_ice_and_ocean is true.') + endif + +!----- write namelist to logfile ----- + if (fms_mpp_pe() == fms_mpp_root_pe() )write( logunit, nml=coupler_nml ) + +!----- write current/initial date actually used to logfile file ----- + + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) & + write( logunit, 16 )date(1),trim(fms_time_manager_month_name(date(2))),date(3:6) +16 format (' current date used = ',i4,1x,a,2i3,2(':',i2.2),' gmt') + +!----------------------------------------------------------------------- +!------ initialize diagnostics manager ------ + +!jwd Fork here is somewhat dangerous. It relies on "no side effects" from +! diag_manager_init. diag_manager_init or this section should be +! re-architected to guarantee this or remove this assumption. +! For instance, what follows assumes that get_base_date has the same +! time for both Atm and Ocean pes. While this should be the case, the +! possible error condition needs to be checked + + diag_model_subset=DIAG_ALL + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + if (atmos_npes /= npes) diag_model_subset = DIAG_OTHER ! change diag_model_subset from DIAG_ALL + elseif (Ocean%is_ocean_pe) then ! Error check above for disjoint pelists should catch any problem + call fms_mpp_set_current_pelist(Ocean%pelist) + ! The FMS diag manager has a convention that segregates files with "ocean" + ! in their names from the other files to handle long diag tables. This + ! does not work if the ice is on the ocean PEs. + if ((ocean_npes /= npes) .and. .not.slow_ice_with_ocean) & + diag_model_subset = DIAG_OCEAN ! change diag_model_subset from DIAG_ALL + endif + if ( fms_mpp_pe() == fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize diag_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + ! initialize diag_manager for processor subset output + call fms_diag_init(DIAG_MODEL_SUBSET=diag_model_subset, TIME_INIT=date) + call fms_memutils_print_memuse_stats( 'diag_manager_init' ) + if ( fms_mpp_pe() == fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing diag_manager at '& + //trim(walldate)//' '//trim(walltime) + endif +!----------------------------------------------------------------------- +!------ reset pelist to "full group" ------ + + call fms_mpp_set_current_pelist() +!----- always override initial/base date with diag_manager value ----- + + call fms_diag_get_base_date ( date_init(1), date_init(2), date_init(3), & + date_init(4), date_init(5), date_init(6) ) + +!----- use current date if no base date ------ + + if ( date_init(1) == 0 ) date_init = date + +!----- set initial and current time types ------ + + Time_init = fms_time_manager_set_date (date_init(1), date_init(2), date_init(3), & + date_init(4), date_init(5), date_init(6)) + + Time = fms_time_manager_set_date (date(1), date(2), date(3), & + date(4), date(5), date(6)) + + Time_start = Time + +!----- compute the ending time ----- + + Time_end = Time + do m=1,months + Time_end = Time_end + fms_time_manager_set_time(0,fms_time_manager_days_in_month(Time_end)) + enddo + Time_end = Time_end + fms_time_manager_set_time(hours*3600+minutes*60+seconds, days) + !Need to pass Time_end into diag_manager for multiple thread case. + call fms_diag_set_time_end(Time_end) + + Run_length = Time_end - Time + +!--- get the time that last intermediate restart file was written out. + if (fms2_io_file_exists('INPUT/coupler.intermediate.res')) then + call fms2_io_ascii_read('INPUT/coupler.intermediate.res', restart_file) + read(restart_file(1), *) date_restart + deallocate(restart_file) + else + date_restart = date + endif + + Time_restart_current = Time + if (ALL(restart_interval ==0)) then + Time_restart = fms_time_manager_increment_date(Time_end, 0, 0, 10, 0, 0, 0) ! no intermediate restart + else + Time_restart = fms_time_manager_set_date(date_restart(1), date_restart(2), date_restart(3), & + date_restart(4), date_restart(5), date_restart(6) ) + Time_restart = fms_time_manager_increment_date(Time_restart, restart_interval(1), restart_interval(2), & + restart_interval(3), restart_interval(4), restart_interval(5), restart_interval(6) ) + if (Time_restart <= Time) call fms_mpp_error(FATAL, & + '==>Error from program coupler: The first intermediate restart time is no larger than the start time') + endif + +!----------------------------------------------------------------------- +!----- write time stamps (for start time and end time) ------ + + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') + + month = fms_time_manager_month_name(date(2)) + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) + + call fms_time_manager_get_date (Time_end, date(1), date(2), date(3), & + date(4), date(5), date(6)) + month = fms_time_manager_month_name(date(2)) + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) + + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) close(time_stamp_unit) + +20 format (i6,5i4,2x,a3) + +!----------------------------------------------------------------------- +!----- compute the time steps ------ + + Time_step_cpld = fms_time_manager_set_time (dt_cpld ,0) + Time_step_atmos = fms_time_manager_set_time (dt_atmos,0) + +!----- determine maximum number of iterations per loop ------ + + num_cpld_calls = Run_length / Time_step_cpld + num_atmos_calls = Time_step_cpld / Time_step_atmos + +!----------------------------------------------------------------------- +!------------------- some error checks --------------------------------- + +!----- initial time cannot be greater than current time ------- + + if ( Time_init > Time ) call error_mesg ('program coupler', & + 'initial time is greater than current time', FATAL) + +!----- make sure run length is a multiple of ocean time step ------ + + if ( num_cpld_calls * Time_step_cpld /= Run_length ) & + call error_mesg ('program coupler', & + 'run length must be multiple of coupled time step', FATAL) + +! ---- make sure cpld time step is a multiple of atmos time step ---- + + if ( num_atmos_calls * Time_step_atmos /= Time_step_cpld ) & + call error_mesg ('program coupler', & + 'cpld time step is not a multiple of the atmos time step', FATAL) + +! +! Initialize the tracer manager. This needs to be done on all PEs, +! before the individual models are initialized. +! + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize tracer_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_tracer_manager_init() +! Initialize the gas-exchange fluxes so this information can be made +! available to the individual components. + call gas_exchange_init(gas_fields_atm, gas_fields_ocn, gas_fluxes) + call fms_coupler_types_init() + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing tracer_manager at '& + //trim(walldate)//' '//trim(walltime) + endif + + + +!----------------------------------------------------------------------- +!------ initialize component models ------ +!------ grid info now comes from grid_spec file + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Beginning to initialize component models at '& + //trim(walldate)//' '//trim(walltime) + endif + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) +!---- atmosphere ---- + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize atmospheric model at '& + //trim(walldate)//' '//trim(walltime) + endif + + call fms_mpp_clock_begin(full_coupler_clocks%atmos_model_init) + + call atmos_model_init( Atm, Time_init, Time, Time_step_atmos, & + do_concurrent_radiation) + + call fms_mpp_clock_end(full_coupler_clocks%atmos_model_init) + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing atmospheric model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_memutils_print_memuse_stats( 'atmos_model_init' ) + call fms_data_override_init(Atm_domain_in = Atm%domain) + endif +!---- land ---------- + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize land model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_clock_begin(full_coupler_clocks%land_model_init) + call land_model_init( Atmos_land_boundary, Land, Time_init, Time, & + Time_step_atmos, Time_step_cpld ) + call fms_mpp_clock_end(full_coupler_clocks%land_model_init) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing land model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_memutils_print_memuse_stats( 'land_model_init' ) + call fms_data_override_init(Land_domain_in = Land%domain) +#ifndef _USE_LEGACY_LAND_ + call fms_data_override_init(Land_domainUG_in = Land%ug_domain) +#endif + endif +!---- ice ----------- + if (Ice%pe) then ! This occurs for all fast or slow ice PEs. + if (Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + else + call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") + endif + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize ice model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_clock_begin(full_coupler_clocks%ice_model_init) + call ice_model_init(Ice, Time_init, Time, Time_step_atmos, & + Time_step_cpld, Verona_coupler=.false., & + concurrent_ice=concurrent_ice, & + gas_fluxes=gas_fluxes, gas_fields_ocn=gas_fields_ocn ) + call fms_mpp_clock_end(full_coupler_clocks%ice_model_init) + + ! This must be called using the union of the ice PE_lists. + call fms_mpp_set_current_pelist(Ice%pelist) + call share_ice_domains(Ice) + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing ice model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_memutils_print_memuse_stats( 'ice_model_init' ) + if (Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(Ice%fast_pelist) + call fms_data_override_init(Ice_domain_in = Ice%domain) + endif + endif + +!---- ocean --------- + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize ocean model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_clock_begin(full_coupler_clocks%ocean_model_init) + call ocean_model_init( Ocean, Ocean_state, Time_init, Time, & + gas_fields_ocn=gas_fields_ocn ) + call fms_mpp_clock_end(full_coupler_clocksocean_model_init) + + if (concurrent) then + call fms_mpp_set_current_pelist( Ocean%pelist ) +!$ call fms_affinity_set('OCEAN', use_hyper_thread, ocean_nthreads) +!$ call omp_set_num_threads(ocean_nthreads) + else + ocean_nthreads = atmos_nthreads + !--- omp_num_threads has already been set by the Atmos-pes, but set again to ensure +!$ call omp_set_num_threads(ocean_nthreads) + endif + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing ocean model at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_memutils_print_memuse_stats( 'ocean_model_init' ) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize data_override at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_data_override_init(Ocean_domain_in = Ocean%domain ) + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing data_override at '& + //trim(walldate)//' '//trim(walltime) + endif + + if (combined_ice_and_ocean) & + call ice_ocean_driver_init(ice_ocean_driver_CS, Time_init, Time) + + endif ! end of Ocean%is_ocean_pe + +!--------------------------------------------- + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finished initializing component models at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + + call fms_mpp_domains_broadcast_domain(Ice%domain) + call fms_mpp_domains_broadcast_domain(Ice%slow_domain_NH) + call fms_mpp_domains_broadcast_domain(Ocean%domain) +!----------------------------------------------------------------------- +!---- initialize flux exchange module ---- + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Starting to initialize flux_exchange at '& + //trim(walldate)//' '//trim(walltime) + endif + call fms_mpp_clock_begin(full_coupler_clocks%flux_exchange_init) + call flux_exchange_init ( Time, Atm, Land, Ice, Ocean, Ocean_state,& + atmos_ice_boundary, land_ice_atmos_boundary, & + land_ice_boundary, ice_ocean_boundary, ocean_ice_boundary, & + do_ocean, slow_ice_ocean_pelist, dt_atmos=dt_atmos, dt_cpld=dt_cpld) + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + call fms_mpp_clock_end(full_coupler_clocks%flux_exchange_init) + call fms_mpp_set_current_pelist() + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Finsihed initializing flux_exchange at '& + //trim(walldate)//' '//trim(walltime) + endif + + Time_atmos = Time + Time_ocean = Time + +! +! read in extra fields for the air-sea gas fluxes +! + if ( Ice%slow_ice_pe ) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + + call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & + num_ice_bc_restart, Ice%slow_domain_NH, to_read=.true., ocean_restart=.false., directory="INPUT/") + + ! Restore the fields from the restart files + do l = 1, num_ice_bc_restart + if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_read_restart(Ice_bc_restart(l)) + enddo + + ! Check whether the restarts were read successfully. + call fms_coupler_type_restore_state(Ice%ocean_fluxes, use_fms2_io=.true., & + test_by_field=.true.) + + do l = 1, num_ice_bc_restart + if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_close_file(Ice_bc_restart(l)) + enddo + endif !< ( Ice%slow_ice_pe ) + + if ( Ocean%is_ocean_pe ) then + call fms_mpp_set_current_pelist(Ocean%pelist) + + call fms_coupler_type_register_restarts(Ocean%fields, Ocn_bc_restart, & + num_ocn_bc_restart, Ocean%domain, to_read=.true., ocean_restart=.true., directory="INPUT/") + + ! Restore the fields from the restart files + do l = 1, num_ocn_bc_restart + if(fms2_io_check_if_open(Ocn_bc_restart(l))) call fms2_io_read_restart(Ocn_bc_restart(l)) + enddo + + ! Check whether the restarts were read successfully. + call fms_coupler_type_restore_state(Ocean%fields, use_fms2_io=.true., & + test_by_field=.true.) + + do l = 1, num_ocn_bc_restart + if(fms2_io_check_if_open(Ocn_bc_restart(l))) call fms2_io_close_file(Ocn_bc_restart(l)) + enddo + endif !< ( Ocean%is_ocean_pe ) + + call fms_mpp_set_current_pelist() + +!----------------------------------------------------------------------- +!---- open and close dummy file in restart dir to check if dir exists -- + + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) then + open(newunit = ascii_unit, file='RESTART/file', status='replace', form='formatted') + close(ascii_unit,status="delete") + endif + + ! Call to daig_grid_end to free up memory used during regional + ! output setup + CALL fms_diag_grid_end() + +!----------------------------------------------------------------------- + if ( do_endpoint_chksum ) then + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum('coupler_init+', 0, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ice%slow_ice_PE) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_chksum('coupler_init+', 0, Ocean, Ice_ocean_boundary) + endif + endif + + call fms_mpp_set_current_pelist() + call fms_memutils_print_memuse_stats('coupler_init') + + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then + call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) + write(errunit,*) 'Exiting coupler_init at '& + //trim(walldate)//' '//trim(walltime) + endif + end subroutine coupler_init + +!####################################################################### + + subroutine coupler_end() + +!----------------------------------------------------------------------- + + if ( do_endpoint_chksum ) then + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum('coupler_end', 0, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ice%slow_ice_PE) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + call slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_chksum('coupler_end', 0, Ocean, Ice_ocean_boundary) + endif + endif + call fms_mpp_set_current_pelist() + +!----- check time versus expected ending time ---- + + if (Time /= Time_end) call error_mesg ('program coupler', & + 'final time does not match expected ending time', WARNING) + +!----------------------------------------------------------------------- +!the call to fms_io_exit has been moved here +!this will work for serial code or concurrent (disjoint pelists) +!but will fail on overlapping but unequal pelists + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_model_end (Ocean, Ocean_state, Time) + endif + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_model_end ( Atm ) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + call land_model_end (Atmos_land_boundary, Land) + endif + if (Ice%pe) then ! This happens on all fast or slow ice PEs. + if (Ice%slow_ice_PE) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + else ! This must be a fast ice PE. + call fms_mpp_set_current_pelist(Ice%fast_pelist) + endif + call ice_model_end (Ice) + endif + + !----- write restart file ------ + call coupler_restart(Time, Time_restart_current) + + call fms_diag_end (Time) +#ifdef use_deprecated_io + call fms_io_exit +#endif + call fms_mpp_set_current_pelist() + + +!----------------------------------------------------------------------- + + end subroutine coupler_end + + !>@brief Register the axis data as a variable in the netcdf file and add some dummy data. + !! This is needed so the combiner can work correctly when the io_layout is not 1,1 + subroutine add_domain_dimension_data(fileobj) + type(FmsNetcdfDomainFile_t) :: fileobj !< Fms2io domain decomposed fileobj + integer, dimension(:), allocatable :: buffer !< Buffer with axis data + integer :: is, ie !< Starting and Ending indices for data + + call fms2_io_get_global_io_domain_indices(fileobj, "xaxis_1", is, ie, indices=buffer) + call fms2_io_write_data(fileobj, "xaxis_1", buffer) + deallocate(buffer) + + call fms2_io_get_global_io_domain_indices(fileobj, "yaxis_1", is, ie, indices=buffer) + call fms2_io_write_data(fileobj, "yaxis_1", buffer) + deallocate(buffer) + + end subroutine add_domain_dimension_data + + + !> \brief Writing restart file that contains running time and restart file writing time. + subroutine coupler_restart(Time_run, Time_res, time_stamp) + type(FmsTime_type), intent(in) :: Time_run, Time_res + character(len=*), intent(in), optional :: time_stamp + character(len=128) :: file_run, file_res + integer :: yr, mon, day, hr, min, sec, date(6), n + integer :: restart_unit !< Unit for the coupler restart file + + call fms_mpp_set_current_pelist() + + ! write restart file + if (present(time_stamp)) then + file_run = 'RESTART/'//trim(time_stamp)//'.coupler.res' + file_res = 'RESTART/'//trim(time_stamp)//'.coupler.intermediate.res' + else + file_run = 'RESTART/coupler.res' + file_res = 'RESTART/coupler.intermediate.res' + endif + + !----- compute current date ------ + call fms_time_manager_get_date (Time_run, date(1), date(2), date(3), & + date(4), date(5), date(6)) + if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then + open(newunit = restart_unit, file=file_run, status='replace', form='formatted') + write(restart_unit, '(i6,8x,a)' )calendar_type, & + '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' + + write(restart_unit, '(6i6,8x,a)' )date_init, & + 'Model start time: year, month, day, hour, minute, second' + write(restart_unit, '(6i6,8x,a)' )date, & + 'Current model time: year, month, day, hour, minute, second' + close(restart_unit) + endif + + if (Time_res > Time_start) then + if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then + open(newunit = restart_unit, file=file_res, status='replace', form='formatted') + call fms_time_manager_get_date(Time_res ,yr,mon,day,hr,min,sec) + write(restart_unit, '(6i6,8x,a)' )yr,mon,day,hr,min,sec, & + 'Current intermediate restart time: year, month, day, hour, minute, second' + close(restart_unit) + endif + endif + + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + if (associated(Ocn_bc_restart)) deallocate(Ocn_bc_restart) + + call fms_coupler_type_register_restarts(Ocean%fields, Ocn_bc_restart, & + num_ocn_bc_restart, Ocean%domain, to_read=.false., ocean_restart=.true., directory="RESTART/") + do n = 1, num_ocn_bc_restart + if (fms2_io_check_if_open(Ocn_bc_restart(n))) then + call fms2_io_write_restart(Ocn_bc_restart(n)) + call add_domain_dimension_data(Ocn_bc_restart(n)) + call fms2_io_close_file(Ocn_bc_restart(n)) + endif + enddo + endif !< (Ocean%is_ocean_pe) + + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + + if (associated(Ice_bc_restart)) deallocate(Ice_bc_restart) + call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & + num_ice_bc_restart, Ice%slow_domain_NH, to_read=.false., ocean_restart=.false., directory="RESTART/") + do n = 1, num_ice_bc_restart + if (fms2_io_check_if_open(Ice_bc_restart(n))) then + call fms2_io_write_restart(Ice_bc_restart(n)) + call add_domain_dimension_data(Ice_bc_restart(n)) + call fms2_io_close_file(Ice_bc_restart(n)) + endif + enddo + endif !< (Atm%pe) + + end subroutine coupler_restart + +!-------------------------------------------------------------------------- + +!> \brief Print out checksums for several atm, land and ice variables + subroutine coupler_chksum(id, timestep) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + + type :: tracer_ind_type + integer :: atm, ice, lnd ! indices of the tracer in the respective models + end type tracer_ind_type + integer :: n_atm_tr, n_lnd_tr, n_exch_tr + integer :: n_atm_tr_tot, n_lnd_tr_tot + integer :: i, tr, n, m, outunit + type(tracer_ind_type), allocatable :: tr_table(:) + character(32) :: tr_name + + call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, & + num_prog=n_atm_tr) + call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, & + num_prog=n_lnd_tr) + + ! Assemble the table of tracer number translation by matching names of + ! prognostic tracers in the atmosphere and surface models; skip all atmos. + ! tracers that have no corresponding surface tracers. + allocate(tr_table(n_atm_tr)) + n = 1 + do i = 1,n_atm_tr + call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, i, tr_name ) + tr_table(n)%atm = i + tr_table(n)%ice = fms_tracer_manager_get_tracer_index ( MODEL_ICE, tr_name ) + tr_table(n)%lnd = fms_tracer_manager_get_tracer_index ( MODEL_LAND, tr_name ) + if (tr_table(n)%ice/=NO_TRACER .or. tr_table(n)%lnd/=NO_TRACER) n = n+1 + enddo + n_exch_tr = n-1 + +100 FORMAT("CHECKSUM::",A32," = ",Z20) +101 FORMAT("CHECKSUM::",A16,a,'%',a," = ",Z20) + + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + + outunit = fms_mpp_stdout() + write(outunit,*) 'BEGIN CHECKSUM(Atm):: ', id, timestep + write(outunit,100) 'atm%t_bot', fms_mpp_chksum(atm%t_bot) + write(outunit,100) 'atm%z_bot', fms_mpp_chksum(atm%z_bot) + write(outunit,100) 'atm%p_bot', fms_mpp_chksum(atm%p_bot) + write(outunit,100) 'atm%u_bot', fms_mpp_chksum(atm%u_bot) + write(outunit,100) 'atm%v_bot', fms_mpp_chksum(atm%v_bot) + write(outunit,100) 'atm%p_surf', fms_mpp_chksum(atm%p_surf) + write(outunit,100) 'atm%gust', fms_mpp_chksum(atm%gust) + do tr = 1,n_exch_tr + n = tr_table(tr)%atm + if (n /= NO_TRACER) then + call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) + write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(Atm%tr_bot(:,:,n)) + endif + enddo + + write(outunit,100) 'land%t_surf', fms_mpp_chksum(land%t_surf) + write(outunit,100) 'land%t_ca', fms_mpp_chksum(land%t_ca) + write(outunit,100) 'land%rough_mom', fms_mpp_chksum(land%rough_mom) + write(outunit,100) 'land%rough_heat', fms_mpp_chksum(land%rough_heat) + write(outunit,100) 'land%rough_scale', fms_mpp_chksum(land%rough_scale) + do tr = 1,n_exch_tr + n = tr_table(tr)%lnd + if (n /= NO_TRACER) then + call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) +#ifndef _USE_LEGACY_LAND_ + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,n)) +#else + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,:,n)) +#endif + endif + enddo + + write(outunit,100) 'ice%t_surf', fms_mpp_chksum(ice%t_surf) + write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(ice%rough_mom) + write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(ice%rough_heat) + write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(ice%rough_moist) + write(outunit,*) 'STOP CHECKSUM(Atm):: ', id, timestep + + !endif + + !if (Ocean%is_ocean_pe) then + !call mpp_set_current_pelist(Ocean%pelist) + + write(outunit,*) 'BEGIN CHECKSUM(Ice):: ', id, timestep + call fms_coupler_type_write_chksums(Ice%ocean_fields, outunit, 'ice%') + write(outunit,*) 'STOP CHECKSUM(Ice):: ', id, timestep + + endif + + deallocate(tr_table) + + call fms_mpp_set_current_pelist() + + end subroutine coupler_chksum + + !####################################################################### + +!> \brief This subroutine calls subroutine that will print out checksums of the elements +!! of the appropriate type. +!! +!! For coupled models typically these types are not defined on all processors. +!! It is assumed that the appropriate pelist has been set before entering this routine. +!! This can be achieved in the following way. +!! ~~~~~~~~~~{.f90} +!! if (Atm%pe) then +!! call mpp_set_current_pelist(Atm%pelist) +!! call atmos_ice_land_chksum('MAIN_LOOP-', nc) +!! endif +!! ~~~~~~~~~~ +!! If you are on the global pelist before you enter this routine using the above call, +!! you can return to the global pelist by invoking +!! ~~~~~~~~~~{.f90} +!! call mpp_set_current_pelist() +!! ~~~~~~~~~~ +!! after you exit. This is only necessary if you need to return to the global pelist. + subroutine atmos_ice_land_chksum(id, timestep, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, & + Atmos_land_boundary) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type (atmos_data_type), intent(in) :: Atm + type (land_data_type), intent(in) :: Land + type (ice_data_type), intent(in) :: Ice + type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary + type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary + type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary + + call atmos_data_type_chksum( id, timestep, Atm) + call lnd_ice_atm_bnd_type_chksum(id, timestep, Land_ice_atmos_boundary) + + if (Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(Ice%fast_pelist) + call ice_data_type_chksum( id, timestep, Ice) + call atm_ice_bnd_type_chksum(id, timestep, Atmos_ice_boundary) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + call land_data_type_chksum( id, timestep, Land) + call atm_lnd_bnd_type_chksum(id, timestep, Atmos_land_boundary) + endif + + call fms_mpp_set_current_pelist(Atm%pelist) + + end subroutine atmos_ice_land_chksum + +!> \brief This subroutine calls subroutine that will print out checksums of the elements +!! of the appropriate type. +!! +!! For coupled models typically these types are not defined on all processors. +!! It is assumed that the appropriate pelist has been set before entering this routine. +!! This can be achieved in the following way. +!! ~~~~~~~~~~{.f90} +!! if (Ice%slow_ice_pe) then +!! call mpp_set_current_pelist(Ice%slow_pelist) +!! call slow_ice_chksum('MAIN_LOOP-', nc) +!! endif +!! ~~~~~~~~~~ +!! If you are on the global pelist before you enter this routine using the above call, +!! you can return to the global pelist by invoking +!! ~~~~~~~~~~{.f90} +!! call mpp_set_current_pelist() +!! ~~~~~~~~~~ +!! after you exit. This is only necessary if you need to return to the global pelist. + subroutine slow_ice_chksum(id, timestep, Ice, Ocean_ice_boundary) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type(ice_data_type), intent(in) :: Ice + type(ocean_ice_boundary_type), intent(in) :: Ocean_ice_boundary + + call ice_data_type_chksum( id, timestep, Ice) + call ocn_ice_bnd_type_chksum( id, timestep, Ocean_ice_boundary) + + end subroutine slow_ice_chksum + + +!> \brief This subroutine calls subroutine that will print out checksums of the elements +!! of the appropriate type. +!! +!! For coupled models typically these types are not defined on all processors. +!! It is assumed that the appropriate pelist has been set before entering this routine. +!! This can be achieved in the following way. +!! ~~~~~~~~~~{.f90} +!! if (Ocean%is_ocean_pe) then +!! call mpp_set_current_pelist(Ocean%pelist) +!! call ocean_chksum('MAIN_LOOP-', nc) +!! endif +!! ~~~~~~~~~~ +!! If you are on the global pelist before you enter this routine using the above call, +!! you can return to the global pelist by invoking +!! ~~~~~~~~~~{.f90} +!! call mpp_set_current_pelist() +!! ~~~~~~~~~~ +!! after you exit. This is only necessary if you need to return to the global pelist. + subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type (ocean_public_type), intent(in) :: Ocean + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + + call ocean_public_type_chksum(id, timestep, Ocean) + call ice_ocn_bnd_type_chksum( id, timestep, Ice_ocean_boundary) + + end subroutine ocean_chksum + +!> \brief This subroutine sets the ID for clocks used in coupler_main + subroutine full_coupler_set_clock_ids(clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) + + type(full_coupler_clock_type), intent(inout) :: full_coupler_clocks + type(atm_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ice_data_type), intent(in) :: Ice + type(ocean_public_type), intent(in) :: Ocean + integer, intent(in) :: do_concurrent_radiation + + !initialization clock is on global pe + full_coupler_clocks%inititialization = fms_mpp_clock_id( 'Initialization' ) + If(Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + full_coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) + end if + if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) + full_coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) + full_coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) + endif + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + full_coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) + full_coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) + full_coupler_clocks%atmos_tracer_driver_gather_data & + = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) + full_coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) + full_coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') + if (.not. do_concurrent_radiation) then + full_coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + endif + full_coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) + full_coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) + full_coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) + full_coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) + full_coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) + full_coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) + if (do_concurrent_radiation) then + full_coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + full_coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) + endif + full_coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') + full_coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) + full_coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) + endif + if (Ice%pe) then + if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) + full_coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) + full_coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) + + if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) + full_coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) + full_coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) + full_coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) + + call fms_mpp_set_current_pelist(Ice%pelist) + full_coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) + full_coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) + + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + full_coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) + endif + + call fms_mpp_set_current_pelist() + full_coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) + full_coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) + full_coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) + + full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) + full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + + !> initialization clock + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + full_coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + full_coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + endif + if (Ice%pe) then + if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) + elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) + else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") + endif + full_coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + full_coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + endif + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + full_coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + + end subroutine full_coupler_set_clock_ids + +end module full_coupler_mod From cd0e90590bb57a76e0a1d2e42f089ac4a9465b7a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 5 Feb 2024 14:13:49 -0500 Subject: [PATCH 05/78] fix errors --- full/coupler_main.F90 | 10 +++++----- full/full_coupler_mod.F90 | 14 +++++++------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 5326521f..f5dddd04 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -336,7 +336,7 @@ program coupler_main call fms_mpp_init() call fms_mpp_clock_begin(full_coupler_clocks%initialization) - + call fms_init call fmsconstants_init call fms_affinity_init @@ -347,7 +347,7 @@ program coupler_main call fms_mpp_set_current_pelist() call fms_mpp_clock_end(full_coupler_clocks%initialization) !end initialization - call fms_mpp_clock_begin(full_coupler_clocks_clocks%main) !begin main loop + call fms_mpp_clock_begin(full_coupler_clocks%main) !begin main loop !----------------------------------------------------------------------- !------ ocean/slow-ice integration loop ------ @@ -357,7 +357,7 @@ program coupler_main call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state) endif - call full_coupler_set_clock_ids(clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) + call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) do nc = 1, num_cpld_calls if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc) @@ -393,10 +393,10 @@ program coupler_main ! Update Ice_ocean_boundary; the first iteration is supplied by restarts if (use_lag_fluxes) then - call fms_mpp_clock_begin(full_coupler_clocks%flux_ice_to_icean) + call fms_mpp_clock_begin(full_coupler_clocks%flux_ice_to_ocean) call flux_ice_to_ocean( Time, Ice, Ocean, Ice_ocean_boundary ) Time_flux_ice_to_ocean = Time - call fms_mpp_clock_end(clocks%flux%flux_ice_to_ocean) + call fms_mpp_clock_end(full_coupler_clocks%flux_ice_to_ocean) endif endif diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 2d52ea08..23435e01 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -895,7 +895,7 @@ subroutine coupler_init call fms_mpp_clock_begin(full_coupler_clocks%ocean_model_init) call ocean_model_init( Ocean, Ocean_state, Time_init, Time, & gas_fields_ocn=gas_fields_ocn ) - call fms_mpp_clock_end(full_coupler_clocksocean_model_init) + call fms_mpp_clock_end(full_coupler_clocks%ocean_model_init) if (concurrent) then call fms_mpp_set_current_pelist( Ocean%pelist ) @@ -1422,17 +1422,17 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine full_coupler_set_clock_ids(clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) + subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) type(full_coupler_clock_type), intent(inout) :: full_coupler_clocks - type(atm_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ice_data_type), intent(in) :: Ice type(ocean_public_type), intent(in) :: Ocean - integer, intent(in) :: do_concurrent_radiation + logical, intent(in) :: do_concurrent_radiation !initialization clock is on global pe - full_coupler_clocks%inititialization = fms_mpp_clock_id( 'Initialization' ) + full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) If(Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) full_coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) From 99cc5a5f6a3a208a3ed30b57fee79ef7f22f3458 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 5 Feb 2024 14:37:23 -0500 Subject: [PATCH 06/78] move omp_lib to full_coupler_mode --- full/coupler_main.F90 | 1 - full/full_coupler_mod.F90 | 2 ++ 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index f5dddd04..0d222531 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -331,7 +331,6 @@ !! This error should probably not occur because of checks done at initialization time. program coupler_main - use omp_lib !< F90 module for OpenMP use full_coupler_mod call fms_mpp_init() diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 23435e01..1c1cf472 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -19,6 +19,8 @@ !*********************************************************************** module full_coupler_mod + use omp_lib + use FMS !, status_fms=>status use FMSconstants, only: fmsconstants_init From 2c3270ce2b1c4583d2a8fb266664750861117aa4 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 6 Feb 2024 15:41:51 -0500 Subject: [PATCH 07/78] fix typo in omp section --- full/coupler_main.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 0d222531..d24b0a59 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -509,7 +509,7 @@ program coupler_main !&OMP& SHARED(full_coupler_clocks%update_land_model_fast, full_coupler_clocks%update_ice_model_fast) & !&OMP& SHARED(full_coupler_clocks%flux_up_to_atmos, full_coupler_clocks%update_atmos_model_up) & !&OMP& SHARED(full_coupler_clocks%concurrent_atmos, full_coupler_clocks%concurrent_radiation) & -!&OMP& SHARED(full_coupler_clocks%newClock%update_atmos_model_dynamics) +!&OMP& SHARED(full_coupler_clocks%update_atmos_model_dynamics) !$ if (omp_get_thread_num() == 0) then !$OMP PARALLEL & !$OMP& NUM_THREADS(1) & @@ -523,7 +523,7 @@ program coupler_main !&OMP& SHARED(full_coupler_clocks%update_land_model_fast, full_coupler_clocks%update_ice_model_fast) & !&OMP& SHARED(full_coupler_clocks%flux_up_to_atmos, full_coupler_clocks%update_atmos_model_up) & !&OMP& SHARED(full_coupler_clocks%concurrent_atmos, full_coupler_clocks%concurrent_radiation) & -!&OMP& SHARED(full_coupler_clocks%newClock%update_atmos_model_dynamics) +!&OMP& SHARED(full_coupler_clocks%update_atmos_model_dynamics) !$ call omp_set_num_threads(atmos_nthreads) !$ dsec=omp_get_wtime() From d2961a6dbeb4a3ced911e20748d85a2531fdc843 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 7 Feb 2024 10:35:11 -0500 Subject: [PATCH 08/78] change omp to full_coupler_clocks --- full/coupler_main.F90 | 12 ++---------- full/full_coupler_mod.F90 | 2 +- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index d24b0a59..df812f75 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -505,11 +505,7 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(full_coupler_clocks%update_atmos_model_down, full_coupler_clocks%flux_down_from_atmos) & -!&OMP& SHARED(full_coupler_clocks%update_land_model_fast, full_coupler_clocks%update_ice_model_fast) & -!&OMP& SHARED(full_coupler_clocks%flux_up_to_atmos, full_coupler_clocks%update_atmos_model_up) & -!&OMP& SHARED(full_coupler_clocks%concurrent_atmos, full_coupler_clocks%concurrent_radiation) & -!&OMP& SHARED(full_coupler_clocks%update_atmos_model_dynamics) +!$OMP& SHARED(full_coupler_clocks) !$ if (omp_get_thread_num() == 0) then !$OMP PARALLEL & !$OMP& NUM_THREADS(1) & @@ -519,11 +515,7 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(full_coupler_clocks%update_atmos_model_down, full_coupler_clocks%flux_down_from_atmos) & -!&OMP& SHARED(full_coupler_clocks%update_land_model_fast, full_coupler_clocks%update_ice_model_fast) & -!&OMP& SHARED(full_coupler_clocks%flux_up_to_atmos, full_coupler_clocks%update_atmos_model_up) & -!&OMP& SHARED(full_coupler_clocks%concurrent_atmos, full_coupler_clocks%concurrent_radiation) & -!&OMP& SHARED(full_coupler_clocks%update_atmos_model_dynamics) +!$OMP& SHARED(full_coupler_clocks) !$ call omp_set_num_threads(atmos_nthreads) !$ dsec=omp_get_wtime() diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 1c1cf472..c185051f 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -253,7 +253,7 @@ module full_coupler_mod end type full_coupler_clock_type type(full_coupler_clock_type) :: full_coupler_clocks - + character(len=80) :: text character(len=48), parameter :: mod_name = 'coupler_main_mod' From cd5a05299dfb95781b3d9830d60706893308d4aa Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 7 Feb 2024 12:14:49 -0500 Subject: [PATCH 09/78] fix clock in omp --- full/coupler_main.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index df812f75..5ed94afe 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -620,7 +620,7 @@ program coupler_main !$OMP& PRIVATE(dsec) & !$OMP& SHARED(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Ocean_ice_boundary, Atmos_land_boundary) & !$OMP& SHARED(do_chksum, do_debug, omp_sec, num_atmos_calls, na, radiation_nthreads) & -!$OMP& SHARED(newClockj) +!$OMP& SHARED(full_coupler_clocks) !$ call omp_set_num_threads(radiation_nthreads) !$ dsec=omp_get_wtime() From 569907277c83c221338d499b24080c01799a52ab Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 7 Feb 2024 12:48:20 -0500 Subject: [PATCH 10/78] initialize clock in coupler_init --- full/coupler_main.F90 | 2 -- full/full_coupler_mod.F90 | 4 ++++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 5ed94afe..f9afe4e6 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -356,8 +356,6 @@ program coupler_main call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state) endif - call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) - do nc = 1, num_cpld_calls if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc) call fms_mpp_set_current_pelist() diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index c185051f..dd715a35 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -538,6 +538,10 @@ subroutine coupler_init Ice%slow_ice_pe = ANY(Ice%slow_pelist(:) .EQ. fms_mpp_pe()) Ice%pe = Ice%fast_ice_pe .OR. Ice%slow_ice_pe call fms_mpp_declare_pelist(slow_ice_ocean_pelist) + + !> The pelists need to be set before initializing the clocks + call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) + !--- dynamic threading turned off when affinity placement is in use !$ call omp_set_dynamic(.FALSE.) !--- nested OpenMP enabled for OpenMP concurrent components From c6ee3006d0d0e91bd5d91095b66937c166d0a729 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 7 Feb 2024 12:56:52 -0500 Subject: [PATCH 11/78] fix initialization clock --- full/coupler_main.F90 | 2 ++ full/full_coupler_mod.F90 | 2 -- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index f9afe4e6..20368f8a 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -334,6 +334,8 @@ program coupler_main use full_coupler_mod call fms_mpp_init() + + full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) call fms_mpp_clock_begin(full_coupler_clocks%initialization) call fms_init diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index dd715a35..eb8d9ef6 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1437,8 +1437,6 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean type(ocean_public_type), intent(in) :: Ocean logical, intent(in) :: do_concurrent_radiation - !initialization clock is on global pe - full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) If(Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) full_coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) From dccf9a4da9ec8311d053107cfe7702da66cf3438 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 7 Feb 2024 15:52:55 -0500 Subject: [PATCH 12/78] cleanup public private --- full/coupler_main.F90 | 1 + full/flux_exchange.F90 | 10 +- full/full_coupler_mod.F90 | 199 ++++++++++++++++++++++---------------- 3 files changed, 122 insertions(+), 88 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 20368f8a..d86bf543 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -331,6 +331,7 @@ !! This error should probably not occur because of checks done at initialization time. program coupler_main + use omp_lib use full_coupler_mod call fms_mpp_init() diff --git a/full/flux_exchange.F90 b/full/flux_exchange.F90 index 35abf236..c1ac8381 100644 --- a/full/flux_exchange.F90 +++ b/full/flux_exchange.F90 @@ -780,11 +780,11 @@ end subroutine flux_exchange_init subroutine flux_check_stocks(Time, Atm, Lnd, Ice, Ocn_state) - type(FmsTime_type) :: Time - type(atmos_data_type), optional :: Atm - type(land_data_type), optional :: Lnd - type(ice_data_type), optional :: Ice - type(ocean_state_type), optional, pointer :: Ocn_state + type(FmsTime_type), intent(in) :: Time + type(atmos_data_type), intent(inout), optional :: Atm + type(land_data_type), intent(inout), optional :: Lnd + type(ice_data_type), intent(inout), optional :: Ice + type(ocean_state_type), intent(inout), optional, pointer :: Ocn_state real :: ref_value integer :: i diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index eb8d9ef6..4a204384 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -19,7 +19,7 @@ !*********************************************************************** module full_coupler_mod - use omp_lib + use omp_lib !< F90 module for OpenMP use FMS !, status_fms=>status use FMSconstants, only: fmsconstants_init @@ -88,47 +88,79 @@ module full_coupler_mod use iso_fortran_env implicit none + private + + public :: FMS, fmsconstants_init + public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up + public :: update_atmos_model_radiation, update_atmos_model_state + public :: update_land_model_fast, update_land_model_slow + public :: update_ice_model_fast, set_ice_surface_fields + public :: unpack_ocean_ice_boundary, exchange_slow_to_fast_ice + public :: ice_model_fast_cleanup, unpack_land_ice_boundary + public :: exchange_fast_to_slow_ice, update_ice_model_slow + public :: update_ocean_model, update_slow_ice_and_ocean + public :: sfc_boundary_layer, generate_sfc_xgrid, send_ice_mask_sic + public :: flux_down_from_atmos, flux_up_to_atmos + public :: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice + public :: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish + public :: flux_check_stocks, flux_init_stocks + public :: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks + public :: flux_atmos_to_ocean, flux_ex_arrays_dealloc + public :: atmos_tracer_driver_gather_data + + public :: atmos_model_restart, land_model_restart, ice_model_restart, ocean_model_restart + + public :: atmos_data_type_chksum, lnd_ice_atm_bnd_type_chksum + public :: lnd_atm_bnd_type_chksum, ice_atm_bnd_type_chksum + public :: atm_lnd_bnd_type_chksum, land_data_type_chksum + public :: ice_data_type_chksum, ocn_ice_bnd_type_chksum + public :: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum + public :: ocean_ice_boundary_type, atmos_ice_boundary_type + public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum + + public :: coupler_init, coupler_end, coupler_restart + public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, full_coupler_set_clock_ids !----------------------------------------------------------------------- - character(len=128) :: version = '$Id$' - character(len=128) :: tag = '$Name$' + character(len=128), public :: version = '$Id$' + character(len=128), public :: tag = '$Name$' !----------------------------------------------------------------------- !---- model defined-types ---- - type (atmos_data_type) :: Atm - type (land_data_type) :: Land - type (ice_data_type) :: Ice + type (atmos_data_type), public :: Atm + type (land_data_type), public :: Land + type (ice_data_type), public :: Ice ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target :: Ocean - type (ocean_state_type), pointer :: Ocean_state => NULL() + type (ocean_public_type), target, public :: Ocean + type (ocean_state_type), pointer, public :: Ocean_state => NULL() - type(atmos_land_boundary_type) :: Atmos_land_boundary - type(atmos_ice_boundary_type) :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary - type(land_ice_boundary_type) :: Land_ice_boundary - type(ice_ocean_boundary_type) :: Ice_ocean_boundary - type(ocean_ice_boundary_type) :: Ocean_ice_boundary - type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() + type(atmos_land_boundary_type), public :: Atmos_land_boundary + type(atmos_ice_boundary_type), public :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type), public :: Land_ice_atmos_boundary + type(land_ice_boundary_type), public :: Land_ice_boundary + type(ice_ocean_boundary_type), public :: Ice_ocean_boundary + type(ocean_ice_boundary_type), public :: Ocean_ice_boundary + type(ice_ocean_driver_type), pointer, public :: ice_ocean_driver_CS => NULL() !----------------------------------------------------------------------- ! ----- coupled model time ----- - type (FmsTime_type) :: Time, Time_init, Time_end, & - Time_step_atmos, Time_step_cpld - type(FmsTime_type) :: Time_atmos, Time_ocean - type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice + type(FmsTime_type), public :: Time, Time_init, Time_end + type(FmsTime_type), public :: Time_step_atmos, Time_step_cpld + type(FmsTime_type), public :: Time_atmos, Time_ocean + type(FmsTime_type), public :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice - integer :: num_atmos_calls, na - integer :: num_cpld_calls, nc + integer, public :: num_atmos_calls, na + integer, public :: num_cpld_calls, nc - type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() - type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() + type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ice_bc_restart => NULL() + type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ocn_bc_restart => NULL() - integer :: num_ice_bc_restart=0, num_ocn_bc_restart=0 - type(FmsTime_type) :: Time_restart, Time_restart_current, Time_start - character(len=32) :: timestamp + integer, public :: num_ice_bc_restart=0, num_ocn_bc_restart=0 + type(FmsTime_type), public :: Time_restart, Time_restart_current, Time_start + character(len=32), public :: timestamp ! ----- coupled model initial date ----- @@ -138,15 +170,15 @@ module full_coupler_mod !----------------------------------------------------------------------- !------ namelist interface ------- - integer, dimension(6) :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) !< The time interval that write out intermediate restart file. - !! The format is (yr,mo,day,hr,min,sec). When restart_interval - !! is all zero, no intermediate restart file will be written out - integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See - !! force_date_from_namelist.) + integer, dimension(6), public :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) !< The time interval that write out intermediate restart file. + !! The format is (yr,mo,day,hr,min,sec). When restart_interval + !! is all zero, no intermediate restart file will be written out + integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See + !! force_date_from_namelist.) character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are - !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. - !! The value 'no_calendar' cannot be used because the time_manager's date - !! functions are used. All values must be lower case. + !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. + !! The value 'no_calendar' cannot be used because the time_manager's date + !! functions are used. All values must be lower case. logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date should override !! the date in the restart file `INPUT/coupler.res`. If the restart file does not !! exist then force_date_from_namelist has no effect, the value of current_date @@ -156,48 +188,48 @@ module full_coupler_mod integer :: hours=0 !< Number of hours the current integration will be run integer :: minutes=0 !< Number of minutes the current integration will be run integer :: seconds=0 !< Number of seconds the current integration will be run - integer :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fat coupling with land and sea ice - integer :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must be an - !! integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. - integer :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere - integer :: ocean_npes=0 !< The number of MPI tasks to use for the ocean - integer :: ice_npes=0 !< The number of MPI tasks to use for the ice - integer :: land_npes=0 !< The number of MPI tasks to use for the land - integer :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere - integer :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean - integer :: radiation_nthreads=1 !< Number of threads to use for the radiation. - logical :: do_atmos =.true. !< Indicates if this component should be executed. If .FALSE., then execution is skipped. - !! This is used when ALL the output fields sent by this component to the coupler have been - !! overridden using the data_override feature. This is for advanced users only. - logical :: do_land =.true. !< See do_atmos - logical :: do_ice =.true. !< See do_atmos - logical :: do_ocean=.true. !< See do_atmos - logical :: do_flux =.true. !< See do_atmos - logical :: concurrent=.FALSE. !< If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate - !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. - !! If .FALSE., the execution is serial: call atmos... followed by call ocean... - logical :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently - logical :: use_lag_fluxes=.TRUE. !< If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. - !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog - !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable - !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there - !! is probably sufficient damping for MOM4. For more modern ocean models (such as - !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. - !! should be much more stable. - logical :: concurrent_ice=.FALSE. !< If .TRUE., the slow sea-ice is forced with the fluxes that were used for the - !! fast ice processes one timestep before. When used in conjuction with setting - !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and - !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can - !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. - logical :: slow_ice_with_ocean=.FALSE. !< If true, the slow sea-ice is advanced on the ocean processors. Otherwise - !! the slow sea-ice processes are on the same PEs as the fast sea-ice. - logical :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance - !! both the slow sea-ice and the ocean. slow_ice_with_ocean and - !! concurrent_ice must both be true if combined_ice_and_ocean is true. - logical :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. + integer, public :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fat coupling with land and sea ice + integer, public :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must be an + !! integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. + integer, public :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere + integer, public :: ocean_npes=0 !< The number of MPI tasks to use for the ocean + integer, public :: ice_npes=0 !< The number of MPI tasks to use for the ice + integer, public :: land_npes=0 !< The number of MPI tasks to use for the land + integer, public :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere + integer, public :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean + integer, public :: radiation_nthreads=1 !< Number of threads to use for the radiation. + logical, public :: do_atmos =.true. !< Indicates if this component should be executed. If .FALSE., then execution is skipped. + !! This is used when ALL the output fields sent by this component to the coupler have been + !! overridden using the data_override feature. This is for advanced users only. + logical, public :: do_land =.true. !< See do_atmos + logical, public :: do_ice =.true. !< See do_atmos + logical, public :: do_ocean=.true. !< See do_atmos + logical, public :: do_flux =.true. !< See do_atmos + logical, public :: concurrent=.FALSE. !< If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate + !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. + !! If .FALSE., the execution is serial: call atmos... followed by call ocean... + logical, public :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently + logical, public :: use_lag_fluxes=.TRUE. !< If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. + !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog + !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable + !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there + !! is probably sufficient damping for MOM4. For more modern ocean models (such as + !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. + !! should be much more stable. + logical, public :: concurrent_ice=.FALSE. !< If .TRUE., the slow sea-ice is forced with the fluxes that were used for the + !! fast ice processes one timestep before. When used in conjuction with setting + !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and + !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can + !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. + logical, public :: slow_ice_with_ocean=.FALSE. !< If true, the slow sea-ice is advanced on the ocean processors. Otherwise + !! the slow sea-ice processes are on the same PEs as the fast sea-ice. + logical, public :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance + !! both the slow sea-ice and the ocean. slow_ice_with_ocean and + !! concurrent_ice must both be true if combined_ice_and_ocean is true. + logical, public :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. - logical :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. - integer :: check_stocks = 0 ! -1: never 0: at end of run only n>0: every n coupled steps + logical, public :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. + integer, public :: check_stocks = 0 !< -1: never 0: at end of run only n>0: every n coupled steps logical :: use_hyper_thread = .false. namelist /coupler_nml/ current_date, calendar, force_date_from_namelist, & @@ -209,7 +241,8 @@ module full_coupler_mod check_stocks, restart_interval, do_debug, do_chksum, & use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean - + + public :: full_coupler_clock_type type full_coupler_clock_type integer :: initialization integer :: main @@ -252,17 +285,17 @@ module full_coupler_mod integer :: flux_exchange_init end type full_coupler_clock_type - type(full_coupler_clock_type) :: full_coupler_clocks + type(full_coupler_clock_type), public :: full_coupler_clocks - character(len=80) :: text - character(len=48), parameter :: mod_name = 'coupler_main_mod' + character(len=80), public :: text + character(len=48), parameter :: mod_name = 'full_coupler_mod' - integer :: outunit + integer, public :: outunit integer :: ensemble_id = 1 integer, allocatable :: ensemble_pelist(:, :) - integer, allocatable :: slow_ice_ocean_pelist(:) - integer :: conc_nthreads = 1 - real :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 + integer, allocatable, public :: slow_ice_ocean_pelist(:) + integer, public :: conc_nthreads = 1 + real, public :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 contains From d1767dc902d06c66924356d842c6195f8c4ccedf Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 7 Feb 2024 15:55:53 -0500 Subject: [PATCH 13/78] fix spacing --- full/full_coupler_mod.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 4a204384..bdd1ad8a 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -133,15 +133,15 @@ module full_coupler_mod type (land_data_type), public :: Land type (ice_data_type), public :: Ice ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target, public :: Ocean + type (ocean_public_type), target, public :: Ocean type (ocean_state_type), pointer, public :: Ocean_state => NULL() - type(atmos_land_boundary_type), public :: Atmos_land_boundary - type(atmos_ice_boundary_type), public :: Atmos_ice_boundary + type(atmos_land_boundary_type), public :: Atmos_land_boundary + type(atmos_ice_boundary_type), public :: Atmos_ice_boundary type(land_ice_atmos_boundary_type), public :: Land_ice_atmos_boundary - type(land_ice_boundary_type), public :: Land_ice_boundary - type(ice_ocean_boundary_type), public :: Ice_ocean_boundary - type(ocean_ice_boundary_type), public :: Ocean_ice_boundary + type(land_ice_boundary_type), public :: Land_ice_boundary + type(ice_ocean_boundary_type), public :: Ice_ocean_boundary + type(ocean_ice_boundary_type), public :: Ocean_ice_boundary type(ice_ocean_driver_type), pointer, public :: ice_ocean_driver_CS => NULL() !----------------------------------------------------------------------- @@ -158,9 +158,9 @@ module full_coupler_mod type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ice_bc_restart => NULL() type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ocn_bc_restart => NULL() - integer, public :: num_ice_bc_restart=0, num_ocn_bc_restart=0 + integer, public :: num_ice_bc_restart=0, num_ocn_bc_restart=0 type(FmsTime_type), public :: Time_restart, Time_restart_current, Time_start - character(len=32), public :: timestamp + character(len=32), public :: timestamp ! ----- coupled model initial date ----- @@ -226,8 +226,8 @@ module full_coupler_mod logical, public :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance !! both the slow sea-ice and the ocean. slow_ice_with_ocean and !! concurrent_ice must both be true if combined_ice_and_ocean is true. - logical, public :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. - logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. + logical, public :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. + logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. logical, public :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. integer, public :: check_stocks = 0 !< -1: never 0: at end of run only n>0: every n coupled steps logical :: use_hyper_thread = .false. From 4478b27c8aef4eb726b10c4fabc8fa1eb248f67c Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 8 Feb 2024 08:04:53 -0500 Subject: [PATCH 14/78] correct clock initializations --- full/coupler_main.F90 | 3 +- full/full_coupler_mod.F90 | 186 ++++++++++++++++++++------------------ 2 files changed, 102 insertions(+), 87 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index d86bf543..70e12df9 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -336,7 +336,8 @@ program coupler_main call fms_mpp_init() - full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) + call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation, & + clock_type='coupler_initialization_clock') call fms_mpp_clock_begin(full_coupler_clocks%initialization) call fms_init diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index bdd1ad8a..5dc16c13 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -834,6 +834,9 @@ subroutine coupler_init !------ initialize component models ------ !------ grid info now comes from grid_spec file + call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & + do_concurrent_radiation, clock_type='atmos_model_init') + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) write(errunit,*) 'Beginning to initialize component models at '& @@ -1461,7 +1464,7 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) + subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation, clock_type) type(full_coupler_clock_type), intent(inout) :: full_coupler_clocks type(atmos_data_type), intent(in) :: Atm @@ -1469,93 +1472,104 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean type(ice_data_type), intent(in) :: Ice type(ocean_public_type), intent(in) :: Ocean logical, intent(in) :: do_concurrent_radiation - - If(Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - full_coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) - end if - if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - full_coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) - full_coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) - endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - full_coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) - full_coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) - full_coupler_clocks%atmos_tracer_driver_gather_data & - = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) - full_coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) - full_coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') - if (.not. do_concurrent_radiation) then - full_coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + character(len=*), intent(in), optional :: clock_type + + if( present(clock_type) ) then + if( trim(clock_type) == 'coupler_initialization_clock' ) then + full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) + else if( trim(clock_type) == 'init_model_clocks' ) then + !> initialization clock + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + full_coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + full_coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + endif + if (Ice%pe) then + if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) + elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) + else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") + endif + full_coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + full_coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + endif + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + full_coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + + call fms_mpp_set_current_pelist() + full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) + full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + end if + else + If(Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + full_coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) + end if + if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) + full_coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) + full_coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) endif - full_coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) - full_coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) - full_coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) - full_coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) - full_coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) - full_coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) - if (do_concurrent_radiation) then - full_coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) - full_coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + full_coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) + full_coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) + full_coupler_clocks%atmos_tracer_driver_gather_data & + = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) + full_coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) + full_coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') + if (.not. do_concurrent_radiation) then + full_coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + endif + full_coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) + full_coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) + full_coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) + full_coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) + full_coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) + full_coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) + if (do_concurrent_radiation) then + full_coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + full_coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) + endif + full_coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') + full_coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) + full_coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) + endif + if (Ice%pe) then + if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) + full_coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) + full_coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) + + if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) + full_coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) + full_coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) + full_coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) + + call fms_mpp_set_current_pelist(Ice%pelist) + full_coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) + full_coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) + + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + full_coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) endif - full_coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') - full_coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) - full_coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) - endif - if (Ice%pe) then - if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) - full_coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) - full_coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) - if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) - full_coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) - full_coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) - full_coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) - - call fms_mpp_set_current_pelist(Ice%pelist) - full_coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) - full_coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) + call fms_mpp_set_current_pelist() + full_coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) + full_coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) + full_coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - full_coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) - endif - - call fms_mpp_set_current_pelist() - full_coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) - full_coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) - full_coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) - - full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) - full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) - - !> initialization clock - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - full_coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - full_coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) - endif - if (Ice%pe) then - if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) - elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) - else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") - endif - full_coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - full_coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) - endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - full_coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) - - end subroutine full_coupler_set_clock_ids - + full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) + full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + end if + + end subroutine full_coupler_set_clock_ids + end module full_coupler_mod From 4ab65b5364e0c2f27fbcbd6546f2bb9aba397cc6 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 8 Feb 2024 09:27:23 -0500 Subject: [PATCH 15/78] fix typo in clocks; add mpp_error to clocks --- full/full_coupler_mod.F90 | 77 ++++++++++++++++++++------------------- 1 file changed, 39 insertions(+), 38 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 5dc16c13..b888905c 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -573,7 +573,8 @@ subroutine coupler_init call fms_mpp_declare_pelist(slow_ice_ocean_pelist) !> The pelists need to be set before initializing the clocks - call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation) + call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & + do_concurrent_radiation, clock_type='init_coupler_clocks') !--- dynamic threading turned off when affinity placement is in use !$ call omp_set_dynamic(.FALSE.) @@ -835,7 +836,7 @@ subroutine coupler_init !------ grid info now comes from grid_spec file call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & - do_concurrent_radiation, clock_type='atmos_model_init') + do_concurrent_radiation, clock_type='init_model_clocks') if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) @@ -1472,41 +1473,39 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean type(ice_data_type), intent(in) :: Ice type(ocean_public_type), intent(in) :: Ocean logical, intent(in) :: do_concurrent_radiation - character(len=*), intent(in), optional :: clock_type - - if( present(clock_type) ) then - if( trim(clock_type) == 'coupler_initialization_clock' ) then - full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) - else if( trim(clock_type) == 'init_model_clocks' ) then - !> initialization clock - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - full_coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - full_coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) - endif - if (Ice%pe) then - if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) - elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) - else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") - endif - full_coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - full_coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + character(len=*), intent(in) :: clock_type + + if( trim(clock_type) == 'coupler_initialization_clock' ) then + full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) + else if( trim(clock_type) == 'init_model_clocks' ) then + !> initialization clock + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + full_coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + full_coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + endif + if (Ice%pe) then + if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) + elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) + else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - full_coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) - - call fms_mpp_set_current_pelist() - full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) - full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) - end if - else + full_coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + full_coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + endif + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + full_coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + + call fms_mpp_set_current_pelist() + full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) + full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + else if( trim(clock_type) == 'init_coupler_clocks' ) then If(Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) full_coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) @@ -1568,8 +1567,10 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + else + call fms_mpp_error(FATAL, 'clock_type not recognized when full_coupler_set_clock_ids') end if - end subroutine full_coupler_set_clock_ids - + end subroutine full_coupler_set_clock_ids + end module full_coupler_mod From a60abd3cbde26bbf1acd1c7ad44bd7fe9a7836c9 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 8 Feb 2024 13:37:03 -0500 Subject: [PATCH 16/78] fix init clocks again --- full/full_coupler_mod.F90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index b888905c..7e05ddcd 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -572,10 +572,6 @@ subroutine coupler_init Ice%pe = Ice%fast_ice_pe .OR. Ice%slow_ice_pe call fms_mpp_declare_pelist(slow_ice_ocean_pelist) - !> The pelists need to be set before initializing the clocks - call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & - do_concurrent_radiation, clock_type='init_coupler_clocks') - !--- dynamic threading turned off when affinity placement is in use !$ call omp_set_dynamic(.FALSE.) !--- nested OpenMP enabled for OpenMP concurrent components @@ -595,6 +591,10 @@ subroutine coupler_init endif endif + !> The pelists need to be set before initializing the clocks + call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & + do_concurrent_radiation, clock_type='init_model_clocks') + !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then write( text,'(a,2i6,a,i2.2)' )'Atmos PE range: ', Atm%pelist(1) , Atm%pelist(atmos_npes) ,& @@ -835,9 +835,6 @@ subroutine coupler_init !------ initialize component models ------ !------ grid info now comes from grid_spec file - call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & - do_concurrent_radiation, clock_type='init_model_clocks') - if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) write(errunit,*) 'Beginning to initialize component models at '& @@ -1477,6 +1474,7 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean if( trim(clock_type) == 'coupler_initialization_clock' ) then full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) + else if( trim(clock_type) == 'init_model_clocks' ) then !> initialization clock if (Atm%pe) then @@ -1505,6 +1503,7 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean call fms_mpp_set_current_pelist() full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + else if( trim(clock_type) == 'init_coupler_clocks' ) then If(Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) @@ -1564,11 +1563,10 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean full_coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) full_coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) full_coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) - - full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) - full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + else call fms_mpp_error(FATAL, 'clock_type not recognized when full_coupler_set_clock_ids') + end if end subroutine full_coupler_set_clock_ids From a6760b2032beaf4e8d88b46999beac8ba9e5bd1f Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 8 Feb 2024 19:33:00 -0500 Subject: [PATCH 17/78] forgot coupler clock initialization --- full/full_coupler_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 7e05ddcd..3b0fd691 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -970,6 +970,9 @@ subroutine coupler_init endif ! end of Ocean%is_ocean_pe + call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & + do_concurrent_radiation, clock_type='init_coupler_clocks') + !--------------------------------------------- if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) From 33c0425c6fcfea7a6622d61902a01f5fb5784c31 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 8 Mar 2024 09:32:02 -0500 Subject: [PATCH 18/78] add public --- full/coupler_main.F90 | 2 +- ...upler_wrapper.F90 => full_coupler_mod.F90} | 240 +++++++++++------- 2 files changed, 148 insertions(+), 94 deletions(-) rename full/{coupler_wrapper.F90 => full_coupler_mod.F90} (86%) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 5dd93a4f..8045eec7 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -333,7 +333,7 @@ program coupler_main !--- F90 module for OpenMP use omp_lib - use coupler_wrapper_mod + use full_coupler_mod call fms_mpp_init() !these clocks are on the global pelist diff --git a/full/coupler_wrapper.F90 b/full/full_coupler_mod.F90 similarity index 86% rename from full/coupler_wrapper.F90 rename to full/full_coupler_mod.F90 index f42207f8..6e0338f8 100644 --- a/full/coupler_wrapper.F90 +++ b/full/full_coupler_mod.F90 @@ -17,7 +17,7 @@ !* License along with FMS Coupler. !* If not, see . !*********************************************************************** -module coupler_wrapper_mod +module full_coupler_mod use FMS !, status_fms=>status use FMSconstants, only: fmsconstants_init @@ -86,6 +86,38 @@ module coupler_wrapper_mod use iso_fortran_env implicit none + private + + public :: FMS, fmsconstants_init + public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up + public :: update_atmos_model_radiation, update_atmos_model_state + public :: update_land_model_fast, update_land_model_slow + public :: update_ice_model_fast, set_ice_surface_fields + public :: unpack_ocean_ice_boundary, exchange_slow_to_fast_ice + public :: ice_model_fast_cleanup, unpack_land_ice_boundary + public :: exchange_fast_to_slow_ice, update_ice_model_slow + public :: update_ocean_model, update_slow_ice_and_ocean + public :: sfc_boundary_layer, generate_sfc_xgrid, send_ice_mask_sic + public :: flux_down_from_atmos, flux_up_to_atmos + public :: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice + public :: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish + public :: flux_check_stocks, flux_init_stocks + public :: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks + public :: flux_atmos_to_ocean, flux_ex_arrays_dealloc + public :: atmos_tracer_driver_gather_data + + public :: atmos_model_restart, land_model_restart, ice_model_restart, ocean_model_restart + + public :: atmos_data_type_chksum, lnd_ice_atm_bnd_type_chksum + public :: lnd_atm_bnd_type_chksum, ice_atm_bnd_type_chksum + public :: atm_lnd_bnd_type_chksum, land_data_type_chksum + public :: ice_data_type_chksum, ocn_ice_bnd_type_chksum + public :: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum + public :: ocean_ice_boundary_type, atmos_ice_boundary_type + public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum + + public :: coupler_init, coupler_end, coupler_restart + public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum !----------------------------------------------------------------------- @@ -95,38 +127,38 @@ module coupler_wrapper_mod !----------------------------------------------------------------------- !---- model defined-types ---- - type (atmos_data_type) :: Atm - type (land_data_type) :: Land - type (ice_data_type) :: Ice + type (atmos_data_type), public :: Atm + type (land_data_type), public :: Land + type (ice_data_type), public :: Ice ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target :: Ocean - type (ocean_state_type), pointer :: Ocean_state => NULL() + type (ocean_public_type), target, public :: Ocean + type (ocean_state_type), pointer, public :: Ocean_state => NULL() - type(atmos_land_boundary_type) :: Atmos_land_boundary - type(atmos_ice_boundary_type) :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary - type(land_ice_boundary_type) :: Land_ice_boundary - type(ice_ocean_boundary_type) :: Ice_ocean_boundary - type(ocean_ice_boundary_type) :: Ocean_ice_boundary - type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() + type(atmos_land_boundary_type), public :: Atmos_land_boundary + type(atmos_ice_boundary_type), public :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type), public :: Land_ice_atmos_boundary + type(land_ice_boundary_type), public :: Land_ice_boundary + type(ice_ocean_boundary_type), public :: Ice_ocean_boundary + type(ocean_ice_boundary_type), public :: Ocean_ice_boundary + type(ice_ocean_driver_type), pointer, public :: ice_ocean_driver_CS => NULL() !----------------------------------------------------------------------- ! ----- coupled model time ----- - type (FmsTime_type) :: Time, Time_init, Time_end, & - Time_step_atmos, Time_step_cpld - type(FmsTime_type) :: Time_atmos, Time_ocean - type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice + type (FmsTime_type), public :: Time, Time_init, Time_end + type(FmsTime_type), public :: Time_step_atmos, Time_step_cpld + type(FmsTime_type), public :: Time_atmos, Time_ocean + type(FmsTime_type), public :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice - integer :: num_atmos_calls, na - integer :: num_cpld_calls, nc + integer, public :: num_atmos_calls, na + integer, public :: num_cpld_calls, nc - type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() - type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() + type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ice_bc_restart => NULL() + type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ocn_bc_restart => NULL() - integer :: num_ice_bc_restart=0, num_ocn_bc_restart=0 - type(FmsTime_type) :: Time_restart, Time_restart_current, Time_start - character(len=32) :: timestamp + integer, public :: num_ice_bc_restart=0, num_ocn_bc_restart=0 + type(FmsTime_type), public :: Time_restart, Time_restart_current, Time_start + character(len=32), public :: timestamp ! ----- coupled model initial date ----- @@ -136,67 +168,89 @@ module coupler_wrapper_mod !----------------------------------------------------------------------- !------ namelist interface ------- - integer, dimension(6) :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) !< The time interval that write out intermediate restart file. - !! The format is (yr,mo,day,hr,min,sec). When restart_interval - !! is all zero, no intermediate restart file will be written out - integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See - !! force_date_from_namelist.) - character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are - !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. - !! The value 'no_calendar' cannot be used because the time_manager's date - !! functions are used. All values must be lower case. - logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date should override - !! the date in the restart file `INPUT/coupler.res`. If the restart file does not - !! exist then force_date_from_namelist has no effect, the value of current_date - !! will be used. + !> The time interval that write out intermediate restart file. + !! The format is (yr,mo,day,hr,min,sec). When restart_interval + !! is all zero, no intermediate restart file will be written out + integer, dimension(6), public :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) + + !> The date that the current integration starts with. (See + !! force_date_from_namelist.) + integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) + + !< The calendar type used by the current integration. Valid values are + !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. + !! The value 'no_calendar' cannot be used because the time_manager's date + !! functions are used. All values must be lower case. + character(len=17) :: calendar = ' ' + + !> Flag that determines whether the namelist variable current_date should override + !! the date in the restart file `INPUT/coupler.res`. If the restart file does not + !! exist then force_date_from_namelist has no effect, the value of current_date + !! will be used. + logical :: force_date_from_namelist = .false. + integer :: months=0 !< Number of months the current integration will be run integer :: days=0 !< Number of days the current integration will be run integer :: hours=0 !< Number of hours the current integration will be run integer :: minutes=0 !< Number of minutes the current integration will be run integer :: seconds=0 !< Number of seconds the current integration will be run - integer :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fat coupling with land and sea ice - integer :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must be an - !! integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. - integer :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere - integer :: ocean_npes=0 !< The number of MPI tasks to use for the ocean - integer :: ice_npes=0 !< The number of MPI tasks to use for the ice - integer :: land_npes=0 !< The number of MPI tasks to use for the land - integer :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere - integer :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean - integer :: radiation_nthreads=1 !< Number of threads to use for the radiation. - logical :: do_atmos =.true. !< Indicates if this component should be executed. If .FALSE., then execution is skipped. - !! This is used when ALL the output fields sent by this component to the coupler have been - !! overridden using the data_override feature. This is for advanced users only. - logical :: do_land =.true. !< See do_atmos - logical :: do_ice =.true. !< See do_atmos - logical :: do_ocean=.true. !< See do_atmos - logical :: do_flux =.true. !< See do_atmos - logical :: concurrent=.FALSE. !< If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate - !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. - !! If .FALSE., the execution is serial: call atmos... followed by call ocean... - logical :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently - logical :: use_lag_fluxes=.TRUE. !< If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. - !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog - !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable - !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there - !! is probably sufficient damping for MOM4. For more modern ocean models (such as - !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. - !! should be much more stable. - logical :: concurrent_ice=.FALSE. !< If .TRUE., the slow sea-ice is forced with the fluxes that were used for the - !! fast ice processes one timestep before. When used in conjuction with setting - !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and - !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can - !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. - logical :: slow_ice_with_ocean=.FALSE. !< If true, the slow sea-ice is advanced on the ocean processors. Otherwise - !! the slow sea-ice processes are on the same PEs as the fast sea-ice. - logical :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance - !! both the slow sea-ice and the ocean. slow_ice_with_ocean and - !! concurrent_ice must both be true if combined_ice_and_ocean is true. - logical :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. - logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. - logical :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. - integer :: check_stocks = 0 ! -1: never 0: at end of run only n>0: every n coupled steps - logical :: use_hyper_thread = .false. + integer, public :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fast + !! coupling with land and sea ice + integer, public :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must + !! be an integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. + integer, public :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere + integer, public :: ocean_npes=0 !< The number of MPI tasks to use for the ocean + integer, public :: ice_npes=0 !< The number of MPI tasks to use for the ice + integer, public :: land_npes=0 !< The number of MPI tasks to use for the land + integer, public :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere + integer, public :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean + integer, public :: radiation_nthreads=1 !< Number of threads to use for the radiation. + + !> Indicates if this component should be executed. If .FALSE., then execution is skipped. + !! This is used when ALL the output fields sent by this component to the coupler have been + !! overridden using the data_override feature. This is for advanced users only. + logical, public :: do_atmos =.true. + logical, public :: do_land =.true. !< See do_atmos + logical, public :: do_ice =.true. !< See do_atmos + logical, public :: do_ocean=.true. !< See do_atmos + logical, public :: do_flux =.true. !< See do_atmos + + !> If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate + !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. + !! If .FALSE., the execution is serial: call atmos... followed by call ocean... + logical, public :: concurrent=.FALSE. + logical, public :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently + + !> If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. + !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog + !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable + !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there + !! is probably sufficient damping for MOM4. For more modern ocean models (such as + !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. + !! should be much more stable. + logical, public :: use_lag_fluxes=.TRUE. + + !> If .TRUE., the slow sea-ice is forced with the fluxes that were used for the + !! fast ice processes one timestep before. When used in conjuction with setting + !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and + !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can + !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. + logical, public :: concurrent_ice=.FALSE. + + !> If true, the slow sea-ice is advanced on the ocean processors. Otherwise + !! the slow sea-ice processes are on the same PEs as the fast sea-ice. + logical, public :: slow_ice_with_ocean=.FALSE. + + !< If true, there is a single call from the coupler to advance + !! both the slow sea-ice and the ocean. slow_ice_with_ocean and + !! concurrent_ice must both be true if combined_ice_and_ocean is true. + logical, public :: combined_ice_and_ocean=.FALSE. + + logical, public :: do_chksum=.FALSE. !< If .TRUE., do multiple checksums throughout the execution of the model + logical, public :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. + logical, public :: do_debug=.FALSE.!< If .TRUE. print additional debugging messages. + integer, public :: check_stocks = 0 !< -1: never 0: at end of run only n>0: every n coupled steps + logical, public :: use_hyper_thread = .false. namelist /coupler_nml/ current_date, calendar, force_date_from_namelist, & months, days, hours, minutes, seconds, dt_cpld, dt_atmos, & @@ -208,26 +262,26 @@ module coupler_wrapper_mod use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean - integer :: initClock, mainClock, termClock + integer, public :: initClock, mainClock, termClock - integer :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 - integer :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e - integer :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka - integer :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki - integer :: newClockj, newClockk, newClockl + integer, public :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 + integer, public :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e + integer, public :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka + integer, public :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki + integer, public :: newClockj, newClockk, newClockl - integer :: id_atmos_model_init, id_land_model_init, id_ice_model_init - integer :: id_ocean_model_init, id_flux_exchange_init + integer, public :: id_atmos_model_init, id_land_model_init, id_ice_model_init + integer, public :: id_ocean_model_init, id_flux_exchange_init character(len=80) :: text character(len=48), parameter :: mod_name = 'coupler_main_mod' - integer :: outunit + integer, public :: outunit integer :: ensemble_id = 1 - integer, allocatable :: ensemble_pelist(:, :) - integer, allocatable :: slow_ice_ocean_pelist(:) - integer :: conc_nthreads = 1 - real :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 + integer, allocatable, public :: ensemble_pelist(:, :) + integer, allocatable, public :: slow_ice_ocean_pelist(:) + integer, public :: conc_nthreads = 1 + real, public :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 contains From ac25fd8eafe6cb867ba1734ec78634ed33da0dab Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 8 Mar 2024 09:36:02 -0500 Subject: [PATCH 19/78] fix end module --- full/full_coupler_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 6e0338f8..31e6d910 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1475,4 +1475,4 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum -end module coupler_wrapper_mod +end module full_coupler_mod From cb0b7cf3aa126f2daee741da9ca43f0a2b4200fd Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 8 Mar 2024 09:49:53 -0500 Subject: [PATCH 20/78] fix spacing --- full/full_coupler_mod.F90 | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 31e6d910..9bfa8a52 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -19,6 +19,7 @@ !*********************************************************************** module full_coupler_mod + use omp_lib !< F90 module for OpenMP use FMS !, status_fms=>status use FMSconstants, only: fmsconstants_init @@ -88,7 +89,7 @@ module full_coupler_mod implicit none private - public :: FMS, fmsconstants_init + public :: FMS, fmsconstants_init public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up public :: update_atmos_model_radiation, update_atmos_model_state public :: update_land_model_fast, update_land_model_slow @@ -121,8 +122,8 @@ module full_coupler_mod !----------------------------------------------------------------------- - character(len=128) :: version = '$Id$' - character(len=128) :: tag = '$Name$' + character(len=128), public :: version = '$Id$' + character(len=128), public :: tag = '$Name$' !----------------------------------------------------------------------- !---- model defined-types ---- @@ -134,21 +135,21 @@ module full_coupler_mod type (ocean_public_type), target, public :: Ocean type (ocean_state_type), pointer, public :: Ocean_state => NULL() - type(atmos_land_boundary_type), public :: Atmos_land_boundary - type(atmos_ice_boundary_type), public :: Atmos_ice_boundary + type(atmos_land_boundary_type), public :: Atmos_land_boundary + type(atmos_ice_boundary_type), public :: Atmos_ice_boundary type(land_ice_atmos_boundary_type), public :: Land_ice_atmos_boundary - type(land_ice_boundary_type), public :: Land_ice_boundary - type(ice_ocean_boundary_type), public :: Ice_ocean_boundary - type(ocean_ice_boundary_type), public :: Ocean_ice_boundary + type(land_ice_boundary_type), public :: Land_ice_boundary + type(ice_ocean_boundary_type), public :: Ice_ocean_boundary + type(ocean_ice_boundary_type), public :: Ocean_ice_boundary type(ice_ocean_driver_type), pointer, public :: ice_ocean_driver_CS => NULL() !----------------------------------------------------------------------- ! ----- coupled model time ----- - type (FmsTime_type), public :: Time, Time_init, Time_end - type(FmsTime_type), public :: Time_step_atmos, Time_step_cpld - type(FmsTime_type), public :: Time_atmos, Time_ocean - type(FmsTime_type), public :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice + type(FmsTime_type), public :: Time, Time_init, Time_end + type(FmsTime_type), public :: Time_step_atmos, Time_step_cpld + type(FmsTime_type), public :: Time_atmos, Time_ocean + type(FmsTime_type), public :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice integer, public :: num_atmos_calls, na integer, public :: num_cpld_calls, nc From 5a3187a739ce235cede663e43faca6c710cdb71d Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 8 Mar 2024 10:30:17 -0500 Subject: [PATCH 21/78] make text public --- full/full_coupler_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 9bfa8a52..3fbe88d5 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -274,7 +274,7 @@ module full_coupler_mod integer, public :: id_atmos_model_init, id_land_model_init, id_ice_model_init integer, public :: id_ocean_model_init, id_flux_exchange_init - character(len=80) :: text + character(len=80), public :: text character(len=48), parameter :: mod_name = 'coupler_main_mod' integer, public :: outunit From 1bb5298694af4fda6d60d33c1019331264bbf2c3 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 8 Mar 2024 10:54:55 -0500 Subject: [PATCH 22/78] add ocean_chksum to public --- full/full_coupler_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 3fbe88d5..826ea1e3 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -20,6 +20,7 @@ module full_coupler_mod use omp_lib !< F90 module for OpenMP + use FMS !, status_fms=>status use FMSconstants, only: fmsconstants_init @@ -118,7 +119,7 @@ module full_coupler_mod public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum public :: coupler_init, coupler_end, coupler_restart - public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum + public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum !----------------------------------------------------------------------- From cdd38b140ce483eeba0334a99ba19ada5fedaf34 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 8 Mar 2024 11:12:55 -0500 Subject: [PATCH 23/78] use fms in coupler_main --- full/coupler_main.F90 | 1 + full/full_coupler_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 8045eec7..aeeed69a 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -333,6 +333,7 @@ program coupler_main !--- F90 module for OpenMP use omp_lib + use FMS use full_coupler_mod call fms_mpp_init() diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 826ea1e3..dad8661a 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -90,7 +90,7 @@ module full_coupler_mod implicit none private - public :: FMS, fmsconstants_init + public :: fmsconstants_init public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up public :: update_atmos_model_radiation, update_atmos_model_state public :: update_land_model_fast, update_land_model_slow From 273a7bf806c820d511cdd927efa07455262ef9ec Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 13 Mar 2024 07:03:52 -0400 Subject: [PATCH 24/78] use fms --- full/coupler_main.F90 | 1 + full/full_coupler_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index f9f85247..56a6b050 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -332,6 +332,7 @@ program coupler_main use omp_lib + use FMS use full_coupler_mod call fms_mpp_init() diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 3b0fd691..97531e73 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -90,7 +90,7 @@ module full_coupler_mod implicit none private - public :: FMS, fmsconstants_init + public :: fmsconstants_init public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up public :: update_atmos_model_radiation, update_atmos_model_state public :: update_land_model_fast, update_land_model_slow From 7f5e81f7aab14a060410f498626924c9e70914e8 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 19 Mar 2024 18:16:54 -0400 Subject: [PATCH 25/78] implicit none --- full/coupler_main.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 56a6b050..3544ee01 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -334,6 +334,9 @@ program coupler_main use omp_lib use FMS use full_coupler_mod + + use iso_fortran_env + implicit none call fms_mpp_init() From 06bd2143d98482dc722fefb684af253dc57634d9 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 19 Mar 2024 18:18:07 -0400 Subject: [PATCH 26/78] implicit none --- full/coupler_main.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index b2a0ba7e..e5bb0c60 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -335,6 +335,9 @@ program coupler_main use omp_lib use FMS use full_coupler_mod + + use iso_fortran_env + implicit none call fms_mpp_init() !these clocks are on the global pelist From ba3065f7a1fad924741d54d2b3bde8f892e598cd Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 26 Mar 2024 08:55:24 -0400 Subject: [PATCH 27/78] add fredb_id back --- full/coupler_main.F90 | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index e5bb0c60..51bd64f0 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -338,6 +338,40 @@ program coupler_main use iso_fortran_env implicit none + + + INTEGER :: i, status, arg_count + CHARACTER(len=256) :: executable_name, arg, fredb_id + +#ifdef FREDB_ID +#define xstr(s) str(s) +#define str(s) #s + fredb_id = xstr(FREDB_ID) +#else +#warning "FREDB_ID not defined. Continuing as normal." + fredb_id = 'FREDB_ID was not defined (e.g. -DFREDB_ID=...) during preprocessing' +#endif + + arg_count = command_argument_count() + DO i=0, arg_count + CALL get_command_argument(i, arg, status=status) + if (status .ne. 0) then + write (error_unit,*) 'get_command_argument failed: status = ', status, ' arg = ', i + stop 1 + end if + + if (i .eq. 0) then + executable_name = arg + else if (arg == '--fredb_id') then + write (output_unit,*) TRIM(fredb_id) + stop + end if + END DO + + if (arg_count .ge. 1) then + write (error_unit,*) 'Usage: '//TRIM(executable_name)//' [--fredb_id]' + stop 1 + end if call fms_mpp_init() !these clocks are on the global pelist From 04e06ab2a08527fdfc37b4a396b3b72c1887084b Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 26 Mar 2024 08:58:21 -0400 Subject: [PATCH 28/78] lint? --- full/coupler_main.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 51bd64f0..826e4970 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -351,7 +351,7 @@ program coupler_main #warning "FREDB_ID not defined. Continuing as normal." fredb_id = 'FREDB_ID was not defined (e.g. -DFREDB_ID=...) during preprocessing' #endif - + arg_count = command_argument_count() DO i=0, arg_count CALL get_command_argument(i, arg, status=status) @@ -359,7 +359,7 @@ program coupler_main write (error_unit,*) 'get_command_argument failed: status = ', status, ' arg = ', i stop 1 end if - + if (i .eq. 0) then executable_name = arg else if (arg == '--fredb_id') then @@ -367,12 +367,12 @@ program coupler_main stop end if END DO - + if (arg_count .ge. 1) then write (error_unit,*) 'Usage: '//TRIM(executable_name)//' [--fredb_id]' stop 1 end if - + call fms_mpp_init() !these clocks are on the global pelist initClock = fms_mpp_clock_id( 'Initialization' ) From c51a69af76ad445363a6dbd5e52b1732bccf98ef Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 26 Mar 2024 09:04:05 -0400 Subject: [PATCH 29/78] add fredb_id back --- full/coupler_main.F90 | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 3544ee01..0965d2e2 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -337,7 +337,37 @@ program coupler_main use iso_fortran_env implicit none - + +#ifdef FREDB_ID +#define xstr(s) str(s) +#define str(s) #s + fredb_id = xstr(FREDB_ID) +#else +#warning "FREDB_ID not defined. Continuing as normal." + fredb_id = 'FREDB_ID was not defined (e.g. -DFREDB_ID=...) during preprocessing' +#endif + + arg_count = command_argument_count() + DO i=0, arg_count + CALL get_command_argument(i, arg, status=status) + if (status .ne. 0) then + write (error_unit,*) 'get_command_argument failed: status = ', status, ' arg = ', i + stop 1 + end if + + if (i .eq. 0) then + executable_name = arg + else if (arg == '--fredb_id') then + write (output_unit,*) TRIM(fredb_id) + stop + end if + END DO + + if (arg_count .ge. 1) then + write (error_unit,*) 'Usage: '//TRIM(executable_name)//' [--fredb_id]' + stop 1 + end if + call fms_mpp_init() call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation, & From 9a7d00e0ba34814b821d2eaa4a0a262080a98477 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 26 Mar 2024 09:10:33 -0400 Subject: [PATCH 30/78] forgot variable declarations for fredbid --- full/coupler_main.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 0965d2e2..2de3475e 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -338,6 +338,9 @@ program coupler_main use iso_fortran_env implicit none + INTEGER :: i, status, arg_count + CHARACTER(len=256) :: executable_name, arg, fredb_id + #ifdef FREDB_ID #define xstr(s) str(s) #define str(s) #s From fb6fda0d8d65bef48e5306d1786027833057b95a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 29 Mar 2024 09:19:03 -0400 Subject: [PATCH 31/78] use MACRO for version update --- full/full_coupler_mod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 97531e73..99b8feeb 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -123,8 +123,11 @@ module full_coupler_mod !----------------------------------------------------------------------- - character(len=128), public :: version = '$Id$' - character(len=128), public :: tag = '$Name$' +#ifdef _FILE_VERSION + character(len=*), parameter :: version = _FILE_VERSION +#else + character(len=*), parameter :: version = 'unknown' +#endif !----------------------------------------------------------------------- !---- model defined-types ---- From d6260099b5599aeb95afdef8e6f9e3516b6b687f Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 29 Mar 2024 09:22:11 -0400 Subject: [PATCH 32/78] update macro name --- full/full_coupler_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 99b8feeb..01965317 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -123,8 +123,8 @@ module full_coupler_mod !----------------------------------------------------------------------- -#ifdef _FILE_VERSION - character(len=*), parameter :: version = _FILE_VERSION +#ifdef FULL_COUPLER_VERSION_ + character(len=*), parameter :: version = FULL_COUPLER_VERSION_ #else character(len=*), parameter :: version = 'unknown' #endif From e4440ca242aeb5fca220b9f06e3a399585114d88 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 29 Mar 2024 09:29:28 -0400 Subject: [PATCH 33/78] add tag --- full/full_coupler_mod.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 01965317..611a7a97 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -124,9 +124,15 @@ module full_coupler_mod !----------------------------------------------------------------------- #ifdef FULL_COUPLER_VERSION_ - character(len=*), parameter :: version = FULL_COUPLER_VERSION_ + character(len=*), parameter, public :: version = FULL_COUPLER_VERSION_ #else - character(len=*), parameter :: version = 'unknown' + character(len=*), parameter, public :: version = 'FULL_COUPLER_MOD' +#endif + +#ifdef FULL_COUPLER_TAG_ + character(len=*), parameter, public :: tag = FULL_COUPLER_TAG_ +#else + character(len=*), parameter, public :: tag = 'unknown' #endif !----------------------------------------------------------------------- From fe17c6b7b5ec83cedb097f2ff4decc9d48f9400b Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 29 Mar 2024 09:52:29 -0400 Subject: [PATCH 34/78] add quotes --- full/full_coupler_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 611a7a97..450dd912 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -124,13 +124,13 @@ module full_coupler_mod !----------------------------------------------------------------------- #ifdef FULL_COUPLER_VERSION_ - character(len=*), parameter, public :: version = FULL_COUPLER_VERSION_ + character(len=*), parameter, public :: version = 'FULL_COUPLER_VERSION_' #else character(len=*), parameter, public :: version = 'FULL_COUPLER_MOD' #endif #ifdef FULL_COUPLER_TAG_ - character(len=*), parameter, public :: tag = FULL_COUPLER_TAG_ + character(len=*), parameter, public :: tag = 'FULL_COUPLER_TAG_' #else character(len=*), parameter, public :: tag = 'unknown' #endif From a42f4f930b5dc231bf5ad377d8ce3562dc182ad4 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 29 Mar 2024 10:12:00 -0400 Subject: [PATCH 35/78] remove quoets --- full/full_coupler_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 450dd912..611a7a97 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -124,13 +124,13 @@ module full_coupler_mod !----------------------------------------------------------------------- #ifdef FULL_COUPLER_VERSION_ - character(len=*), parameter, public :: version = 'FULL_COUPLER_VERSION_' + character(len=*), parameter, public :: version = FULL_COUPLER_VERSION_ #else character(len=*), parameter, public :: version = 'FULL_COUPLER_MOD' #endif #ifdef FULL_COUPLER_TAG_ - character(len=*), parameter, public :: tag = 'FULL_COUPLER_TAG_' + character(len=*), parameter, public :: tag = FULL_COUPLER_TAG_ #else character(len=*), parameter, public :: tag = 'unknown' #endif From 9731db4a3ae09910242100127b81c1e688977a7d Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 11 Apr 2024 08:49:35 -0400 Subject: [PATCH 36/78] file_version.fh --- full/full_coupler_mod.F90 | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 611a7a97..0f8a2097 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -123,17 +123,7 @@ module full_coupler_mod !----------------------------------------------------------------------- -#ifdef FULL_COUPLER_VERSION_ - character(len=*), parameter, public :: version = FULL_COUPLER_VERSION_ -#else - character(len=*), parameter, public :: version = 'FULL_COUPLER_MOD' -#endif - -#ifdef FULL_COUPLER_TAG_ - character(len=*), parameter, public :: tag = FULL_COUPLER_TAG_ -#else - character(len=*), parameter, public :: tag = 'unknown' -#endif +#include !----------------------------------------------------------------------- !---- model defined-types ---- @@ -374,7 +364,7 @@ subroutine coupler_init endif !----- write version to logfile ------- - call fms_write_version_number(version, tag) + call fms_write_version_number('FULL_COUPLER_MOD', version) !----- read namelist ------- From c5c9e2ff367ed8002929b3141e21c3321d5c322d Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 11 Apr 2024 09:26:43 -0400 Subject: [PATCH 37/78] add untracked file --- full/file_version.fh | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 full/file_version.fh diff --git a/full/file_version.fh b/full/file_version.fh new file mode 100644 index 00000000..f613f764 --- /dev/null +++ b/full/file_version.fh @@ -0,0 +1,25 @@ +! -*-f90-*- +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +#ifdef _FILE_VERSION + character(len=*), parameter :: version = _FILE_VERSION +#else + character(len=*), parameter :: version = 'unknown' +#endif \ No newline at end of file From af3039e1bed7c62c220689d0398aac09222603af Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 16 Apr 2024 11:59:56 -0400 Subject: [PATCH 38/78] add _in to clock subroutine args --- full/full_coupler_mod.F90 | 184 +++++++++++++++++++------------------- 1 file changed, 94 insertions(+), 90 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 97531e73..936b5f56 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -20,7 +20,7 @@ module full_coupler_mod use omp_lib !< F90 module for OpenMP - + use FMS !, status_fms=>status use FMSconstants, only: fmsconstants_init @@ -89,7 +89,7 @@ module full_coupler_mod implicit none private - + public :: fmsconstants_init public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up public :: update_atmos_model_radiation, update_atmos_model_state @@ -972,7 +972,7 @@ subroutine coupler_init call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & do_concurrent_radiation, clock_type='init_coupler_clocks') - + !--------------------------------------------- if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) @@ -1465,113 +1465,117 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation, clock_type) - - type(full_coupler_clock_type), intent(inout) :: full_coupler_clocks - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice - type(ocean_public_type), intent(in) :: Ocean - logical, intent(in) :: do_concurrent_radiation - character(len=*), intent(in) :: clock_type - - if( trim(clock_type) == 'coupler_initialization_clock' ) then - full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) - - else if( trim(clock_type) == 'init_model_clocks' ) then + subroutine full_coupler_set_clock_ids(full_coupler_clocks_in, Atm_in, Land_in, Ice_in, Ocean_in, & + slow_ice_ocean_pelist_in, ensemble_pelist_in, ensemble_id, & + do_concurrent_radiation_in, clock_type_in) + + type(full_coupler_clock_type), intent(inout) :: full_coupler_clocks_in + type(atmos_data_type), intent(in) :: Atm_in + type(land_data_type), intent(in) :: Land_in + type(ice_data_type), intent(in) :: Ice_in + type(ocean_public_type), intent(in) :: Ocean_in + integer, intent(in), dimension(:) :: slow_ice_ocean_pelist + integer, intent(in), dimension(:,:) :: ensemble_pelist_in + integer, intent(in) :: ensemble_id + logical, intent(in) :: do_concurrent_radiation_in + character(len=*), intent(in) :: clock_type_in + + if( trim(clock_type_in) == 'coupler_initialization_clock' ) then + full_coupler_clocks_in%initialization = fms_mpp_clock_id( 'Initialization' ) + + else if( trim(clock_type_in) == 'init_model_clocks' ) then !> initialization clock - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - full_coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + if (Atm_in%pe) then + call fms_mpp_set_current_pelist(Atm_in%pelist) + full_coupler_clocks_in%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - full_coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + if (Land_in%pe) then + call fms_mpp_set_current_pelist(Land_in%pelist) + full_coupler_clocks_in%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) endif - if (Ice%pe) then - if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) - elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) + if (Ice_in%pe) then + if (Ice_in%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice_in%pelist) + elseif (Ice_in%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice_in%fast_pelist) + elseif (Ice_in%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice_in%slow_pelist) else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") endif - full_coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + full_coupler_clocks_in%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - full_coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + if (Ocean_in%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean_in%pelist) + full_coupler_clocks_in%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - full_coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) - + call fms_mpp_set_current_pelist(ensemble_pelist_in(ensemble_id,:)) + full_coupler_clocks_in%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + call fms_mpp_set_current_pelist() - full_coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) - full_coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + full_coupler_clocks_in%main = fms_mpp_clock_id( 'Main loop' ) + full_coupler_clocks_in%termination = fms_mpp_clock_id( 'Termination' ) - else if( trim(clock_type) == 'init_coupler_clocks' ) then - If(Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - full_coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) + else if( trim(clock_type_in) == 'init_coupler_clocks' ) then + If(Atm_in%pe) then + call fms_mpp_set_current_pelist(Atm_in%pelist) + full_coupler_clocks_in%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) end if - if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - full_coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) - full_coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) + if (Ice_in%slow_ice_PE .or. Ocean_in%is_ocean_pe) then + call fms_mpp_set_current_pelist(slow_ice_ocean_pelist_in) + full_coupler_clocks_in%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) + full_coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - full_coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) - full_coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) - full_coupler_clocks%atmos_tracer_driver_gather_data & - = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) - full_coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) - full_coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') - if (.not. do_concurrent_radiation) then - full_coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) - endif - full_coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) - full_coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) - full_coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) - full_coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) - full_coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) - full_coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) - if (do_concurrent_radiation) then - full_coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) - full_coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) + if (Atm_in%pe) then + call fms_mpp_set_current_pelist(Atm_in%pelist) + full_coupler_clocks_in%atm = fms_mpp_clock_id( 'ATM' ) + full_coupler_clocks_in%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) + full_coupler_clocks_in%atmos_tracer_driver_gather_data & + = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) + full_coupler_clocks_in%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) + full_coupler_clocks_in%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') + if (.not. do_concurrent_radiation_in) & + full_coupler_clocks_in%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + full_coupler_clocks_in%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) + full_coupler_clocks_in%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) + full_coupler_clocks_in%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) + full_coupler_clocks_in%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) + full_coupler_clocks_in%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) + full_coupler_clocks_in%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) + if (do_concurrent_radiation_in) then + full_coupler_clocks_in%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + full_coupler_clocks_in%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) endif - full_coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') - full_coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) - full_coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) + full_coupler_clocks_in%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') + full_coupler_clocks_in%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) + full_coupler_clocks_in%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) endif - if (Ice%pe) then - if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) - full_coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) - full_coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) - - if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) - full_coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) - full_coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) - full_coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) - - call fms_mpp_set_current_pelist(Ice%pelist) - full_coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) - full_coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) - + if (Ice_in%pe) then + if (Ice_in%fast_ice_pe) call fms_mpp_set_current_pelist(Ice_in%fast_pelist) + full_coupler_clocks_in%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) + full_coupler_clocks_in%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) + + if (Ice_in%slow_ice_pe) call fms_mpp_set_current_pelist(Ice_in%slow_pelist) + full_coupler_clocks_in%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) + full_coupler_clocks_in%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) + full_coupler_clocks_in%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) + + call fms_mpp_set_current_pelist(Ice_in%pelist) + full_coupler_clocks_in%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) + full_coupler_clocks_in%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) + endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - full_coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) + if (Ocean_in%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean_in%pelist) + full_coupler_clocks_in%ocean = fms_mpp_clock_id( 'OCN' ) endif - + call fms_mpp_set_current_pelist() - full_coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) - full_coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) - full_coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) + full_coupler_clocks_in%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) + full_coupler_clocks_in%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) + full_coupler_clocks_in%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) else call fms_mpp_error(FATAL, 'clock_type not recognized when full_coupler_set_clock_ids') end if - + end subroutine full_coupler_set_clock_ids - + end module full_coupler_mod From 8cf0e7963d9478c456c186be41a1db7c302a5fc4 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 16 Apr 2024 12:55:07 -0400 Subject: [PATCH 39/78] more fixes --- full/coupler_main.F90 | 9 ++++----- full/full_coupler_mod.F90 | 19 +++++++++---------- 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 2de3475e..bde8e539 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -71,7 +71,7 @@ !! The three components of coupler: @ref coupler_main , flux_exchange_mod, and surface_flux_mod !! are configured through three namelists !! * \ref coupler_config "coupler_nml" -!! * \ref flux_exchange_conf "flux_exchange_nml" +!! * \ref flux_exchange_conf "flux_exchange_nml" !! * \ref surface_flux_config "surface_flux_nml" !! !! @@ -373,17 +373,16 @@ program coupler_main call fms_mpp_init() - call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, do_concurrent_radiation, & - clock_type='coupler_initialization_clock') + full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) call fms_mpp_clock_begin(full_coupler_clocks%initialization) - + call fms_init call fmsconstants_init call fms_affinity_init call coupler_init if (do_chksum) call coupler_chksum('coupler_init+', 0) - + call fms_mpp_set_current_pelist() call fms_mpp_clock_end(full_coupler_clocks%initialization) !end initialization diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 936b5f56..145a2017 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -372,7 +372,7 @@ subroutine coupler_init read (fms_mpp_input_nml_file, coupler_nml, iostat=io) ierr = check_nml_error (io, 'coupler_nml') -!----- read date and calendar type from restart file ----- + !----- read date and calendar type from restart file ----- if (fms2_io_file_exists('INPUT/coupler.res')) then call fms2_io_ascii_read('INPUT/coupler.res', restart_file) read(restart_file(1), *) calendar_type @@ -593,6 +593,7 @@ subroutine coupler_init !> The pelists need to be set before initializing the clocks call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & + slow_ice_ocean_pelist, ensemble_pelist, ensemble_id, & do_concurrent_radiation, clock_type='init_model_clocks') !Write out messages on root PEs @@ -971,6 +972,7 @@ subroutine coupler_init endif ! end of Ocean%is_ocean_pe call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & + slow_ice_ocean_pelist, ensemble_pelist,ensemble_id, & do_concurrent_radiation, clock_type='init_coupler_clocks') !--------------------------------------------- @@ -1467,23 +1469,20 @@ end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main subroutine full_coupler_set_clock_ids(full_coupler_clocks_in, Atm_in, Land_in, Ice_in, Ocean_in, & slow_ice_ocean_pelist_in, ensemble_pelist_in, ensemble_id, & - do_concurrent_radiation_in, clock_type_in) + do_concurrent_radiation_in, clock_type) type(full_coupler_clock_type), intent(inout) :: full_coupler_clocks_in type(atmos_data_type), intent(in) :: Atm_in type(land_data_type), intent(in) :: Land_in type(ice_data_type), intent(in) :: Ice_in type(ocean_public_type), intent(in) :: Ocean_in - integer, intent(in), dimension(:) :: slow_ice_ocean_pelist + integer, intent(in), dimension(:) :: slow_ice_ocean_pelist_in integer, intent(in), dimension(:,:) :: ensemble_pelist_in integer, intent(in) :: ensemble_id logical, intent(in) :: do_concurrent_radiation_in - character(len=*), intent(in) :: clock_type_in + character(len=*), intent(in) :: clock_type - if( trim(clock_type_in) == 'coupler_initialization_clock' ) then - full_coupler_clocks_in%initialization = fms_mpp_clock_id( 'Initialization' ) - - else if( trim(clock_type_in) == 'init_model_clocks' ) then + if( trim(clock_type) == 'init_model_clocks' ) then !> initialization clock if (Atm_in%pe) then call fms_mpp_set_current_pelist(Atm_in%pelist) @@ -1512,7 +1511,7 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks_in, Atm_in, Land_in, I full_coupler_clocks_in%main = fms_mpp_clock_id( 'Main loop' ) full_coupler_clocks_in%termination = fms_mpp_clock_id( 'Termination' ) - else if( trim(clock_type_in) == 'init_coupler_clocks' ) then + else if( trim(clock_type) == 'init_coupler_clocks' ) then If(Atm_in%pe) then call fms_mpp_set_current_pelist(Atm_in%pelist) full_coupler_clocks_in%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) @@ -1572,7 +1571,7 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks_in, Atm_in, Land_in, I full_coupler_clocks_in%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) else - call fms_mpp_error(FATAL, 'clock_type not recognized when full_coupler_set_clock_ids') + call fms_mpp_error(FATAL, 'clock_type not recognized in full_coupler_set_clock_ids') end if From 46787c742d431c765aa283784be3bf85bea4f176 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 17 Apr 2024 09:30:29 -0400 Subject: [PATCH 40/78] fix typo --- full/full_coupler_mod.F90 | 120 +++++++++++++++++++------------------- 1 file changed, 60 insertions(+), 60 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 145a2017..d20590ac 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -119,7 +119,7 @@ module full_coupler_mod public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum public :: coupler_init, coupler_end, coupler_restart - public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, full_coupler_set_clock_ids + public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, coupler_set_clock_ids !----------------------------------------------------------------------- @@ -285,7 +285,7 @@ module full_coupler_mod integer :: flux_exchange_init end type full_coupler_clock_type - type(full_coupler_clock_type), public :: full_coupler_clocks + type(full_coupler_clock_type), public :: coupler_clocks character(len=80), public :: text character(len=48), parameter :: mod_name = 'full_coupler_mod' @@ -592,9 +592,9 @@ subroutine coupler_init endif !> The pelists need to be set before initializing the clocks - call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & - slow_ice_ocean_pelist, ensemble_pelist, ensemble_id, & - do_concurrent_radiation, clock_type='init_model_clocks') + call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, & + slow_ice_ocean_pelist, ensemble_pelist, ensemble_id, & + do_concurrent_radiation, clock_type='init_model_clocks') !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -850,12 +850,12 @@ subroutine coupler_init //trim(walldate)//' '//trim(walltime) endif - call fms_mpp_clock_begin(full_coupler_clocks%atmos_model_init) + call fms_mpp_clock_begin(coupler_clocks%atmos_model_init) call atmos_model_init( Atm, Time_init, Time, Time_step_atmos, & do_concurrent_radiation) - call fms_mpp_clock_end(full_coupler_clocks%atmos_model_init) + call fms_mpp_clock_end(coupler_clocks%atmos_model_init) if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) @@ -873,10 +873,10 @@ subroutine coupler_init write(errunit,*) 'Starting to initialize land model at '& //trim(walldate)//' '//trim(walltime) endif - call fms_mpp_clock_begin(full_coupler_clocks%land_model_init) + call fms_mpp_clock_begin(coupler_clocks%land_model_init) call land_model_init( Atmos_land_boundary, Land, Time_init, Time, & Time_step_atmos, Time_step_cpld ) - call fms_mpp_clock_end(full_coupler_clocks%land_model_init) + call fms_mpp_clock_end(coupler_clocks%land_model_init) if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) write(errunit,*) 'Finished initializing land model at '& @@ -902,12 +902,12 @@ subroutine coupler_init write(errunit,*) 'Starting to initialize ice model at '& //trim(walldate)//' '//trim(walltime) endif - call fms_mpp_clock_begin(full_coupler_clocks%ice_model_init) + call fms_mpp_clock_begin(coupler_clocks%ice_model_init) call ice_model_init(Ice, Time_init, Time, Time_step_atmos, & Time_step_cpld, Verona_coupler=.false., & concurrent_ice=concurrent_ice, & gas_fluxes=gas_fluxes, gas_fields_ocn=gas_fields_ocn ) - call fms_mpp_clock_end(full_coupler_clocks%ice_model_init) + call fms_mpp_clock_end(coupler_clocks%ice_model_init) ! This must be called using the union of the ice PE_lists. call fms_mpp_set_current_pelist(Ice%pelist) @@ -933,10 +933,10 @@ subroutine coupler_init write(errunit,*) 'Starting to initialize ocean model at '& //trim(walldate)//' '//trim(walltime) endif - call fms_mpp_clock_begin(full_coupler_clocks%ocean_model_init) + call fms_mpp_clock_begin(coupler_clocks%ocean_model_init) call ocean_model_init( Ocean, Ocean_state, Time_init, Time, & gas_fields_ocn=gas_fields_ocn ) - call fms_mpp_clock_end(full_coupler_clocks%ocean_model_init) + call fms_mpp_clock_end(coupler_clocks%ocean_model_init) if (concurrent) then call fms_mpp_set_current_pelist( Ocean%pelist ) @@ -971,9 +971,9 @@ subroutine coupler_init endif ! end of Ocean%is_ocean_pe - call full_coupler_set_clock_ids(full_coupler_clocks, Atm, Land, Ice, Ocean, & - slow_ice_ocean_pelist, ensemble_pelist,ensemble_id, & - do_concurrent_radiation, clock_type='init_coupler_clocks') + call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, & + slow_ice_ocean_pelist, ensemble_pelist, ensemble_id, & + do_concurrent_radiation, clock_type='init_coupler_clocks') !--------------------------------------------- if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -993,13 +993,13 @@ subroutine coupler_init write(errunit,*) 'Starting to initialize flux_exchange at '& //trim(walldate)//' '//trim(walltime) endif - call fms_mpp_clock_begin(full_coupler_clocks%flux_exchange_init) + call fms_mpp_clock_begin(coupler_clocks%flux_exchange_init) call flux_exchange_init ( Time, Atm, Land, Ice, Ocean, Ocean_state,& atmos_ice_boundary, land_ice_atmos_boundary, & land_ice_boundary, ice_ocean_boundary, ocean_ice_boundary, & do_ocean, slow_ice_ocean_pelist, dt_atmos=dt_atmos, dt_cpld=dt_cpld) call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - call fms_mpp_clock_end(full_coupler_clocks%flux_exchange_init) + call fms_mpp_clock_end(coupler_clocks%flux_exchange_init) call fms_mpp_set_current_pelist() if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) @@ -1467,11 +1467,11 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine full_coupler_set_clock_ids(full_coupler_clocks_in, Atm_in, Land_in, Ice_in, Ocean_in, & + subroutine coupler_set_clock_ids(coupler_clocks_in, Atm_in, Land_in, Ice_in, Ocean_in, & slow_ice_ocean_pelist_in, ensemble_pelist_in, ensemble_id, & do_concurrent_radiation_in, clock_type) - type(full_coupler_clock_type), intent(inout) :: full_coupler_clocks_in + type(full_coupler_clock_type), intent(inout) :: coupler_clocks_in type(atmos_data_type), intent(in) :: Atm_in type(land_data_type), intent(in) :: Land_in type(ice_data_type), intent(in) :: Ice_in @@ -1486,11 +1486,11 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks_in, Atm_in, Land_in, I !> initialization clock if (Atm_in%pe) then call fms_mpp_set_current_pelist(Atm_in%pelist) - full_coupler_clocks_in%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + coupler_clocks_in%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) endif if (Land_in%pe) then call fms_mpp_set_current_pelist(Land_in%pelist) - full_coupler_clocks_in%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + coupler_clocks_in%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) endif if (Ice_in%pe) then if (Ice_in%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice_in%pelist) @@ -1498,83 +1498,83 @@ subroutine full_coupler_set_clock_ids(full_coupler_clocks_in, Atm_in, Land_in, I elseif (Ice_in%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice_in%slow_pelist) else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") endif - full_coupler_clocks_in%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + coupler_clocks_in%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) endif if (Ocean_in%is_ocean_pe) then call fms_mpp_set_current_pelist(Ocean_in%pelist) - full_coupler_clocks_in%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + coupler_clocks_in%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) endif call fms_mpp_set_current_pelist(ensemble_pelist_in(ensemble_id,:)) - full_coupler_clocks_in%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + coupler_clocks_in%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) call fms_mpp_set_current_pelist() - full_coupler_clocks_in%main = fms_mpp_clock_id( 'Main loop' ) - full_coupler_clocks_in%termination = fms_mpp_clock_id( 'Termination' ) + coupler_clocks_in%main = fms_mpp_clock_id( 'Main loop' ) + coupler_clocks_in%termination = fms_mpp_clock_id( 'Termination' ) else if( trim(clock_type) == 'init_coupler_clocks' ) then If(Atm_in%pe) then call fms_mpp_set_current_pelist(Atm_in%pelist) - full_coupler_clocks_in%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) + coupler_clocks_in%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) end if if (Ice_in%slow_ice_PE .or. Ocean_in%is_ocean_pe) then call fms_mpp_set_current_pelist(slow_ice_ocean_pelist_in) - full_coupler_clocks_in%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) - full_coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) + coupler_clocks_in%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) + coupler_clocks_in%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) endif if (Atm_in%pe) then call fms_mpp_set_current_pelist(Atm_in%pelist) - full_coupler_clocks_in%atm = fms_mpp_clock_id( 'ATM' ) - full_coupler_clocks_in%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) - full_coupler_clocks_in%atmos_tracer_driver_gather_data & + coupler_clocks_in%atm = fms_mpp_clock_id( 'ATM' ) + coupler_clocks_in%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) + coupler_clocks_in%atmos_tracer_driver_gather_data & = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) - full_coupler_clocks_in%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) - full_coupler_clocks_in%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') + coupler_clocks_in%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) + coupler_clocks_in%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') if (.not. do_concurrent_radiation_in) & - full_coupler_clocks_in%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) - full_coupler_clocks_in%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) - full_coupler_clocks_in%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) - full_coupler_clocks_in%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) - full_coupler_clocks_in%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) - full_coupler_clocks_in%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) - full_coupler_clocks_in%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) + coupler_clocks_in%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + coupler_clocks_in%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) + coupler_clocks_in%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) + coupler_clocks_in%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) + coupler_clocks_in%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) + coupler_clocks_in%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) + coupler_clocks_in%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) if (do_concurrent_radiation_in) then - full_coupler_clocks_in%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) - full_coupler_clocks_in%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) + coupler_clocks_in%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + coupler_clocks_in%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) endif - full_coupler_clocks_in%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') - full_coupler_clocks_in%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) - full_coupler_clocks_in%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) + coupler_clocks_in%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') + coupler_clocks_in%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) + coupler_clocks_in%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) endif if (Ice_in%pe) then if (Ice_in%fast_ice_pe) call fms_mpp_set_current_pelist(Ice_in%fast_pelist) - full_coupler_clocks_in%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) - full_coupler_clocks_in%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) + coupler_clocks_in%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) + coupler_clocks_in%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) if (Ice_in%slow_ice_pe) call fms_mpp_set_current_pelist(Ice_in%slow_pelist) - full_coupler_clocks_in%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) - full_coupler_clocks_in%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) - full_coupler_clocks_in%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) + coupler_clocks_in%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) + coupler_clocks_in%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) + coupler_clocks_in%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) call fms_mpp_set_current_pelist(Ice_in%pelist) - full_coupler_clocks_in%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) - full_coupler_clocks_in%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) + coupler_clocks_in%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) + coupler_clocks_in%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) endif if (Ocean_in%is_ocean_pe) then call fms_mpp_set_current_pelist(Ocean_in%pelist) - full_coupler_clocks_in%ocean = fms_mpp_clock_id( 'OCN' ) + coupler_clocks_in%ocean = fms_mpp_clock_id( 'OCN' ) endif call fms_mpp_set_current_pelist() - full_coupler_clocks_in%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) - full_coupler_clocks_in%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) - full_coupler_clocks_in%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) + coupler_clocks_in%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) + coupler_clocks_in%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) + coupler_clocks_in%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) else - call fms_mpp_error(FATAL, 'clock_type not recognized in full_coupler_set_clock_ids') + call fms_mpp_error(FATAL, 'clock_type not recognized in coupler_set_clock_ids') end if - end subroutine full_coupler_set_clock_ids + end subroutine coupler_set_clock_ids end module full_coupler_mod From 6b0fbd347fec5d8166996ff7ac68935334f8d116 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 17 Apr 2024 09:46:28 -0400 Subject: [PATCH 41/78] oops change full_coupler_clocks to coupler_clocks --- full/coupler_main.F90 | 152 +++++++++++++++++++++--------------------- 1 file changed, 76 insertions(+), 76 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index bde8e539..c53837a2 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -373,8 +373,8 @@ program coupler_main call fms_mpp_init() - full_coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) - call fms_mpp_clock_begin(full_coupler_clocks%initialization) + coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) + call fms_mpp_clock_begin(coupler_clocks%initialization) call fms_init call fmsconstants_init @@ -384,9 +384,9 @@ program coupler_main if (do_chksum) call coupler_chksum('coupler_init+', 0) call fms_mpp_set_current_pelist() - call fms_mpp_clock_end(full_coupler_clocks%initialization) !end initialization + call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization - call fms_mpp_clock_begin(full_coupler_clocks%main) !begin main loop + call fms_mpp_clock_begin(coupler_clocks%main) !begin main loop !----------------------------------------------------------------------- !------ ocean/slow-ice integration loop ------ @@ -420,20 +420,20 @@ program coupler_main if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then ! If the slow ice is on a subset of the ocean PEs, use the ocean PElist. call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - call fms_mpp_clock_begin(full_coupler_clocks%flux_ocean_to_ice) + call fms_mpp_clock_begin(coupler_clocks%flux_ocean_to_ice) !Redistribute quantities from Ocean to Ocean_ice_boundary !Ice intent is In. !Ice is used only for accessing Ice%area and knowing if we are on an Ice pe call flux_ocean_to_ice( Time, Ocean, Ice, Ocean_ice_boundary ) Time_flux_ocean_to_ice = Time - call fms_mpp_clock_end(full_coupler_clocks%flux_ocean_to_ice) + call fms_mpp_clock_end(coupler_clocks%flux_ocean_to_ice) ! Update Ice_ocean_boundary; the first iteration is supplied by restarts if (use_lag_fluxes) then - call fms_mpp_clock_begin(full_coupler_clocks%flux_ice_to_ocean) + call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean) call flux_ice_to_ocean( Time, Ice, Ocean, Ice_ocean_boundary ) Time_flux_ice_to_ocean = Time - call fms_mpp_clock_end(full_coupler_clocks%flux_ice_to_ocean) + call fms_mpp_clock_end(coupler_clocks%flux_ice_to_ocean) endif endif @@ -454,46 +454,46 @@ program coupler_main ! To print the value of frazil heat flux at the right time the following block ! needs to sit here rather than at the end of the coupler loop. if (check_stocks > 0) then - call fms_mpp_clock_begin(full_coupler_clocks%flux_check_stocks) + call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks) if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then call fms_mpp_set_current_pelist() call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) endif - call fms_mpp_clock_end(full_coupler_clocks%flux_check_stocks) + call fms_mpp_clock_end(coupler_clocks%flux_check_stocks) endif if (do_ice .and. Ice%pe) then if (Ice%slow_ice_pe) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call fms_mpp_clock_begin(full_coupler_clocks%set_ice_surface_slow) + call fms_mpp_clock_begin(coupler_clocks%set_ice_surface_slow) ! This may do data override or diagnostics on Ice_ocean_boundary. call flux_ocean_to_ice_finish( Time_flux_ocean_to_ice, Ice, Ocean_Ice_Boundary ) call unpack_ocean_ice_boundary( Ocean_ice_boundary, Ice ) if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, Ice, Ocean_ice_boundary) - call fms_mpp_clock_end(full_coupler_clocks%set_ice_surface_slow) + call fms_mpp_clock_end(coupler_clocks%set_ice_surface_slow) endif ! This could be a point where the model is serialized if the fast and ! slow ice are on different PEs. if (.not.Ice%shared_slow_fast_PEs) call fms_mpp_set_current_pelist(Ice%pelist) - call fms_mpp_clock_begin(full_coupler_clocks%set_ice_surface_exchange) + call fms_mpp_clock_begin(coupler_clocks%set_ice_surface_exchange) call exchange_slow_to_fast_ice(Ice) - call fms_mpp_clock_end(full_coupler_clocks%set_ice_surface_exchange) + call fms_mpp_clock_end(coupler_clocks%set_ice_surface_exchange) if (concurrent_ice) then ! This call occurs all ice PEs. - call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_slow_exchange) + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_slow_exchange) call exchange_fast_to_slow_ice(Ice) - call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_slow_exchange) + call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_exchange) endif if (Ice%fast_ice_pe) then if (.not.Ice%shared_slow_fast_PEs) call fms_mpp_set_current_pelist(Ice%fast_pelist) - call fms_mpp_clock_begin(full_coupler_clocks%set_ice_surface_fast) + call fms_mpp_clock_begin(coupler_clocks%set_ice_surface_fast) call set_ice_surface_fields(Ice) - call fms_mpp_clock_end(full_coupler_clocks%set_ice_surface_fast) + call fms_mpp_clock_end(coupler_clocks%set_ice_surface_fast) endif endif @@ -501,19 +501,19 @@ program coupler_main if (.NOT.(do_ice .and. Ice%pe) .OR. (ice_npes .NE. atmos_npes)) & call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_begin(full_coupler_clocks%atm) + call fms_mpp_clock_begin(coupler_clocks%atm) if (do_chksum) call atmos_ice_land_chksum('set_ice_surface+', nc, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - call fms_mpp_clock_begin(full_coupler_clocks%generate_sfc_xgrid) + call fms_mpp_clock_begin(coupler_clocks%generate_sfc_xgrid) call generate_sfc_xgrid( Land, Ice ) - call fms_mpp_clock_end(full_coupler_clocks%generate_sfc_xgrid) + call fms_mpp_clock_end(coupler_clocks%generate_sfc_xgrid) call send_ice_mask_sic(Time) !----------------------------------------------------------------------- ! ------ atmos/fast-land/fast-ice integration loop ------- - call fms_mpp_clock_begin(full_coupler_clocks%atmos_loop) + call fms_mpp_clock_begin(coupler_clocks%atmos_loop) do na = 1, num_atmos_calls if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) @@ -521,18 +521,18 @@ program coupler_main Time_atmos = Time_atmos + Time_step_atmos if (do_atmos) then - call fms_mpp_clock_begin(full_coupler_clocks%atmos_tracer_driver_gather_data) + call fms_mpp_clock_begin(coupler_clocks%atmos_tracer_driver_gather_data) call atmos_tracer_driver_gather_data(Atm%fields, Atm%tr_bot) - call fms_mpp_clock_end(full_coupler_clocks%atmos_tracer_driver_gather_data) + call fms_mpp_clock_end(coupler_clocks%atmos_tracer_driver_gather_data) endif if (do_flux) then - call fms_mpp_clock_begin(full_coupler_clocks%sfc_boundary_layer) + call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( REAL(dt_atmos), Time_atmos, & Atm, Land, Ice, Land_ice_atmos_boundary ) if (do_chksum) call atmos_ice_land_chksum('sfc+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - call fms_mpp_clock_end(full_coupler_clocks%sfc_boundary_layer) + call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) endif !$OMP PARALLEL & @@ -543,7 +543,7 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(full_coupler_clocks) +!$OMP& SHARED(coupler_clocks) !$ if (omp_get_thread_num() == 0) then !$OMP PARALLEL & !$OMP& NUM_THREADS(1) & @@ -553,17 +553,17 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(full_coupler_clocks) +!$OMP& SHARED(coupler_clocks) !$ call omp_set_num_threads(atmos_nthreads) !$ dsec=omp_get_wtime() - if (do_concurrent_radiation) call fms_mpp_clock_begin(full_coupler_clocks%concurrent_atmos) + if (do_concurrent_radiation) call fms_mpp_clock_begin(coupler_clocks%concurrent_atmos) ! ---- atmosphere dynamics ---- if (do_atmos) then - call fms_mpp_clock_begin(full_coupler_clocks%update_atmos_model_dynamics) + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) call update_atmos_model_dynamics( Atm ) - call fms_mpp_clock_end(full_coupler_clocks%update_atmos_model_dynamics) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', (nc-1)*num_atmos_calls+na, & Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) @@ -571,9 +571,9 @@ program coupler_main ! ---- SERIAL atmosphere radiation ---- if (.not.do_concurrent_radiation) then - call fms_mpp_clock_begin(full_coupler_clocks%concurrent_radiation) + call fms_mpp_clock_begin(coupler_clocks%concurrent_radiation) call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(full_coupler_clocks%concurrent_radiation) + call fms_mpp_clock_end(coupler_clocks%concurrent_radiation) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)', (nc-1)*num_atmos_calls+na, & Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) @@ -581,61 +581,61 @@ program coupler_main ! ---- atmosphere down ---- if (do_atmos) then - call fms_mpp_clock_begin(full_coupler_clocks%update_atmos_model_down) + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_down) call update_atmos_model_down( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(full_coupler_clocks%update_atmos_model_down) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_down) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_down+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update down') - call fms_mpp_clock_begin(full_coupler_clocks%flux_down_from_atmos) + call fms_mpp_clock_begin(coupler_clocks%flux_down_from_atmos) call flux_down_from_atmos( Time_atmos, Atm, Land, Ice, & Land_ice_atmos_boundary, & Atmos_land_boundary, & Atmos_ice_boundary ) - call fms_mpp_clock_end(full_coupler_clocks%flux_down_from_atmos) + call fms_mpp_clock_end(coupler_clocks%flux_down_from_atmos) if (do_chksum) call atmos_ice_land_chksum('flux_down_from_atmos+', (nc-1)*num_atmos_calls+na, Atm, Land, & Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) ! -------------------------------------------------------------- ! ---- land model ---- - call fms_mpp_clock_begin(full_coupler_clocks%update_land_model_fast) + call fms_mpp_clock_begin(coupler_clocks%update_land_model_fast) if (do_land .AND. land%pe) then if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) call update_land_model_fast( Atmos_land_boundary, Land ) endif if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(full_coupler_clocks%update_land_model_fast) + call fms_mpp_clock_end(coupler_clocks%update_land_model_fast) if (do_chksum) call atmos_ice_land_chksum('update_land_fast+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update land') ! ---- ice model ---- - call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_fast) + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_fast) if (do_ice .AND. Ice%fast_ice_pe) then if (ice_npes .NE. atmos_npes)call fms_mpp_set_current_pelist(Ice%fast_pelist) call update_ice_model_fast( Atmos_ice_boundary, Ice ) endif if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_fast) + call fms_mpp_clock_end(coupler_clocks%update_ice_model_fast) if (do_chksum) call atmos_ice_land_chksum('update_ice_fast+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') ! -------------------------------------------------------------- ! ---- atmosphere up ---- - call fms_mpp_clock_begin(full_coupler_clocks%flux_up_to_atmos) + call fms_mpp_clock_begin(coupler_clocks%flux_up_to_atmos) call flux_up_to_atmos( Time_atmos, Land, Ice, Land_ice_atmos_boundary, & Atmos_land_boundary, Atmos_ice_boundary ) - call fms_mpp_clock_end(full_coupler_clocks%flux_up_to_atmos) + call fms_mpp_clock_end(coupler_clocks%flux_up_to_atmos) if (do_chksum) call atmos_ice_land_chksum('flux_up2atmos+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - call fms_mpp_clock_begin(full_coupler_clocks%update_atmos_model_up) + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_up) if (do_atmos) & call update_atmos_model_up( Land_ice_atmos_boundary, Atm) - call fms_mpp_clock_end(full_coupler_clocks%update_atmos_model_up) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_up) if (do_chksum) call atmos_ice_land_chksum('update_atmos_up+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update up') @@ -645,7 +645,7 @@ program coupler_main call flux_ex_arrays_dealloc !-------------- - if (do_concurrent_radiation) call fms_mpp_clock_end(full_coupler_clocks%concurrent_atmos) + if (do_concurrent_radiation) call fms_mpp_clock_end(coupler_clocks%concurrent_atmos) !$ omp_sec(1) = omp_sec(1) + (omp_get_wtime() - dsec) !$OMP END PARALLEL !$ endif @@ -658,13 +658,13 @@ program coupler_main !$OMP& PRIVATE(dsec) & !$OMP& SHARED(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Ocean_ice_boundary, Atmos_land_boundary) & !$OMP& SHARED(do_chksum, do_debug, omp_sec, num_atmos_calls, na, radiation_nthreads) & -!$OMP& SHARED(full_coupler_clocks) +!$OMP& SHARED(coupler_clocks) !$ call omp_set_num_threads(radiation_nthreads) !$ dsec=omp_get_wtime() - call fms_mpp_clock_begin(full_coupler_clocks%concurrent_radiation) + call fms_mpp_clock_begin(coupler_clocks%concurrent_radiation) call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(full_coupler_clocks%concurrent_radiation) + call fms_mpp_clock_end(coupler_clocks%concurrent_radiation) !$ omp_sec(2) = omp_sec(2) + (omp_get_wtime() - dsec) !---CANNOT PUT AN MPP_CHKSUM HERE AS IT REQUIRES THE ABILITY TO HAVE TWO DIFFERENT OPENMP THREADS !---INSIDE OF MPI AT THE SAME TIME WHICH IS NOT CURRENTLY ALLOWED @@ -680,18 +680,18 @@ program coupler_main !$ if (do_concurrent_radiation) imb_sec(2) = imb_sec(2) + omp_get_wtime() !$ call omp_set_num_threads(atmos_nthreads+(conc_nthreads-1)*radiation_nthreads) - call fms_mpp_clock_begin(full_coupler_clocks%update_atmos_model_state) + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) call update_atmos_model_state( Atm ) if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_state+', (nc-1)*num_atmos_calls+na, Atm, Land, & Ice,Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update state') - call fms_mpp_clock_end(full_coupler_clocks%update_atmos_model_state) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) enddo ! end of na (fast loop) - call fms_mpp_clock_end(full_coupler_clocks%atmos_loop) + call fms_mpp_clock_end(coupler_clocks%atmos_loop) - call fms_mpp_clock_begin(full_coupler_clocks%update_land_model_slow) + call fms_mpp_clock_begin(coupler_clocks%update_land_model_slow) ! ------ end of atmospheric time step loop ----- if (do_land .AND. Land%pe) then if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) @@ -699,47 +699,47 @@ program coupler_main endif if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) !----------------------------------------------------------------------- - call fms_mpp_clock_end(full_coupler_clocks%update_land_model_slow) + call fms_mpp_clock_end(coupler_clocks%update_land_model_slow) if (do_chksum) call atmos_ice_land_chksum('update_land_slow+', nc, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) ! ! need flux call to put runoff and p_surf on ice grid ! - call fms_mpp_clock_begin(full_coupler_clocks%flux_land_to_ice) + call fms_mpp_clock_begin(coupler_clocks%flux_land_to_ice) call flux_land_to_ice( Time, Land, Ice, Land_ice_boundary ) - call fms_mpp_clock_end(full_coupler_clocks%flux_land_to_ice) + call fms_mpp_clock_end(coupler_clocks%flux_land_to_ice) if (do_chksum) call atmos_ice_land_chksum('fluxlnd2ice+', nc, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) Atmos_ice_boundary%p = 0.0 ! call flux_atmos_to_ice_slow ? Time = Time_atmos - call fms_mpp_clock_end(full_coupler_clocks%atm) + call fms_mpp_clock_end(coupler_clocks%atm) endif !Atm%pe block if(Atm%pe) then - call fms_mpp_clock_begin(full_coupler_clocks%atm) !Ice is still using ATM pelist and need to be included in ATM clock + call fms_mpp_clock_begin(coupler_clocks%atm) !Ice is still using ATM pelist and need to be included in ATM clock !ATM clock is used for load-balancing the coupled models endif if (do_ice .and. Ice%pe) then if (Ice%fast_ice_PE) then if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Ice%fast_pelist) - call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_slow_fast) + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_slow_fast) ! These two calls occur on whichever PEs handle the fast ice processess. call ice_model_fast_cleanup(Ice) call unpack_land_ice_boundary(Ice, Land_ice_boundary) - call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_slow_fast) + call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_fast) endif if (.not.concurrent_ice) then ! This could be a point where the model is serialized. if (.not.Ice%shared_slow_fast_PEs) call fms_mpp_set_current_pelist(Ice%pelist) ! This call occurs all ice PEs. - call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_slow_exchange) + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_slow_exchange) call exchange_fast_to_slow_ice(Ice) - call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_slow_exchange) + call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_exchange) endif ! ------ slow-ice model ------ @@ -747,13 +747,13 @@ program coupler_main ! This call occurs on whichever PEs handle the slow ice processess. if (Ice%slow_ice_PE .and. .not.combined_ice_and_ocean) then if (slow_ice_with_ocean) call fms_mpp_set_current_pelist(Ice%slow_pelist) - call fms_mpp_clock_begin(full_coupler_clocks%update_ice_model_slow_slow) + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_slow_slow) call update_ice_model_slow(Ice) - call fms_mpp_clock_begin(full_coupler_clocks%flux_ice_to_ocean_stocks) + call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean_stocks) call flux_ice_to_ocean_stocks(Ice) - call fms_mpp_clock_end(full_coupler_clocks%flux_ice_to_ocean_stocks) - call fms_mpp_clock_end(full_coupler_clocks%update_ice_model_slow_slow) + call fms_mpp_clock_end(coupler_clocks%flux_ice_to_ocean_stocks) + call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_slow) endif if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, Ice, Ocean_ice_boundary) @@ -761,7 +761,7 @@ program coupler_main if(Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(full_coupler_clocks%atm) + call fms_mpp_clock_end(coupler_clocks%atm) endif ! Update Ice_ocean_boundary using the newly calculated fluxes. @@ -773,16 +773,16 @@ program coupler_main if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then ! If the slow ice is on a subset of the ocean PEs, use the ocean PElist. call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - call fms_mpp_clock_begin(full_coupler_clocks%flux_ice_to_ocean) + call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean) call flux_ice_to_ocean( Time, Ice, Ocean, Ice_ocean_boundary ) Time_flux_ice_to_ocean = Time - call fms_mpp_clock_end(full_coupler_clocks%flux_ice_to_ocean) + call fms_mpp_clock_end(coupler_clocks%flux_ice_to_ocean) endif endif if (Ocean%is_ocean_pe) then call fms_mpp_set_current_pelist(Ocean%pelist) - call fms_mpp_clock_begin(full_coupler_clocks%ocean) + call fms_mpp_clock_begin(coupler_clocks%ocean) ! This may do data override or diagnostics on Ice_ocean_boundary. call flux_ice_to_ocean_finish(Time_flux_ice_to_ocean, Ice_ocean_boundary) @@ -810,7 +810,7 @@ program coupler_main Time_ocean = Time_ocean + Time_step_cpld Time = Time_ocean - call fms_mpp_clock_end(full_coupler_clocks%ocean) + call fms_mpp_clock_end(coupler_clocks%ocean) endif !--- write out intermediate restart file when needed. @@ -850,22 +850,22 @@ program coupler_main 102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) call fms_mpp_set_current_pelist() - call fms_mpp_clock_begin(full_coupler_clocks%final_flux_check_stocks) + call fms_mpp_clock_begin(coupler_clocks%final_flux_check_stocks) if (check_stocks >= 0) then call fms_mpp_set_current_pelist() call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) endif - call fms_mpp_clock_end(full_coupler_clocks%final_flux_check_stocks) + call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks) call fms_mpp_set_current_pelist() !----------------------------------------------------------------------- - call fms_mpp_clock_end(full_coupler_clocks%main) - call fms_mpp_clock_begin(full_coupler_clocks%termination) + call fms_mpp_clock_end(coupler_clocks%main) + call fms_mpp_clock_begin(coupler_clocks%termination) if (do_chksum) call coupler_chksum('coupler_end-', nc) call coupler_end - call fms_mpp_clock_end(full_coupler_clocks%termination) + call fms_mpp_clock_end(coupler_clocks%termination) call fms_memutils_print_memuse_stats( 'Memory HiWaterMark', always=.TRUE. ) call fms_end From add6309fce258a46e90cc2a532b95c6c6c5f518e Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 17 Apr 2024 13:57:02 -0400 Subject: [PATCH 42/78] remove *_flux_exchange_mod clocks --- full/atm_land_ice_flux_exchange.F90 | 17 +---------------- full/ice_ocean_flux_exchange.F90 | 9 +-------- full/land_ice_flux_exchange.F90 | 5 +---- 3 files changed, 3 insertions(+), 28 deletions(-) diff --git a/full/atm_land_ice_flux_exchange.F90 b/full/atm_land_ice_flux_exchange.F90 index 7da5221b..11dab430 100644 --- a/full/atm_land_ice_flux_exchange.F90 +++ b/full/atm_land_ice_flux_exchange.F90 @@ -261,7 +261,7 @@ module atm_land_ice_flux_exchange_mod ! REDIST: same physical grid, different decomposition, must move data around ! DIRECT: same physical grid, same domain decomposition, can directly copy data integer, parameter :: REGRID=1, REDIST=2, DIRECT=3 - integer :: cplClock, sfcClock, fluxAtmDnClock, regenClock, fluxAtmUpClock + integer :: cplClock ! Exchange grid indices integer :: X1_GRID_ATM, X1_GRID_ICE, X1_GRID_LND @@ -624,12 +624,6 @@ subroutine atm_land_ice_flux_exchange_init(Time, Atm, Land, Ice, atmos_ice_bound call fms_mpp_domains_get_compute_domain(Land%domain, xsize=nxc_lnd, ysize=nyc_lnd) endif - !Balaji: clocks on atm%pe only - sfcClock = fms_mpp_clock_id( 'SFC boundary layer', flags=fms_clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - fluxAtmDnClock = fms_mpp_clock_id( 'Flux DN from atm', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) - regenClock = fms_mpp_clock_id( 'XGrid generation', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) - fluxAtmUpClock = fms_mpp_clock_id( 'Flux UP to atm', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) - do_init = .false. end subroutine atm_land_ice_flux_exchange_init @@ -727,7 +721,6 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar 'must call atm_land_ice_flux_exchange_init first', FATAL) !Balaji call fms_mpp_clock_begin(cplClock) - call fms_mpp_clock_begin(sfcClock) ! [2] allocate storage for variables that are also used in flux_up_to_atmos allocate ( & ex_t_surf (n_xgrid_sfc), & @@ -1223,7 +1216,6 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar #endif - ! call mpp_clock_end(fluxClock) zrefm = 10.0 zrefh = z_ref_heat ! ---- optimize calculation ---- @@ -1932,7 +1924,6 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar endif !Balaji - call fms_mpp_clock_end(sfcClock) call fms_mpp_clock_end(cplClock) !======================================================================= @@ -2031,7 +2022,6 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun !Balaji call fms_mpp_clock_begin(cplClock) - call fms_mpp_clock_begin(fluxAtmDnClock) ov = .FALSE. !----------------------------------------------------------------------- !Balaji: fms_data_override calls moved here from coupler_main @@ -2691,7 +2681,6 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun used = fms_diag_send_data ( id_tauv, -Atmos_boundary%v_flux, Time ) !Balaji - call fms_mpp_clock_end(fluxAtmDnClock) call fms_mpp_clock_end(cplClock) !======================================================================= @@ -2710,7 +2699,6 @@ subroutine generate_sfc_xgrid( Land, Ice ) !Balaji call fms_mpp_clock_begin(cplClock) - call fms_mpp_clock_begin(regenClock) call fms_mpp_domains_get_compute_domain(Ice%Domain, isc, iec, jsc, jec) @@ -2731,7 +2719,6 @@ subroutine generate_sfc_xgrid( Land, Ice ) endif !Balaji - call fms_mpp_clock_end(regenClock) call fms_mpp_clock_end(cplClock) return end subroutine generate_sfc_xgrid @@ -2798,7 +2785,6 @@ subroutine flux_up_to_atmos ( Time, Land, Ice, Land_Ice_Atmos_Boundary, Land_bou !Balaji call fms_mpp_clock_begin(cplClock) - call fms_mpp_clock_begin(fluxAtmUpClock) !----------------------------------------------------------------------- !Balaji: data_override calls moved here from coupler_main call fms_data_override ( 'ICE', 't_surf', Ice%t_surf, Time) @@ -3204,7 +3190,6 @@ subroutine flux_up_to_atmos ( Time, Land, Ice, Land_Ice_Atmos_Boundary, Land_bou & radius=Radius, ier=ier, verbose='stock move EVAP*HLV (Ice->ATm) ') !Balaji - call fms_mpp_clock_end(fluxAtmUpClock) call fms_mpp_clock_end(cplClock) end subroutine flux_up_to_atmos diff --git a/full/ice_ocean_flux_exchange.F90 b/full/ice_ocean_flux_exchange.F90 index a0219d9f..b8d98473 100644 --- a/full/ice_ocean_flux_exchange.F90 +++ b/full/ice_ocean_flux_exchange.F90 @@ -48,7 +48,7 @@ module ice_ocean_flux_exchange_mod logical :: debug_stocks = .false. logical :: do_area_weighted_flux = .false. - integer :: cplOcnClock, fluxOceanIceClock, fluxIceOceanClock + integer :: cplOcnClock real :: Dt_cpl integer, allocatable :: slow_ice_ocean_pelist(:) @@ -197,8 +197,6 @@ subroutine ice_ocean_flux_exchange_init(Time, Ice, Ocean, Ocean_state, ice_ocean slow_ice_ocean_pelist = slow_ice_ocean_pelist_in call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) cplOcnClock = fms_mpp_clock_id( 'Ice-ocean coupler', flags=fms_clock_flag_default, grain=CLOCK_COMPONENT ) - fluxIceOceanClock = fms_mpp_clock_id( 'Flux ice to ocean', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) - fluxOceanIceClock = fms_mpp_clock_id( 'Flux ocean to ice', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) endif end subroutine ice_ocean_flux_exchange_init @@ -237,7 +235,6 @@ subroutine flux_ice_to_ocean ( Time, Ice, Ocean, Ice_Ocean_Boundary ) logical :: used call fms_mpp_clock_begin(cplOcnClock) - call fms_mpp_clock_begin(fluxIceOceanClock) if(ASSOCIATED(Ice_Ocean_Boundary%u_flux) ) call flux_ice_to_ocean_redistribute( Ice, Ocean, & Ice%flux_u, Ice_Ocean_Boundary%u_flux, Ice_Ocean_Boundary%xtype, .FALSE. ) @@ -312,8 +309,6 @@ subroutine flux_ice_to_ocean ( Time, Ice, Ocean, Ice_Ocean_Boundary ) if(ASSOCIATED(Ice_Ocean_Boundary%q_flux) ) call flux_ice_to_ocean_redistribute( Ice, Ocean, & Ice%flux_q, Ice_Ocean_Boundary%q_flux, Ice_Ocean_Boundary%xtype, do_area_weighted_flux ) - call fms_mpp_clock_end(fluxIceOceanClock) - call fms_mpp_clock_end(cplOcnClock) !----------------------------------------------------------------------- end subroutine flux_ice_to_ocean @@ -389,7 +384,6 @@ subroutine flux_ocean_to_ice ( Time, Ocean, Ice, Ocean_Ice_Boundary ) logical :: used call fms_mpp_clock_begin(cplOcnClock) - call fms_mpp_clock_begin(fluxOceanIceClock) select case (Ocean_Ice_Boundary%xtype) case(DIRECT) @@ -447,7 +441,6 @@ subroutine flux_ocean_to_ice ( Time, Ocean, Ice, Ocean_Ice_Boundary ) call fms_mpp_error( FATAL, 'flux_ocean_to_ice: Ocean_Ice_Boundary%xtype must be DIRECT or REDIST.' ) end select - call fms_mpp_clock_end(fluxOceanIceClock) call fms_mpp_clock_end(cplOcnClock) !----------------------------------------------------------------------- diff --git a/full/land_ice_flux_exchange.F90 b/full/land_ice_flux_exchange.F90 index 7a6e6312..c31b9f0a 100644 --- a/full/land_ice_flux_exchange.F90 +++ b/full/land_ice_flux_exchange.F90 @@ -42,7 +42,7 @@ module land_ice_flux_exchange_mod public :: flux_land_to_ice, land_ice_flux_exchange_init - integer :: cplClock, fluxLandIceClock + integer :: cplClock logical :: do_runoff real :: Dt_cpl contains @@ -61,7 +61,6 @@ subroutine land_ice_flux_exchange_init(Land, Ice, land_ice_boundary, Dt_cpl_in, do_runoff = do_runoff_in cplClock = cplClock_in Dt_cpl = Dt_cpl_in - fluxLandIceClock = fms_mpp_clock_id( 'Flux land to ice', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) if (do_runoff) then call fms_xgrid_setup_xmap(xmap_runoff, (/ 'LND', 'OCN' /), & @@ -114,7 +113,6 @@ subroutine flux_land_to_ice( Time, Land, Ice, Land_Ice_Boundary ) !Balaji call fms_mpp_clock_begin(cplClock) - call fms_mpp_clock_begin(fluxLandIceClock) ! ccc = conservation_check(Land%discharge, 'LND', xmap_runoff) ! if (fms_mpp_pe()==fms_mpp_root_pe()) print *,'RUNOFF', ccc @@ -154,7 +152,6 @@ subroutine flux_land_to_ice( Time, Land, Ice, Land_Ice_Boundary ) Land_Ice_Boundary%calving_hflx = 0.0 endif - call fms_mpp_clock_end(fluxLandIceClock) call fms_mpp_clock_end(cplClock) end subroutine flux_land_to_ice From 2e965ef715f07ac93229690049aaee5b96bea5c2 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 18 Apr 2024 10:20:23 -0400 Subject: [PATCH 43/78] IMPLICIT NONE --- full/full_coupler_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index d20590ac..11b9b395 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1471,6 +1471,8 @@ subroutine coupler_set_clock_ids(coupler_clocks_in, Atm_in, Land_in, Ice_in, Oce slow_ice_ocean_pelist_in, ensemble_pelist_in, ensemble_id, & do_concurrent_radiation_in, clock_type) + implicit none + type(full_coupler_clock_type), intent(inout) :: coupler_clocks_in type(atmos_data_type), intent(in) :: Atm_in type(land_data_type), intent(in) :: Land_in From 446673f371c21a370076ba77b1020bcb5981f638 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 19 Apr 2024 11:00:13 -0400 Subject: [PATCH 44/78] make variables program variables inwork gaea might go down --- full/coupler_main.F90 | 61 +++++++++++++++++++++++++-- full/full_coupler_mod.F90 | 88 +++++++-------------------------------- 2 files changed, 73 insertions(+), 76 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 826e4970..0b2c8af5 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -339,7 +339,58 @@ program coupler_main use iso_fortran_env implicit none - + !> model defined types + type (atmos_data_type) :: Atm + type (land_data_type) :: Land + type (ice_data_type) :: Ice + ! allow members of ocean type to be aliased (ap) + type (ocean_public_type), target :: Ocean + type (ocean_state_type), pointer :: Ocean_state => NULL() + + type(atmos_land_boundary_type) :: Atmos_land_boundary + type(atmos_ice_boundary_type) :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary + type(land_ice_boundary_type) :: Land_ice_boundary + type(ice_ocean_boundary_type) :: Ice_ocean_boundary + type(ocean_ice_boundary_type) :: Ocean_ice_boundary + type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() + + type(FmsTime_type) :: Time, Time_init, Time_end + type(FmsTime_type) :: Time_step_atmos, Time_step_cpld + type(FmsTime_type) :: Time_atmos, Time_ocean + type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice + + integer :: num_atmos_calls, na + integer :: num_cpld_calls, nc + + type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() + type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() + + integer :: num_ice_bc_restart=0, num_ocn_bc_restart=0 + type(FmsTime_type) :: Time_restart, Time_restart_current, Time_start + character(len=32), public :: timestamp + + !> coupled model initial date + integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) + integer :: calendar_type = INVALID_CALENDAR + + integer :: initClock, mainClock, termClock + integer :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 + integer :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e + integer :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka + integer :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki + integer :: newClockj, newClockk, newClockl + integer :: id_atmos_model_init, id_land_model_init, id_ice_model_init + integer :: id_ocean_model_init, id_flux_exchange_init + + integer :: outunit + integer :: ensemble_id = 1 + integer, allocatable :: ensemble_pelist(:, :) + integer, allocatable :: slow_ice_ocean_pelist(:) + integer :: conc_nthreads = 1 + real :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 + + !> FREDB_ID related variables INTEGER :: i, status, arg_count CHARACTER(len=256) :: executable_name, arg, fredb_id @@ -381,8 +432,12 @@ program coupler_main call fms_init call fmsconstants_init call fms_affinity_init - - call coupler_init + + call coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_boundary, & + Ice_bc_restart, num_ice_bc_restart, Ocn_bc_restart, num_ocn_bc_restart, ensemble_pelist, & + slow_ice_ocean_pelist, id_atmos_model_init, id_land_model_init, id_ocean_model_init, & + id_flux_exchange_init, mainClock, termClock, Time_init, Time_start, Time_end, Time_restart, & + Time_restart_current, Time_start, Time_step_cpld, Time_step_atmos, num_cpld_calls, num_atmos_calls) if (do_chksum) call coupler_chksum('coupler_init+', 0) call fms_mpp_set_current_pelist() diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index dad8661a..6b1e434e 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -126,63 +126,21 @@ module full_coupler_mod character(len=128), public :: version = '$Id$' character(len=128), public :: tag = '$Name$' -!----------------------------------------------------------------------- -!---- model defined-types ---- - - type (atmos_data_type), public :: Atm - type (land_data_type), public :: Land - type (ice_data_type), public :: Ice - ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target, public :: Ocean - type (ocean_state_type), pointer, public :: Ocean_state => NULL() - - type(atmos_land_boundary_type), public :: Atmos_land_boundary - type(atmos_ice_boundary_type), public :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type), public :: Land_ice_atmos_boundary - type(land_ice_boundary_type), public :: Land_ice_boundary - type(ice_ocean_boundary_type), public :: Ice_ocean_boundary - type(ocean_ice_boundary_type), public :: Ocean_ice_boundary - type(ice_ocean_driver_type), pointer, public :: ice_ocean_driver_CS => NULL() - -!----------------------------------------------------------------------- -! ----- coupled model time ----- - - type(FmsTime_type), public :: Time, Time_init, Time_end - type(FmsTime_type), public :: Time_step_atmos, Time_step_cpld - type(FmsTime_type), public :: Time_atmos, Time_ocean - type(FmsTime_type), public :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice - - integer, public :: num_atmos_calls, na - integer, public :: num_cpld_calls, nc - - type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ice_bc_restart => NULL() - type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ocn_bc_restart => NULL() - - integer, public :: num_ice_bc_restart=0, num_ocn_bc_restart=0 - type(FmsTime_type), public :: Time_restart, Time_restart_current, Time_start - character(len=32), public :: timestamp - -! ----- coupled model initial date ----- - - integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) - integer :: calendar_type = INVALID_CALENDAR - -!----------------------------------------------------------------------- -!------ namelist interface ------- +!> namelist interface !> The time interval that write out intermediate restart file. !! The format is (yr,mo,day,hr,min,sec). When restart_interval !! is all zero, no intermediate restart file will be written out integer, dimension(6), public :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) - + !> The date that the current integration starts with. (See !! force_date_from_namelist.) - integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) - + integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The calendar type used by the current integration. Valid values are !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. !! The value 'no_calendar' cannot be used because the time_manager's date !! functions are used. All values must be lower case. + character(len=17) :: calendar = ' ' !> Flag that determines whether the namelist variable current_date should override @@ -191,11 +149,11 @@ module full_coupler_mod !! will be used. logical :: force_date_from_namelist = .false. - integer :: months=0 !< Number of months the current integration will be run - integer :: days=0 !< Number of days the current integration will be run - integer :: hours=0 !< Number of hours the current integration will be run - integer :: minutes=0 !< Number of minutes the current integration will be run - integer :: seconds=0 !< Number of seconds the current integration will be run + integer, public :: months=0 !< Number of months the current integration will be run + integer, public :: days=0 !< Number of days the current integration will be run + integer, public :: hours=0 !< Number of hours the current integration will be run + integer, public :: minutes=0 !< Number of minutes the current integration will be run + integer, public :: seconds=0 !< Number of seconds the current integration will be run integer, public :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fast !! coupling with land and sea ice integer, public :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must @@ -264,33 +222,17 @@ module full_coupler_mod use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean - integer, public :: initClock, mainClock, termClock - - integer, public :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 - integer, public :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e - integer, public :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka - integer, public :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki - integer, public :: newClockj, newClockk, newClockl - - integer, public :: id_atmos_model_init, id_land_model_init, id_ice_model_init - integer, public :: id_ocean_model_init, id_flux_exchange_init - - character(len=80), public :: text - character(len=48), parameter :: mod_name = 'coupler_main_mod' - - integer, public :: outunit - integer :: ensemble_id = 1 - integer, allocatable, public :: ensemble_pelist(:, :) - integer, allocatable, public :: slow_ice_ocean_pelist(:) - integer, public :: conc_nthreads = 1 - real, public :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 - contains !####################################################################### !> \brief Initialize all defined exchange grids and all boundary maps - subroutine coupler_init + subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_boundary, + Ice_bc_restart, num_ice_bc_restart, Ocn_bc_restart, num_ocn_bc_restart, ensemble_pelist, + slow_ice_ocean_pelist, id_atmos_model_init, id_land_model_init, id_ocean_model_init, + id_flux_exchange_init, mainClock, termClock, Time_init, Time_start, Time_end, Time_restart, + Time_restart_current, Time_start, Time_step_cpld, Time_step_atmos, num_cpld_calls, num_atmos_calls, + use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_id,ensemble_pelist_setup use ensemble_manager_mod, only : get_ensemble_size, get_ensemble_pelist From e891d1890aae8753e8f322f2a848e18571edaad2 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 23 Apr 2024 09:23:06 -0400 Subject: [PATCH 45/78] make program variables --- full/coupler_main.F90 | 52 ++++++------ full/full_coupler_mod.F90 | 163 +++++++++++++++++++++++++++++--------- 2 files changed, 152 insertions(+), 63 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 0b2c8af5..330f639e 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -71,7 +71,7 @@ !! The three components of coupler: @ref coupler_main , flux_exchange_mod, and surface_flux_mod !! are configured through three namelists !! * \ref coupler_config "coupler_nml" -!! * \ref flux_exchange_conf "flux_exchange_nml" +!! * \ref flux_exchange_conf "flux_exchange_nml" !! * \ref surface_flux_config "surface_flux_nml" !! !! @@ -355,7 +355,7 @@ program coupler_main type(ocean_ice_boundary_type) :: Ocean_ice_boundary type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() - type(FmsTime_type) :: Time, Time_init, Time_end + type(FmsTime_type) :: Time type(FmsTime_type) :: Time_step_atmos, Time_step_cpld type(FmsTime_type) :: Time_atmos, Time_ocean type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice @@ -366,15 +366,11 @@ program coupler_main type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() - integer :: num_ice_bc_restart=0, num_ocn_bc_restart=0 - type(FmsTime_type) :: Time_restart, Time_restart_current, Time_start - character(len=32), public :: timestamp + type(FmsTime_type) :: Time_restart, Time_start, Time_end + type(FmsTime_type) :: Time_restart_current + character(len=32) :: timestamp - !> coupled model initial date - integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) - integer :: calendar_type = INVALID_CALENDAR - - integer :: initClock, mainClock, termClock + integer :: initClock, mainClock, termClock integer :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 integer :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e integer :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka @@ -384,7 +380,7 @@ program coupler_main integer :: id_ocean_model_init, id_flux_exchange_init integer :: outunit - integer :: ensemble_id = 1 + character(len=80) :: text integer, allocatable :: ensemble_pelist(:, :) integer, allocatable :: slow_ice_ocean_pelist(:) integer :: conc_nthreads = 1 @@ -432,13 +428,17 @@ program coupler_main call fms_init call fmsconstants_init call fms_affinity_init - - call coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_boundary, & - Ice_bc_restart, num_ice_bc_restart, Ocn_bc_restart, num_ocn_bc_restart, ensemble_pelist, & - slow_ice_ocean_pelist, id_atmos_model_init, id_land_model_init, id_ocean_model_init, & - id_flux_exchange_init, mainClock, termClock, Time_init, Time_start, Time_end, Time_restart, & - Time_restart_current, Time_start, Time_step_cpld, Time_step_atmos, num_cpld_calls, num_atmos_calls) - if (do_chksum) call coupler_chksum('coupler_init+', 0) + + + call coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & + Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & + Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, & + ensemble_pelist, slow_ice_ocean_pelist, id_atmos_model_init, id_land_model_init, & + id_ice_model_init, id_ocean_model_init, id_flux_exchange_init, mainClock, termClock, & + Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, & + Time_start, Time_end, Time_restart) + + if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) call fms_mpp_set_current_pelist() @@ -511,7 +511,7 @@ program coupler_main newClock14 = fms_mpp_clock_id( 'final flux_check_stocks' ) do nc = 1, num_cpld_calls - if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc) + if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice) call fms_mpp_set_current_pelist() if (do_chksum) then @@ -552,7 +552,7 @@ program coupler_main endif if (do_chksum) then - call coupler_chksum('flux_ocn2ice+', nc) + call coupler_chksum('flux_ocn2ice+', nc, Atm, Land, Ice) if (Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) call atmos_ice_land_chksum('fluxocn2ice+', nc, Atm, Land, Ice, & @@ -944,11 +944,12 @@ program coupler_main if (Ocean%is_ocean_pe) then call ocean_model_restart(Ocean_state, timestamp) endif - call coupler_restart(Time, Time_restart_current, timestamp) + call coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & + Time, Time_restart_current, Time_start, Time_end, timestamp) endif !-------------- - if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc) + if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc, Atm, Land, Ice) write( text,'(a,i6)' )'Main loop at coupling timestep=', nc call fms_memutils_print_memuse_stats(text) outunit= fms_mpp_stdout() @@ -976,8 +977,11 @@ program coupler_main call fms_mpp_clock_end(mainClock) call fms_mpp_clock_begin(termClock) - if (do_chksum) call coupler_chksum('coupler_end-', nc) - call coupler_end + if (do_chksum) call coupler_chksum('coupler_end-', nc, Atm, Land, Ice) + call coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& + Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & + Time, Time_start, Time_end, Time_restart_current) + call fms_mpp_clock_end(termClock) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 6b1e434e..43fab27f 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -12,7 +12,7 @@ !* WITHOUT ANY WARRANTY; without even the implied warranty of !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU !* General Public License for more details. -!* + !* !* You should have received a copy of the GNU Lesser General Public !* License along with FMS Coupler. !* If not, see . @@ -90,6 +90,11 @@ module full_coupler_mod implicit none private + public :: atmos_data_type, land_data_type, ice_data_type + public :: ocean_public_type, ocean_state_type + public :: atmos_land_boundary_type, atmos_ice_boundary_type, land_ice_atmos_boundary_type + public :: land_ice_boundary_type, ice_ocean_boundary_type, ocean_ice_boundary_type, ice_ocean_driver_type + public :: fmsconstants_init public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up public :: update_atmos_model_radiation, update_atmos_model_state @@ -126,28 +131,28 @@ module full_coupler_mod character(len=128), public :: version = '$Id$' character(len=128), public :: tag = '$Name$' -!> namelist interface + !> namelist interface !> The time interval that write out intermediate restart file. !! The format is (yr,mo,day,hr,min,sec). When restart_interval !! is all zero, no intermediate restart file will be written out integer, dimension(6), public :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) - + !> The date that the current integration starts with. (See !! force_date_from_namelist.) integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The calendar type used by the current integration. Valid values are !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. !! The value 'no_calendar' cannot be used because the time_manager's date - !! functions are used. All values must be lower case. + !! functions are used. All values must be lower case. - character(len=17) :: calendar = ' ' + character(len=17) :: calendar = ' ' !> Flag that determines whether the namelist variable current_date should override !! the date in the restart file `INPUT/coupler.res`. If the restart file does not !! exist then force_date_from_namelist has no effect, the value of current_date !! will be used. - logical :: force_date_from_namelist = .false. + logical :: force_date_from_namelist = .false. integer, public :: months=0 !< Number of months the current integration will be run integer, public :: days=0 !< Number of days the current integration will be run @@ -169,7 +174,7 @@ module full_coupler_mod !> Indicates if this component should be executed. If .FALSE., then execution is skipped. !! This is used when ALL the output fields sent by this component to the coupler have been !! overridden using the data_override feature. This is for advanced users only. - logical, public :: do_atmos =.true. + logical, public :: do_atmos =.true. logical, public :: do_land =.true. !< See do_atmos logical, public :: do_ice =.true. !< See do_atmos logical, public :: do_ocean=.true. !< See do_atmos @@ -178,7 +183,7 @@ module full_coupler_mod !> If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. !! If .FALSE., the execution is serial: call atmos... followed by call ocean... - logical, public :: concurrent=.FALSE. + logical, public :: concurrent=.FALSE. logical, public :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently !> If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. @@ -188,23 +193,23 @@ module full_coupler_mod !! is probably sufficient damping for MOM4. For more modern ocean models (such as !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. !! should be much more stable. - logical, public :: use_lag_fluxes=.TRUE. + logical, public :: use_lag_fluxes=.TRUE. !> If .TRUE., the slow sea-ice is forced with the fluxes that were used for the !! fast ice processes one timestep before. When used in conjuction with setting !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. - logical, public :: concurrent_ice=.FALSE. + logical, public :: concurrent_ice=.FALSE. !> If true, the slow sea-ice is advanced on the ocean processors. Otherwise !! the slow sea-ice processes are on the same PEs as the fast sea-ice. logical, public :: slow_ice_with_ocean=.FALSE. - + !< If true, there is a single call from the coupler to advance !! both the slow sea-ice and the ocean. slow_ice_with_ocean and !! concurrent_ice must both be true if combined_ice_and_ocean is true. - logical, public :: combined_ice_and_ocean=.FALSE. + logical, public :: combined_ice_and_ocean=.FALSE. logical, public :: do_chksum=.FALSE. !< If .TRUE., do multiple checksums throughout the execution of the model logical, public :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. @@ -222,22 +227,52 @@ module full_coupler_mod use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean -contains -!####################################################################### + character(len=80) :: text + character(len=48), parameter :: mod_name = 'coupler_main_mod' -!> \brief Initialize all defined exchange grids and all boundary maps - subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_boundary, - Ice_bc_restart, num_ice_bc_restart, Ocn_bc_restart, num_ocn_bc_restart, ensemble_pelist, - slow_ice_ocean_pelist, id_atmos_model_init, id_land_model_init, id_ocean_model_init, - id_flux_exchange_init, mainClock, termClock, Time_init, Time_start, Time_end, Time_restart, - Time_restart_current, Time_start, Time_step_cpld, Time_step_atmos, num_cpld_calls, num_atmos_calls, - + integer :: calendar_type = INVALID_CALENDAR - use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_id,ensemble_pelist_setup - use ensemble_manager_mod, only : get_ensemble_size, get_ensemble_pelist + !> coupled model initial date + integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) +contains + +!####################################################################### +!> \brief Initialize all defined exchange grids and all boundary maps + subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & + Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & + Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, & + id_atmos_model_init, id_land_model_init, id_ice_model_init, id_ocean_model_init, & + id_flux_exchange_init, mainClock, termClock, Time_step_cpld, Time_step_atmos, & + Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, Time_start, Time_end, Time_restart) + + implicit none + + type(atmos_data_type), intent(inout) :: Atm + type(land_data_type), intent(inout) :: Land + type(ice_data_type), intent(inout) :: Ice + type(ocean_public_type), intent(inout) :: Ocean + type(ocean_state_type), pointer, intent(inout) :: Ocean_state + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary + type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary + type(ocean_ice_boundary_type), intent(inout) :: Ocean_ice_boundary + type(land_ice_boundary_type), intent(inout) :: Land_ice_boundary + type(ice_ocean_driver_type), pointer, intent(inout) :: Ice_ocean_driver_CS + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary + type(FmsNetcdfDomainFile_t), pointer, dimension(:), intent(inout) :: Ice_bc_restart, Ocn_bc_restart + + integer, allocatable, dimension(:,:), intent(inout) :: ensemble_pelist + integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist + integer, intent(inout) :: id_atmos_model_init, id_land_model_init + integer, intent(inout) :: id_ocean_model_init, id_flux_exchange_init, id_ice_model_init + integer, intent(inout) :: mainClock, termClock + type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean + type(FMSTime_type), intent(inout) :: Time_start, Time_end, Time_restart + + integer, intent(inout) :: num_cpld_calls, num_atmos_calls ! !----------------------------------------------------------------------- ! local parameters @@ -257,6 +292,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_bou integer :: pe, npes integer :: ens_siz(6), ensemble_size + integer :: ensemble_id = 1 integer :: atmos_pe_start=0, atmos_pe_end=0, & ocean_pe_start=0, ocean_pe_end=0 @@ -275,13 +311,17 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_bou integer :: time_stamp_unit !< Unif of the time_stamp file integer :: ascii_unit !< Unit of a dummy ascii file + type(FmsTime_type) :: Time, Time_init, Time_restart_current + type(FmsCoupler1dBC_type), pointer :: & gas_fields_atm => NULL(), & ! A pointer to the type describing the - ! atmospheric fields that will participate in the gas fluxes. + ! atmospheric fields that will participate in the gas fluxes. gas_fields_ocn => NULL(), & ! A pointer to the type describing the ocean - ! and ice surface fields that will participate in the gas fluxes. - gas_fluxes => NULL() ! A pointer to the type describing the - ! atmosphere-ocean gas and tracer fluxes. + ! and ice surface fields that will participate in the gas fluxes. + gas_fluxes => NULL() ! A pointer to the type describing the + ! atmosphere-ocean gas and tracer fluxes. + + integer :: num_ice_bc_restart, num_ocn_bc_restart !----------------------------------------------------------------------- outunit = fms_mpp_stdout() @@ -380,7 +420,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_bou write(errunit,*) 'Finished initializing ensemble_manager at '& //trim(walldate)//' '//trim(walltime) endif - ens_siz = get_ensemble_size() + ens_siz = fms_ensemble_manager_get_ensemble_size() ensemble_size = ens_siz(1) npes = ens_siz(2) @@ -422,8 +462,9 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_bou !set up affinities based on threads - ensemble_id = get_ensemble_id() + ensemble_id = fms_ensemble_manager_get_ensemble_id() + if(allocated(ensemble_pelist)) call mpp_error(FATAL, 'ensemble_pelist unexpectedly has already been allocated') allocate(ensemble_pelist(1:ensemble_size,1:npes)) call fms_ensemble_manager_get_ensemble_pelist(ensemble_pelist) @@ -445,7 +486,11 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_bou allocate( Ice%slow_pelist(ice_npes) ) Ice%slow_pelist(:) = Ice%fast_pelist(:) if(concurrent) then - allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) + if(.not.allocated(slow_ice_ocean_pelist)) then + allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) + else + call mpp_error(FATAL, 'allocation of slow_ice_ocean_pelist unexpectedly has already been allocated') + end if slow_ice_ocean_pelist(1:ice_npes) = Ice%slow_pelist(:) slow_ice_ocean_pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) else @@ -720,7 +765,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_ice_boundary, Ice_ocean_bou !----------------------------------------------------------------------- !----- write time stamps (for start time and end time) ------ - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) & + open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') month = fms_time_manager_month_name(date(2)) if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) @@ -1048,9 +1094,27 @@ end subroutine coupler_init !####################################################################### - subroutine coupler_end() + subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& + Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & + Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current) -!----------------------------------------------------------------------- + implicit none + + type(atmos_data_type), intent(inout) :: Atm + type(land_data_type), intent(inout) :: Land + type(ice_data_type), intent(inout) :: Ice + type(ocean_public_type), intent(inout) :: Ocean + type(ocean_state_type), pointer, intent(inout) :: Ocean_state + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary + type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary + type(ocean_ice_boundary_type), intent(inout) :: Ocean_ice_boundary + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ocn_bc_restart + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart + + type(FmsTime_type), intent(in) :: Time, Time_start, Time_end, Time_restart_current + integer :: num_ice_bc_restart, num_ocn_bc_restart if ( do_endpoint_chksum ) then if (Atm%pe) then @@ -1100,7 +1164,8 @@ subroutine coupler_end() endif !----- write restart file ------ - call coupler_restart(Time, Time_restart_current) + call coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & + Time, Time_restart_current, Time_start, Time_end) call fms_diag_end (Time) #ifdef use_deprecated_io @@ -1128,15 +1193,29 @@ subroutine add_domain_dimension_data(fileobj) call fms2_io_write_data(fileobj, "yaxis_1", buffer) deallocate(buffer) - end subroutine add_domain_dimension_data + end subroutine add_domain_dimension_data !> \brief Writing restart file that contains running time and restart file writing time. - subroutine coupler_restart(Time_run, Time_res, time_stamp) - type(FmsTime_type), intent(in) :: Time_run, Time_res + subroutine coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & + Time_run, Time_res, Time_start, Time_end, time_stamp) + + implicit none + + type(atmos_data_type), intent(inout) :: Atm + type(ice_data_type), intent(inout) :: Ice + type(ocean_public_type), intent(inout) :: Ocean + + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ocn_bc_restart + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart + + type(FmsTime_type), intent(in) :: Time_run, Time_res, Time_start, Time_end character(len=*), intent(in), optional :: time_stamp - character(len=128) :: file_run, file_res + + character(len=128) :: file_run, file_res + integer :: yr, mon, day, hr, min, sec, date(6), n + integer :: num_ice_bc_restart, num_ocn_bc_restart integer :: restart_unit !< Unit for the coupler restart file call fms_mpp_set_current_pelist() @@ -1210,7 +1289,13 @@ end subroutine coupler_restart !-------------------------------------------------------------------------- !> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(id, timestep) + subroutine coupler_chksum(id, timestep, Atm, Land, Ice) + + implicit none + + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ice_data_type), intent(in) :: Ice character(len=*), intent(in) :: id integer , intent(in) :: timestep From 1880bfe097188da7bfaaa9327f2d474e4bfcd3d4 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 23 Apr 2024 12:15:22 -0400 Subject: [PATCH 46/78] it compiles! --- full/full_coupler_mod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 43fab27f..8f3043a9 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -120,7 +120,6 @@ module full_coupler_mod public :: atm_lnd_bnd_type_chksum, land_data_type_chksum public :: ice_data_type_chksum, ocn_ice_bnd_type_chksum public :: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum - public :: ocean_ice_boundary_type, atmos_ice_boundary_type public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum public :: coupler_init, coupler_end, coupler_restart @@ -464,7 +463,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, ensemble_id = fms_ensemble_manager_get_ensemble_id() - if(allocated(ensemble_pelist)) call mpp_error(FATAL, 'ensemble_pelist unexpectedly has already been allocated') + if(allocated(ensemble_pelist)) call fms_mpp_error(FATAL, 'ensemble_pelist unexpectedly has already been allocated') allocate(ensemble_pelist(1:ensemble_size,1:npes)) call fms_ensemble_manager_get_ensemble_pelist(ensemble_pelist) @@ -489,7 +488,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, if(.not.allocated(slow_ice_ocean_pelist)) then allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) else - call mpp_error(FATAL, 'allocation of slow_ice_ocean_pelist unexpectedly has already been allocated') + call fms_mpp_error(FATAL, 'allocation of slow_ice_ocean_pelist unexpectedly has already been allocated') end if slow_ice_ocean_pelist(1:ice_npes) = Ice%slow_pelist(:) slow_ice_ocean_pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) From 9c52fc63c3ccbd3c3839406ef8dc0e06cc71daaa Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 23 Apr 2024 14:00:18 -0400 Subject: [PATCH 47/78] conc_nthreads error that wasnt there before! --- full/coupler_main.F90 | 4 ++-- full/full_coupler_mod.F90 | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 330f639e..fad30a10 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -432,8 +432,8 @@ program coupler_main call coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & - Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, & - ensemble_pelist, slow_ice_ocean_pelist, id_atmos_model_init, id_land_model_init, & + Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, & + conc_nthreads, id_atmos_model_init, id_land_model_init, & id_ice_model_init, id_ocean_model_init, id_flux_exchange_init, mainClock, termClock, & Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, & Time_start, Time_end, Time_restart) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 8f3043a9..e9bf8c73 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -242,7 +242,7 @@ module full_coupler_mod !> \brief Initialize all defined exchange grids and all boundary maps subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & - Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, & + Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & id_atmos_model_init, id_land_model_init, id_ice_model_init, id_ocean_model_init, & id_flux_exchange_init, mainClock, termClock, Time_step_cpld, Time_step_atmos, & Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, Time_start, Time_end, Time_restart) @@ -260,9 +260,10 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, type(ocean_ice_boundary_type), intent(inout) :: Ocean_ice_boundary type(land_ice_boundary_type), intent(inout) :: Land_ice_boundary type(ice_ocean_driver_type), pointer, intent(inout) :: Ice_ocean_driver_CS - type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary type(FmsNetcdfDomainFile_t), pointer, dimension(:), intent(inout) :: Ice_bc_restart, Ocn_bc_restart + integer, intent(inout) :: conc_nthreads integer, allocatable, dimension(:,:), intent(inout) :: ensemble_pelist integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist integer, intent(inout) :: id_atmos_model_init, id_land_model_init From 7e13e96d29797ca1ef97430af9042892b12aeba5 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 6 May 2024 12:50:13 -0400 Subject: [PATCH 48/78] pass Time as coupler_init argument --- full/coupler_main.F90 | 2 +- full/full_coupler_mod.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index fad30a10..15b28441 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -436,7 +436,7 @@ program coupler_main conc_nthreads, id_atmos_model_init, id_land_model_init, & id_ice_model_init, id_ocean_model_init, id_flux_exchange_init, mainClock, termClock, & Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, & - Time_start, Time_end, Time_restart) + Time, Time_start, Time_end, Time_restart) if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index e9bf8c73..0a621a5a 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -245,7 +245,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & id_atmos_model_init, id_land_model_init, id_ice_model_init, id_ocean_model_init, & id_flux_exchange_init, mainClock, termClock, Time_step_cpld, Time_step_atmos, & - Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, Time_start, Time_end, Time_restart) + Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart) implicit none @@ -270,7 +270,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer, intent(inout) :: id_ocean_model_init, id_flux_exchange_init, id_ice_model_init integer, intent(inout) :: mainClock, termClock type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean - type(FMSTime_type), intent(inout) :: Time_start, Time_end, Time_restart + type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart integer, intent(inout) :: num_cpld_calls, num_atmos_calls ! From 0e8f21efd824d647a4d87049c8557e72ea8197f9 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 6 May 2024 12:56:52 -0400 Subject: [PATCH 49/78] add Time_restart_current to coupler_init argument --- full/coupler_main.F90 | 2 +- full/full_coupler_mod.F90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 15b28441..111b5e6f 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -436,7 +436,7 @@ program coupler_main conc_nthreads, id_atmos_model_init, id_land_model_init, & id_ice_model_init, id_ocean_model_init, id_flux_exchange_init, mainClock, termClock, & Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, & - Time, Time_start, Time_end, Time_restart) + Time, Time_start, Time_end, Time_restart, Time_restart_current) if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 0a621a5a..44111664 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -244,8 +244,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & id_atmos_model_init, id_land_model_init, id_ice_model_init, id_ocean_model_init, & - id_flux_exchange_init, mainClock, termClock, Time_step_cpld, Time_step_atmos, & - Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart) + id_flux_exchange_init, mainClock, termClock, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & + num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) implicit none @@ -270,7 +270,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer, intent(inout) :: id_ocean_model_init, id_flux_exchange_init, id_ice_model_init integer, intent(inout) :: mainClock, termClock type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean - type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart + type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart, Time_restart_current integer, intent(inout) :: num_cpld_calls, num_atmos_calls ! @@ -311,7 +311,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer :: time_stamp_unit !< Unif of the time_stamp file integer :: ascii_unit !< Unit of a dummy ascii file - type(FmsTime_type) :: Time, Time_init, Time_restart_current + type(FmsTime_type) :: Time_init type(FmsCoupler1dBC_type), pointer :: & gas_fields_atm => NULL(), & ! A pointer to the type describing the From 7b517c2f757af5cd5c97756a4766795cef99de1a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 7 May 2024 14:27:42 -0400 Subject: [PATCH 50/78] change full to nothing --- full/full_coupler_mod.F90 | 140 +++++++++++++++++--------------------- 1 file changed, 63 insertions(+), 77 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 11b9b395..fbb96a56 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -242,8 +242,8 @@ module full_coupler_mod use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean - public :: full_coupler_clock_type - type full_coupler_clock_type + public :: coupler_clock_type + type coupler_clock_type integer :: initialization integer :: main integer :: generate_sfc_xgrid @@ -283,9 +283,9 @@ module full_coupler_mod integer :: ice_model_init integer :: ocean_model_init integer :: flux_exchange_init - end type full_coupler_clock_type + end type coupler_clock_type - type(full_coupler_clock_type), public :: coupler_clocks + type(coupler_clock_type), public :: coupler_clocks character(len=80), public :: text character(len=48), parameter :: mod_name = 'full_coupler_mod' @@ -592,9 +592,7 @@ subroutine coupler_init endif !> The pelists need to be set before initializing the clocks - call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, & - slow_ice_ocean_pelist, ensemble_pelist, ensemble_id, & - do_concurrent_radiation, clock_type='init_model_clocks') + call coupler_set_clock_ids(ensemble_id, clock_set='model_init_clocks') !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -971,9 +969,7 @@ subroutine coupler_init endif ! end of Ocean%is_ocean_pe - call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, & - slow_ice_ocean_pelist, ensemble_pelist, ensemble_id, & - do_concurrent_radiation, clock_type='init_coupler_clocks') + call coupler_set_clock_ids(ensemble_id, clock_set='coupler_clocks') !--------------------------------------------- if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -1467,113 +1463,103 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine coupler_set_clock_ids(coupler_clocks_in, Atm_in, Land_in, Ice_in, Ocean_in, & - slow_ice_ocean_pelist_in, ensemble_pelist_in, ensemble_id, & - do_concurrent_radiation_in, clock_type) + subroutine coupler_set_clock_ids(ensemble_id, clock_set) implicit none - type(full_coupler_clock_type), intent(inout) :: coupler_clocks_in - type(atmos_data_type), intent(in) :: Atm_in - type(land_data_type), intent(in) :: Land_in - type(ice_data_type), intent(in) :: Ice_in - type(ocean_public_type), intent(in) :: Ocean_in - integer, intent(in), dimension(:) :: slow_ice_ocean_pelist_in - integer, intent(in), dimension(:,:) :: ensemble_pelist_in integer, intent(in) :: ensemble_id - logical, intent(in) :: do_concurrent_radiation_in - character(len=*), intent(in) :: clock_type + character(len=*), intent(in) :: clock_set - if( trim(clock_type) == 'init_model_clocks' ) then + if( trim(clock_set) == 'model_init_clocks' ) then !> initialization clock - if (Atm_in%pe) then - call fms_mpp_set_current_pelist(Atm_in%pelist) - coupler_clocks_in%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) endif - if (Land_in%pe) then - call fms_mpp_set_current_pelist(Land_in%pelist) - coupler_clocks_in%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) endif - if (Ice_in%pe) then - if (Ice_in%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice_in%pelist) - elseif (Ice_in%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice_in%fast_pelist) - elseif (Ice_in%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice_in%slow_pelist) + if (Ice%pe) then + if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) + elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") endif - coupler_clocks_in%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) endif - if (Ocean_in%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean_in%pelist) - coupler_clocks_in%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) endif - call fms_mpp_set_current_pelist(ensemble_pelist_in(ensemble_id,:)) - coupler_clocks_in%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) call fms_mpp_set_current_pelist() - coupler_clocks_in%main = fms_mpp_clock_id( 'Main loop' ) - coupler_clocks_in%termination = fms_mpp_clock_id( 'Termination' ) + coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) + coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) - else if( trim(clock_type) == 'init_coupler_clocks' ) then + else if( trim(clock_set) == 'coupler_clocks' ) then If(Atm_in%pe) then call fms_mpp_set_current_pelist(Atm_in%pelist) - coupler_clocks_in%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) + coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) end if if (Ice_in%slow_ice_PE .or. Ocean_in%is_ocean_pe) then - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist_in) - coupler_clocks_in%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) - coupler_clocks_in%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) + call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) + coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) + coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) endif if (Atm_in%pe) then call fms_mpp_set_current_pelist(Atm_in%pelist) - coupler_clocks_in%atm = fms_mpp_clock_id( 'ATM' ) - coupler_clocks_in%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) - coupler_clocks_in%atmos_tracer_driver_gather_data & + coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) + coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) + coupler_clocks%atmos_tracer_driver_gather_data & = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) - coupler_clocks_in%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) - coupler_clocks_in%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') - if (.not. do_concurrent_radiation_in) & - coupler_clocks_in%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) - coupler_clocks_in%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) - coupler_clocks_in%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) - coupler_clocks_in%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) - coupler_clocks_in%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) - coupler_clocks_in%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) - coupler_clocks_in%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) - if (do_concurrent_radiation_in) then - coupler_clocks_in%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) - coupler_clocks_in%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) + coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) + coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') + if (.not. do_concurrent_radiation) & + coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) + coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) + coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) + coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) + coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) + coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) + if (do_concurrent_radiation) then + coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) endif - coupler_clocks_in%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') - coupler_clocks_in%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) - coupler_clocks_in%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) + coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') + coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) + coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) endif if (Ice_in%pe) then if (Ice_in%fast_ice_pe) call fms_mpp_set_current_pelist(Ice_in%fast_pelist) - coupler_clocks_in%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) - coupler_clocks_in%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) + coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) + coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) if (Ice_in%slow_ice_pe) call fms_mpp_set_current_pelist(Ice_in%slow_pelist) - coupler_clocks_in%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) - coupler_clocks_in%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) - coupler_clocks_in%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) + coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) + coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) + coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) call fms_mpp_set_current_pelist(Ice_in%pelist) - coupler_clocks_in%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) - coupler_clocks_in%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) + coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) + coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) endif if (Ocean_in%is_ocean_pe) then call fms_mpp_set_current_pelist(Ocean_in%pelist) - coupler_clocks_in%ocean = fms_mpp_clock_id( 'OCN' ) + coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) endif call fms_mpp_set_current_pelist() - coupler_clocks_in%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) - coupler_clocks_in%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) - coupler_clocks_in%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) + coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) + coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) + coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) else - call fms_mpp_error(FATAL, 'clock_type not recognized in coupler_set_clock_ids') + call fms_mpp_error(FATAL, 'clock_set not recognized in coupler_set_clock_ids') end if From 9af81baddce95df9d3ae3c5b73adc18a2015aa0e Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 7 May 2024 15:33:34 -0400 Subject: [PATCH 51/78] fixes for compilation --- full/full_coupler_mod.F90 | 38 ++++++++++++++++++++++---------------- 1 file changed, 22 insertions(+), 16 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 9e92f558..6425d79b 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -611,7 +611,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, endif !> The pelists need to be set before initializing the clocks - call coupler_set_clock_ids(ensemble_id, clock_set='model_init_clocks') + call coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set='model_init_clocks') !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -989,7 +989,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, endif ! end of Ocean%is_ocean_pe - call coupler_set_clock_ids(ensemble_id, clock_set='coupler_clocks') + call coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set='coupler_clocks') !--------------------------------------------- if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -1522,11 +1522,17 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine coupler_set_clock_ids(ensemble_id, clock_set) + subroutine coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set) implicit none - - integer, intent(in) :: ensemble_id + + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ocean_public_type), intent(in) :: Ocean + type(ice_data_type), intent(in) :: Ice + integer, dimension(:), intent(in) :: slow_ice_ocean_pelist + integer, dimension(:,:), intent(in) :: ensemble_pelist + integer, intent(in) :: ensemble_id character(len=*), intent(in) :: clock_set if( trim(clock_set) == 'model_init_clocks' ) then @@ -1559,17 +1565,17 @@ subroutine coupler_set_clock_ids(ensemble_id, clock_set) coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) else if( trim(clock_set) == 'coupler_clocks' ) then - If(Atm_in%pe) then - call fms_mpp_set_current_pelist(Atm_in%pelist) + If(Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) end if - if (Ice_in%slow_ice_PE .or. Ocean_in%is_ocean_pe) then + if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) endif - if (Atm_in%pe) then - call fms_mpp_set_current_pelist(Atm_in%pelist) + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) coupler_clocks%atmos_tracer_driver_gather_data & @@ -1592,23 +1598,23 @@ subroutine coupler_set_clock_ids(ensemble_id, clock_set) coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) endif - if (Ice_in%pe) then - if (Ice_in%fast_ice_pe) call fms_mpp_set_current_pelist(Ice_in%fast_pelist) + if (Ice%pe) then + if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) - if (Ice_in%slow_ice_pe) call fms_mpp_set_current_pelist(Ice_in%slow_pelist) + if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) - call fms_mpp_set_current_pelist(Ice_in%pelist) + call fms_mpp_set_current_pelist(Ice%pelist) coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) endif - if (Ocean_in%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean_in%pelist) + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) endif From d3ad3e23fa099200e9f2e72d8abe91ec7204baca Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 9 May 2024 10:42:28 -0400 Subject: [PATCH 52/78] update full coupler mod --- full/coupler_main.F90 | 76 +++++- full/full_coupler_mod.F90 | 481 +++++++++++++++++++++----------------- 2 files changed, 334 insertions(+), 223 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index c53837a2..4d2669a8 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -338,6 +338,54 @@ program coupler_main use iso_fortran_env implicit none + !> model defined types + type (atmos_data_type) :: Atm + type (land_data_type) :: Land + type (ice_data_type) :: Ice + ! allow members of ocean type to be aliased (ap) + type (ocean_public_type), target :: Ocean + type (ocean_state_type), pointer :: Ocean_state => NULL() + + type(atmos_land_boundary_type) :: Atmos_land_boundary + type(atmos_ice_boundary_type) :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary + type(land_ice_boundary_type) :: Land_ice_boundary + type(ice_ocean_boundary_type) :: Ice_ocean_boundary + type(ocean_ice_boundary_type) :: Ocean_ice_boundary + type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() + + type(FmsTime_type) :: Time + type(FmsTime_type) :: Time_step_atmos, Time_step_cpld + type(FmsTime_type) :: Time_atmos, Time_ocean + type(FmsTime_type) :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice + + integer :: num_atmos_calls, na + integer :: num_cpld_calls, nc + + type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() + type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() + + type(FmsTime_type) :: Time_restart, Time_start, Time_end + type(FmsTime_type) :: Time_restart_current + character(len=32) :: timestamp + + integer :: initClock, mainClock, termClock + integer :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 + integer :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e + integer :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka + integer :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki + integer :: newClockj, newClockk, newClockl + integer :: id_atmos_model_init, id_land_model_init, id_ice_model_init + integer :: id_ocean_model_init, id_flux_exchange_init + + integer :: outunit + character(len=80) :: text + integer, allocatable :: ensemble_pelist(:, :) + integer, allocatable :: slow_ice_ocean_pelist(:) + integer :: conc_nthreads = 1 + real :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 + + !> FREDB_ID related variables INTEGER :: i, status, arg_count CHARACTER(len=256) :: executable_name, arg, fredb_id @@ -380,8 +428,16 @@ program coupler_main call fmsconstants_init call fms_affinity_init - call coupler_init - if (do_chksum) call coupler_chksum('coupler_init+', 0) + + call coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & + Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & + Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, & + conc_nthreads, id_atmos_model_init, id_land_model_init, & + id_ice_model_init, id_ocean_model_init, id_flux_exchange_init, mainClock, termClock, & + Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, & + Time, Time_start, Time_end, Time_restart, Time_restart_current) + + if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization @@ -397,7 +453,7 @@ program coupler_main endif do nc = 1, num_cpld_calls - if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc) + if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice) call fms_mpp_set_current_pelist() if (do_chksum) then @@ -438,7 +494,7 @@ program coupler_main endif if (do_chksum) then - call coupler_chksum('flux_ocn2ice+', nc) + call coupler_chksum('flux_ocn2ice+', nc, Atm, Land, Ice) if (Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) call atmos_ice_land_chksum('fluxocn2ice+', nc, Atm, Land, Ice, & @@ -830,11 +886,12 @@ program coupler_main if (Ocean%is_ocean_pe) then call ocean_model_restart(Ocean_state, timestamp) endif - call coupler_restart(Time, Time_restart_current, timestamp) + call coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & + Time, Time_restart_current, Time_start, Time_end, timestamp) endif !-------------- - if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc) + if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc, Atm, Land, Ice) write( text,'(a,i6)' )'Main loop at coupling timestep=', nc call fms_memutils_print_memuse_stats(text) outunit= fms_mpp_stdout() @@ -862,8 +919,11 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%main) call fms_mpp_clock_begin(coupler_clocks%termination) - if (do_chksum) call coupler_chksum('coupler_end-', nc) - call coupler_end + if (do_chksum) call coupler_chksum('coupler_end-', nc, Atm, Land, Ice) + call coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& + Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & + Time, Time_start, Time_end, Time_restart_current) + call fms_mpp_clock_end(coupler_clocks%termination) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 11b9b395..6425d79b 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -12,7 +12,7 @@ !* WITHOUT ANY WARRANTY; without even the implied warranty of !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU !* General Public License for more details. -!* + !* !* You should have received a copy of the GNU Lesser General Public !* License along with FMS Coupler. !* If not, see . @@ -90,6 +90,11 @@ module full_coupler_mod implicit none private + public :: atmos_data_type, land_data_type, ice_data_type + public :: ocean_public_type, ocean_state_type + public :: atmos_land_boundary_type, atmos_ice_boundary_type, land_ice_atmos_boundary_type + public :: land_ice_boundary_type, ice_ocean_boundary_type, ocean_ice_boundary_type, ice_ocean_driver_type + public :: fmsconstants_init public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up public :: update_atmos_model_radiation, update_atmos_model_state @@ -115,82 +120,48 @@ module full_coupler_mod public :: atm_lnd_bnd_type_chksum, land_data_type_chksum public :: ice_data_type_chksum, ocn_ice_bnd_type_chksum public :: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum - public :: ocean_ice_boundary_type, atmos_ice_boundary_type public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum public :: coupler_init, coupler_end, coupler_restart - public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, coupler_set_clock_ids + public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum !----------------------------------------------------------------------- character(len=128), public :: version = '$Id$' character(len=128), public :: tag = '$Name$' -!----------------------------------------------------------------------- -!---- model defined-types ---- - - type (atmos_data_type), public :: Atm - type (land_data_type), public :: Land - type (ice_data_type), public :: Ice - ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target, public :: Ocean - type (ocean_state_type), pointer, public :: Ocean_state => NULL() - - type(atmos_land_boundary_type), public :: Atmos_land_boundary - type(atmos_ice_boundary_type), public :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type), public :: Land_ice_atmos_boundary - type(land_ice_boundary_type), public :: Land_ice_boundary - type(ice_ocean_boundary_type), public :: Ice_ocean_boundary - type(ocean_ice_boundary_type), public :: Ocean_ice_boundary - type(ice_ocean_driver_type), pointer, public :: ice_ocean_driver_CS => NULL() - -!----------------------------------------------------------------------- -! ----- coupled model time ----- - - type(FmsTime_type), public :: Time, Time_init, Time_end - type(FmsTime_type), public :: Time_step_atmos, Time_step_cpld - type(FmsTime_type), public :: Time_atmos, Time_ocean - type(FmsTime_type), public :: Time_flux_ice_to_ocean, Time_flux_ocean_to_ice - - integer, public :: num_atmos_calls, na - integer, public :: num_cpld_calls, nc - - type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ice_bc_restart => NULL() - type(FmsNetcdfDomainFile_t), dimension(:), pointer, public :: Ocn_bc_restart => NULL() - - integer, public :: num_ice_bc_restart=0, num_ocn_bc_restart=0 - type(FmsTime_type), public :: Time_restart, Time_restart_current, Time_start - character(len=32), public :: timestamp - -! ----- coupled model initial date ----- - - integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) - integer :: calendar_type = INVALID_CALENDAR - -!----------------------------------------------------------------------- -!------ namelist interface ------- - - integer, dimension(6), public :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) !< The time interval that write out intermediate restart file. - !! The format is (yr,mo,day,hr,min,sec). When restart_interval - !! is all zero, no intermediate restart file will be written out - integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See - !! force_date_from_namelist.) - character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are - !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. - !! The value 'no_calendar' cannot be used because the time_manager's date - !! functions are used. All values must be lower case. - logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date should override - !! the date in the restart file `INPUT/coupler.res`. If the restart file does not - !! exist then force_date_from_namelist has no effect, the value of current_date - !! will be used. - integer :: months=0 !< Number of months the current integration will be run - integer :: days=0 !< Number of days the current integration will be run - integer :: hours=0 !< Number of hours the current integration will be run - integer :: minutes=0 !< Number of minutes the current integration will be run - integer :: seconds=0 !< Number of seconds the current integration will be run - integer, public :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fat coupling with land and sea ice - integer, public :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must be an - !! integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. + !> namelist interface + + !> The time interval that write out intermediate restart file. + !! The format is (yr,mo,day,hr,min,sec). When restart_interval + !! is all zero, no intermediate restart file will be written out + integer, dimension(6), public :: restart_interval = (/ 0, 0, 0, 0, 0, 0/) + + !> The date that the current integration starts with. (See + !! force_date_from_namelist.) + integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) + !< The calendar type used by the current integration. Valid values are + !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. + !! The value 'no_calendar' cannot be used because the time_manager's date + !! functions are used. All values must be lower case. + + character(len=17) :: calendar = ' ' + + !> Flag that determines whether the namelist variable current_date should override + !! the date in the restart file `INPUT/coupler.res`. If the restart file does not + !! exist then force_date_from_namelist has no effect, the value of current_date + !! will be used. + logical :: force_date_from_namelist = .false. + + integer, public :: months=0 !< Number of months the current integration will be run + integer, public :: days=0 !< Number of days the current integration will be run + integer, public :: hours=0 !< Number of hours the current integration will be run + integer, public :: minutes=0 !< Number of minutes the current integration will be run + integer, public :: seconds=0 !< Number of seconds the current integration will be run + integer, public :: dt_atmos = 0 !< Atmospheric model time step in seconds, including the fast + !! coupling with land and sea ice + integer, public :: dt_cpld = 0 !< Time step in seconds for coupling between ocean and atmospheric models. This must + !! be an integral multiple of dt_atmos and dt_ocean. This is the "slow" timestep. integer, public :: atmos_npes=0 !< The number of MPI tasks to use for the atmosphere integer, public :: ocean_npes=0 !< The number of MPI tasks to use for the ocean integer, public :: ice_npes=0 !< The number of MPI tasks to use for the ice @@ -198,39 +169,52 @@ module full_coupler_mod integer, public :: atmos_nthreads=1 !< Number of OpenMP threads to use in the atmosphere integer, public :: ocean_nthreads=1 !< Number of OpenMP threads to use in the ocean integer, public :: radiation_nthreads=1 !< Number of threads to use for the radiation. - logical, public :: do_atmos =.true. !< Indicates if this component should be executed. If .FALSE., then execution is skipped. - !! This is used when ALL the output fields sent by this component to the coupler have been - !! overridden using the data_override feature. This is for advanced users only. + + !> Indicates if this component should be executed. If .FALSE., then execution is skipped. + !! This is used when ALL the output fields sent by this component to the coupler have been + !! overridden using the data_override feature. This is for advanced users only. + logical, public :: do_atmos =.true. logical, public :: do_land =.true. !< See do_atmos logical, public :: do_ice =.true. !< See do_atmos logical, public :: do_ocean=.true. !< See do_atmos logical, public :: do_flux =.true. !< See do_atmos - logical, public :: concurrent=.FALSE. !< If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate - !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. - !! If .FALSE., the execution is serial: call atmos... followed by call ocean... + + !> If .TRUE., the ocean executes concurrently with the atmosphere-land-ice on a separate + !! set of PEs. Concurrent should be .TRUE. if concurrent_ice is .TRUE. + !! If .FALSE., the execution is serial: call atmos... followed by call ocean... + logical, public :: concurrent=.FALSE. logical, public :: do_concurrent_radiation=.FALSE. !< If .TRUE. then radiation is done concurrently - logical, public :: use_lag_fluxes=.TRUE. !< If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. - !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog - !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable - !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there - !! is probably sufficient damping for MOM4. For more modern ocean models (such as - !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. - !! should be much more stable. - logical, public :: concurrent_ice=.FALSE. !< If .TRUE., the slow sea-ice is forced with the fluxes that were used for the - !! fast ice processes one timestep before. When used in conjuction with setting - !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and - !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can - !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. - logical, public :: slow_ice_with_ocean=.FALSE. !< If true, the slow sea-ice is advanced on the ocean processors. Otherwise - !! the slow sea-ice processes are on the same PEs as the fast sea-ice. - logical, public :: combined_ice_and_ocean=.FALSE. !< If true, there is a single call from the coupler to advance - !! both the slow sea-ice and the ocean. slow_ice_with_ocean and - !! concurrent_ice must both be true if combined_ice_and_ocean is true. - logical, public :: do_chksum=.FALSE. !! If .TRUE., do multiple checksums throughout the execution of the model. - logical :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. - logical, public :: do_debug=.FALSE. !< If .TRUE. print additional debugging messages. - integer, public :: check_stocks = 0 !< -1: never 0: at end of run only n>0: every n coupled steps - logical :: use_hyper_thread = .false. + + !> If .TRUE., the ocean is forced with SBCs from one coupling timestep ago. + !! If .FALSE., the ocean is forced with most recent SBCs. For an old leapfrog + !! MOM4 coupling with dt_cpld=dt_ocean, lag fluxes can be shown to be stable + !! and current fluxes to be unconditionally unstable. For dt_cpld>dt_ocean there + !! is probably sufficient damping for MOM4. For more modern ocean models (such as + !! MOM5, GOLD or MOM6) that do not use leapfrog timestepping, use_lag_fluxes=.False. + !! should be much more stable. + logical, public :: use_lag_fluxes=.TRUE. + + !> If .TRUE., the slow sea-ice is forced with the fluxes that were used for the + !! fast ice processes one timestep before. When used in conjuction with setting + !! slow_ice_with_ocean=.TRUE., this approach allows the atmosphere and + !! ocean to run concurrently even if use_lag_fluxes=.FALSE., and it can + !! be shown to ameliorate or eliminate several ice-ocean coupled instabilities. + logical, public :: concurrent_ice=.FALSE. + + !> If true, the slow sea-ice is advanced on the ocean processors. Otherwise + !! the slow sea-ice processes are on the same PEs as the fast sea-ice. + logical, public :: slow_ice_with_ocean=.FALSE. + + !< If true, there is a single call from the coupler to advance + !! both the slow sea-ice and the ocean. slow_ice_with_ocean and + !! concurrent_ice must both be true if combined_ice_and_ocean is true. + logical, public :: combined_ice_and_ocean=.FALSE. + + logical, public :: do_chksum=.FALSE. !< If .TRUE., do multiple checksums throughout the execution of the model + logical, public :: do_endpoint_chksum=.TRUE. !< If .TRUE., do checksums of the initial and final states. + logical, public :: do_debug=.FALSE.!< If .TRUE. print additional debugging messages. + integer, public :: check_stocks = 0 !< -1: never 0: at end of run only n>0: every n coupled steps + logical, public :: use_hyper_thread = .false. namelist /coupler_nml/ current_date, calendar, force_date_from_namelist, & months, days, hours, minutes, seconds, dt_cpld, dt_atmos, & @@ -242,8 +226,8 @@ module full_coupler_mod use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean - public :: full_coupler_clock_type - type full_coupler_clock_type + public :: coupler_clock_type + type coupler_clock_type integer :: initialization integer :: main integer :: generate_sfc_xgrid @@ -283,31 +267,56 @@ module full_coupler_mod integer :: ice_model_init integer :: ocean_model_init integer :: flux_exchange_init - end type full_coupler_clock_type + end type coupler_clock_type - type(full_coupler_clock_type), public :: coupler_clocks + type(coupler_clock_type), public :: coupler_clocks - character(len=80), public :: text - character(len=48), parameter :: mod_name = 'full_coupler_mod' + character(len=80) :: text + character(len=48), parameter :: mod_name = 'coupler_main_mod' - integer, public :: outunit - integer :: ensemble_id = 1 - integer, allocatable :: ensemble_pelist(:, :) - integer, allocatable, public :: slow_ice_ocean_pelist(:) - integer, public :: conc_nthreads = 1 - real, public :: dsec, omp_sec(2)=0.0, imb_sec(2)=0.0 + integer :: calendar_type = INVALID_CALENDAR + + !> coupled model initial date + integer :: date_init(6) = (/ 0, 0, 0, 0, 0, 0 /) contains !####################################################################### !> \brief Initialize all defined exchange grids and all boundary maps - subroutine coupler_init - - use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_id,ensemble_pelist_setup - use ensemble_manager_mod, only : get_ensemble_size, get_ensemble_pelist + subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & + Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & + Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & + id_atmos_model_init, id_land_model_init, id_ice_model_init, id_ocean_model_init, & + id_flux_exchange_init, mainClock, termClock, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & + num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) + implicit none + type(atmos_data_type), intent(inout) :: Atm + type(land_data_type), intent(inout) :: Land + type(ice_data_type), intent(inout) :: Ice + type(ocean_public_type), intent(inout) :: Ocean + type(ocean_state_type), pointer, intent(inout) :: Ocean_state + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary + type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary + type(ocean_ice_boundary_type), intent(inout) :: Ocean_ice_boundary + type(land_ice_boundary_type), intent(inout) :: Land_ice_boundary + type(ice_ocean_driver_type), pointer, intent(inout) :: Ice_ocean_driver_CS + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary + type(FmsNetcdfDomainFile_t), pointer, dimension(:), intent(inout) :: Ice_bc_restart, Ocn_bc_restart + + integer, intent(inout) :: conc_nthreads + integer, allocatable, dimension(:,:), intent(inout) :: ensemble_pelist + integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist + integer, intent(inout) :: id_atmos_model_init, id_land_model_init + integer, intent(inout) :: id_ocean_model_init, id_flux_exchange_init, id_ice_model_init + integer, intent(inout) :: mainClock, termClock + type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean + type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart, Time_restart_current + + integer, intent(inout) :: num_cpld_calls, num_atmos_calls ! !----------------------------------------------------------------------- ! local parameters @@ -327,6 +336,7 @@ subroutine coupler_init integer :: pe, npes integer :: ens_siz(6), ensemble_size + integer :: ensemble_id = 1 integer :: atmos_pe_start=0, atmos_pe_end=0, & ocean_pe_start=0, ocean_pe_end=0 @@ -345,13 +355,17 @@ subroutine coupler_init integer :: time_stamp_unit !< Unif of the time_stamp file integer :: ascii_unit !< Unit of a dummy ascii file + type(FmsTime_type) :: Time_init + type(FmsCoupler1dBC_type), pointer :: & gas_fields_atm => NULL(), & ! A pointer to the type describing the - ! atmospheric fields that will participate in the gas fluxes. + ! atmospheric fields that will participate in the gas fluxes. gas_fields_ocn => NULL(), & ! A pointer to the type describing the ocean - ! and ice surface fields that will participate in the gas fluxes. - gas_fluxes => NULL() ! A pointer to the type describing the - ! atmosphere-ocean gas and tracer fluxes. + ! and ice surface fields that will participate in the gas fluxes. + gas_fluxes => NULL() ! A pointer to the type describing the + ! atmosphere-ocean gas and tracer fluxes. + + integer :: num_ice_bc_restart, num_ocn_bc_restart !----------------------------------------------------------------------- outunit = fms_mpp_stdout() @@ -450,7 +464,7 @@ subroutine coupler_init write(errunit,*) 'Finished initializing ensemble_manager at '& //trim(walldate)//' '//trim(walltime) endif - ens_siz = get_ensemble_size() + ens_siz = fms_ensemble_manager_get_ensemble_size() ensemble_size = ens_siz(1) npes = ens_siz(2) @@ -492,8 +506,9 @@ subroutine coupler_init !set up affinities based on threads - ensemble_id = get_ensemble_id() + ensemble_id = fms_ensemble_manager_get_ensemble_id() + if(allocated(ensemble_pelist)) call fms_mpp_error(FATAL, 'ensemble_pelist unexpectedly has already been allocated') allocate(ensemble_pelist(1:ensemble_size,1:npes)) call fms_ensemble_manager_get_ensemble_pelist(ensemble_pelist) @@ -515,7 +530,11 @@ subroutine coupler_init allocate( Ice%slow_pelist(ice_npes) ) Ice%slow_pelist(:) = Ice%fast_pelist(:) if(concurrent) then - allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) + if(.not.allocated(slow_ice_ocean_pelist)) then + allocate(slow_ice_ocean_pelist(ocean_npes+ice_npes)) + else + call fms_mpp_error(FATAL, 'allocation of slow_ice_ocean_pelist unexpectedly has already been allocated') + end if slow_ice_ocean_pelist(1:ice_npes) = Ice%slow_pelist(:) slow_ice_ocean_pelist(ice_npes+1:ice_npes+ocean_npes) = Ocean%pelist(:) else @@ -592,9 +611,7 @@ subroutine coupler_init endif !> The pelists need to be set before initializing the clocks - call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, & - slow_ice_ocean_pelist, ensemble_pelist, ensemble_id, & - do_concurrent_radiation, clock_type='init_model_clocks') + call coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set='model_init_clocks') !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -764,7 +781,8 @@ subroutine coupler_init !----------------------------------------------------------------------- !----- write time stamps (for start time and end time) ------ - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) & + open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') month = fms_time_manager_month_name(date(2)) if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) @@ -971,9 +989,7 @@ subroutine coupler_init endif ! end of Ocean%is_ocean_pe - call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, & - slow_ice_ocean_pelist, ensemble_pelist, ensemble_id, & - do_concurrent_radiation, clock_type='init_coupler_clocks') + call coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set='coupler_clocks') !--------------------------------------------- if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -1096,9 +1112,27 @@ end subroutine coupler_init !####################################################################### - subroutine coupler_end() + subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& + Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & + Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current) -!----------------------------------------------------------------------- + implicit none + + type(atmos_data_type), intent(inout) :: Atm + type(land_data_type), intent(inout) :: Land + type(ice_data_type), intent(inout) :: Ice + type(ocean_public_type), intent(inout) :: Ocean + type(ocean_state_type), pointer, intent(inout) :: Ocean_state + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary + type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary + type(ocean_ice_boundary_type), intent(inout) :: Ocean_ice_boundary + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ocn_bc_restart + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart + + type(FmsTime_type), intent(in) :: Time, Time_start, Time_end, Time_restart_current + integer :: num_ice_bc_restart, num_ocn_bc_restart if ( do_endpoint_chksum ) then if (Atm%pe) then @@ -1148,7 +1182,8 @@ subroutine coupler_end() endif !----- write restart file ------ - call coupler_restart(Time, Time_restart_current) + call coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & + Time, Time_restart_current, Time_start, Time_end) call fms_diag_end (Time) #ifdef use_deprecated_io @@ -1176,15 +1211,29 @@ subroutine add_domain_dimension_data(fileobj) call fms2_io_write_data(fileobj, "yaxis_1", buffer) deallocate(buffer) - end subroutine add_domain_dimension_data + end subroutine add_domain_dimension_data !> \brief Writing restart file that contains running time and restart file writing time. - subroutine coupler_restart(Time_run, Time_res, time_stamp) - type(FmsTime_type), intent(in) :: Time_run, Time_res + subroutine coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & + Time_run, Time_res, Time_start, Time_end, time_stamp) + + implicit none + + type(atmos_data_type), intent(inout) :: Atm + type(ice_data_type), intent(inout) :: Ice + type(ocean_public_type), intent(inout) :: Ocean + + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ocn_bc_restart + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart + + type(FmsTime_type), intent(in) :: Time_run, Time_res, Time_start, Time_end character(len=*), intent(in), optional :: time_stamp - character(len=128) :: file_run, file_res + + character(len=128) :: file_run, file_res + integer :: yr, mon, day, hr, min, sec, date(6), n + integer :: num_ice_bc_restart, num_ocn_bc_restart integer :: restart_unit !< Unit for the coupler restart file call fms_mpp_set_current_pelist() @@ -1258,7 +1307,13 @@ end subroutine coupler_restart !-------------------------------------------------------------------------- !> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(id, timestep) + subroutine coupler_chksum(id, timestep, Atm, Land, Ice) + + implicit none + + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ice_data_type), intent(in) :: Ice character(len=*), intent(in) :: id integer , intent(in) :: timestep @@ -1467,113 +1522,109 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine coupler_set_clock_ids(coupler_clocks_in, Atm_in, Land_in, Ice_in, Ocean_in, & - slow_ice_ocean_pelist_in, ensemble_pelist_in, ensemble_id, & - do_concurrent_radiation_in, clock_type) + subroutine coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set) implicit none - - type(full_coupler_clock_type), intent(inout) :: coupler_clocks_in - type(atmos_data_type), intent(in) :: Atm_in - type(land_data_type), intent(in) :: Land_in - type(ice_data_type), intent(in) :: Ice_in - type(ocean_public_type), intent(in) :: Ocean_in - integer, intent(in), dimension(:) :: slow_ice_ocean_pelist_in - integer, intent(in), dimension(:,:) :: ensemble_pelist_in - integer, intent(in) :: ensemble_id - logical, intent(in) :: do_concurrent_radiation_in - character(len=*), intent(in) :: clock_type - - if( trim(clock_type) == 'init_model_clocks' ) then + + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ocean_public_type), intent(in) :: Ocean + type(ice_data_type), intent(in) :: Ice + integer, dimension(:), intent(in) :: slow_ice_ocean_pelist + integer, dimension(:,:), intent(in) :: ensemble_pelist + integer, intent(in) :: ensemble_id + character(len=*), intent(in) :: clock_set + + if( trim(clock_set) == 'model_init_clocks' ) then !> initialization clock - if (Atm_in%pe) then - call fms_mpp_set_current_pelist(Atm_in%pelist) - coupler_clocks_in%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) endif - if (Land_in%pe) then - call fms_mpp_set_current_pelist(Land_in%pelist) - coupler_clocks_in%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) endif - if (Ice_in%pe) then - if (Ice_in%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice_in%pelist) - elseif (Ice_in%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice_in%fast_pelist) - elseif (Ice_in%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice_in%slow_pelist) + if (Ice%pe) then + if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) + elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") endif - coupler_clocks_in%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) endif - if (Ocean_in%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean_in%pelist) - coupler_clocks_in%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) endif - call fms_mpp_set_current_pelist(ensemble_pelist_in(ensemble_id,:)) - coupler_clocks_in%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) call fms_mpp_set_current_pelist() - coupler_clocks_in%main = fms_mpp_clock_id( 'Main loop' ) - coupler_clocks_in%termination = fms_mpp_clock_id( 'Termination' ) + coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) + coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) - else if( trim(clock_type) == 'init_coupler_clocks' ) then - If(Atm_in%pe) then - call fms_mpp_set_current_pelist(Atm_in%pelist) - coupler_clocks_in%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) + else if( trim(clock_set) == 'coupler_clocks' ) then + If(Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) end if - if (Ice_in%slow_ice_PE .or. Ocean_in%is_ocean_pe) then - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist_in) - coupler_clocks_in%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) - coupler_clocks_in%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) + if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) + coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) + coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) endif - if (Atm_in%pe) then - call fms_mpp_set_current_pelist(Atm_in%pelist) - coupler_clocks_in%atm = fms_mpp_clock_id( 'ATM' ) - coupler_clocks_in%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) - coupler_clocks_in%atmos_tracer_driver_gather_data & + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) + coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) + coupler_clocks%atmos_tracer_driver_gather_data & = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) - coupler_clocks_in%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) - coupler_clocks_in%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') - if (.not. do_concurrent_radiation_in) & - coupler_clocks_in%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) - coupler_clocks_in%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) - coupler_clocks_in%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) - coupler_clocks_in%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) - coupler_clocks_in%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) - coupler_clocks_in%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) - coupler_clocks_in%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) - if (do_concurrent_radiation_in) then - coupler_clocks_in%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) - coupler_clocks_in%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) + coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) + coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') + if (.not. do_concurrent_radiation) & + coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) + coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) + coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) + coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) + coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) + coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) + if (do_concurrent_radiation) then + coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) endif - coupler_clocks_in%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') - coupler_clocks_in%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) - coupler_clocks_in%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) + coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') + coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) + coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) endif - if (Ice_in%pe) then - if (Ice_in%fast_ice_pe) call fms_mpp_set_current_pelist(Ice_in%fast_pelist) - coupler_clocks_in%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) - coupler_clocks_in%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) + if (Ice%pe) then + if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) + coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) + coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) - if (Ice_in%slow_ice_pe) call fms_mpp_set_current_pelist(Ice_in%slow_pelist) - coupler_clocks_in%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) - coupler_clocks_in%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) - coupler_clocks_in%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) + if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) + coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) + coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) + coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) - call fms_mpp_set_current_pelist(Ice_in%pelist) - coupler_clocks_in%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) - coupler_clocks_in%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) + call fms_mpp_set_current_pelist(Ice%pelist) + coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) + coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) endif - if (Ocean_in%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean_in%pelist) - coupler_clocks_in%ocean = fms_mpp_clock_id( 'OCN' ) + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) endif call fms_mpp_set_current_pelist() - coupler_clocks_in%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) - coupler_clocks_in%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) - coupler_clocks_in%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) + coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) + coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) + coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) else - call fms_mpp_error(FATAL, 'clock_type not recognized in coupler_set_clock_ids') + call fms_mpp_error(FATAL, 'clock_set not recognized in coupler_set_clock_ids') end if From 04f5ca28d4f5be2cd37aaa431007e49d26ef3b97 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 9 May 2024 10:55:41 -0400 Subject: [PATCH 53/78] make coupler_clocks program variable --- full/coupler_main.F90 | 22 +++++++--------------- full/flux_exchange.F90 | 10 +++++----- full/full_coupler_mod.F90 | 26 ++++++++++++-------------- 3 files changed, 24 insertions(+), 34 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 4d2669a8..be68d6b2 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -331,6 +331,7 @@ !! This error should probably not occur because of checks done at initialization time. program coupler_main + !--- F90 module for OpenMP use omp_lib use FMS use full_coupler_mod @@ -369,15 +370,8 @@ program coupler_main type(FmsTime_type) :: Time_restart_current character(len=32) :: timestamp - integer :: initClock, mainClock, termClock - integer :: newClock0, newClock1, newClock2, newClock3, newClock4, newClock5, newClock7 - integer :: newClock6f, newClock6s, newClock6e, newClock10f, newClock10s, newClock10e - integer :: newClock8, newClock9, newClock11, newClock12, newClock13, newClock14, newClocka - integer :: newClockb, newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki - integer :: newClockj, newClockk, newClockl - integer :: id_atmos_model_init, id_land_model_init, id_ice_model_init - integer :: id_ocean_model_init, id_flux_exchange_init - + type(coupler_clock_type) :: coupler_clocks + integer :: outunit character(len=80) :: text integer, allocatable :: ensemble_pelist(:, :) @@ -421,6 +415,7 @@ program coupler_main call fms_mpp_init() + !this clock is on the global pelist coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) call fms_mpp_clock_begin(coupler_clocks%initialization) @@ -428,14 +423,11 @@ program coupler_main call fmsconstants_init call fms_affinity_init - call coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & - Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & + Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, & - conc_nthreads, id_atmos_model_init, id_land_model_init, & - id_ice_model_init, id_ocean_model_init, id_flux_exchange_init, mainClock, termClock, & - Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, num_atmos_calls, & - Time, Time_start, Time_end, Time_restart, Time_restart_current) + conc_nthreads, coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & + num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) diff --git a/full/flux_exchange.F90 b/full/flux_exchange.F90 index c1ac8381..35abf236 100644 --- a/full/flux_exchange.F90 +++ b/full/flux_exchange.F90 @@ -780,11 +780,11 @@ end subroutine flux_exchange_init subroutine flux_check_stocks(Time, Atm, Lnd, Ice, Ocn_state) - type(FmsTime_type), intent(in) :: Time - type(atmos_data_type), intent(inout), optional :: Atm - type(land_data_type), intent(inout), optional :: Lnd - type(ice_data_type), intent(inout), optional :: Ice - type(ocean_state_type), intent(inout), optional, pointer :: Ocn_state + type(FmsTime_type) :: Time + type(atmos_data_type), optional :: Atm + type(land_data_type), optional :: Lnd + type(ice_data_type), optional :: Ice + type(ocean_state_type), optional, pointer :: Ocn_state real :: ref_value integer :: i diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 6425d79b..b9d0d472 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -226,7 +226,6 @@ module full_coupler_mod use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean - public :: coupler_clock_type type coupler_clock_type integer :: initialization integer :: main @@ -269,8 +268,6 @@ module full_coupler_mod integer :: flux_exchange_init end type coupler_clock_type - type(coupler_clock_type), public :: coupler_clocks - character(len=80) :: text character(len=48), parameter :: mod_name = 'coupler_main_mod' @@ -285,11 +282,10 @@ module full_coupler_mod !> \brief Initialize all defined exchange grids and all boundary maps subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & - Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & - Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & - id_atmos_model_init, id_land_model_init, id_ice_model_init, id_ocean_model_init, & - id_flux_exchange_init, mainClock, termClock, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & - num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) + Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & + Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & + coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & + num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) implicit none @@ -310,9 +306,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer, intent(inout) :: conc_nthreads integer, allocatable, dimension(:,:), intent(inout) :: ensemble_pelist integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist - integer, intent(inout) :: id_atmos_model_init, id_land_model_init - integer, intent(inout) :: id_ocean_model_init, id_flux_exchange_init, id_ice_model_init - integer, intent(inout) :: mainClock, termClock + type(coupler_clock_type) :: coupler_clocks type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart, Time_restart_current @@ -611,7 +605,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, endif !> The pelists need to be set before initializing the clocks - call coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set='model_init_clocks') + call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist, & + slow_ice_ocean_pelist, ensemble_id, clock_set='model_init_clocks') !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -989,7 +984,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, endif ! end of Ocean%is_ocean_pe - call coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set='coupler_clocks') + call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist, & + slow_ice_ocean_pelist, ensemble_id, clock_set='coupler_clocks') !--------------------------------------------- if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -1522,10 +1518,12 @@ subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine coupler_set_clock_ids(Atm, Land, Ice, Ocean, ensemble_pelist, slow_ice_ocean_pelist, ensemble_id, clock_set) + subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist,& + slow_ice_ocean_pelist, ensemble_id, clock_set) implicit none + type(coupler_clock_type), intent(inout) :: coupler_clocks type(atmos_data_type), intent(in) :: Atm type(land_data_type), intent(in) :: Land type(ocean_public_type), intent(in) :: Ocean From cb7721b66731620a35ca2f565c1fc644af39450b Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 9 May 2024 13:18:40 -0400 Subject: [PATCH 54/78] make clock type public --- full/full_coupler_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index b9d0d472..e6ea3ee4 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -125,6 +125,8 @@ module full_coupler_mod public :: coupler_init, coupler_end, coupler_restart public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum + public :: coupler_clock_type + !----------------------------------------------------------------------- character(len=128), public :: version = '$Id$' @@ -226,7 +228,7 @@ module full_coupler_mod use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean - type coupler_clock_type + type coupler_clock_type integer :: initialization integer :: main integer :: generate_sfc_xgrid From ae1d8047485eacc319dc26037f01f65769ce0b9c Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 12:51:46 -0400 Subject: [PATCH 55/78] add coupler_full_chksum --- full/coupler_main.F90 | 36 ++++-------------------- full/full_coupler_mod.F90 | 58 +++++++++++++++++++++++++++------------ 2 files changed, 46 insertions(+), 48 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index be68d6b2..eab481b3 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -429,8 +429,6 @@ program coupler_main conc_nthreads, coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) - if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) - call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization @@ -445,21 +443,10 @@ program coupler_main endif do nc = 1, num_cpld_calls - if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice) - call fms_mpp_set_current_pelist() - if (do_chksum) then - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum('MAIN_LOOP-', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum('MAIN_LOOP-', nc, Ocean, Ice_ocean_boundary) - endif - call fms_mpp_set_current_pelist() - endif + if (do_chksum) call coupler_full_chksum('MAIN_LOOP-', nc, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & + Ocean, Ice_ocean_boundary) ! Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication ! points when running concurrently. The calls are placed next to each other in @@ -485,20 +472,9 @@ program coupler_main endif endif - if (do_chksum) then - call coupler_chksum('flux_ocn2ice+', nc, Atm, Land, Ice) - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum('fluxocn2ice+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_public_type_chksum('fluxocn2ice+', nc, Ocean) - endif - call fms_mpp_set_current_pelist() - endif - + if (do_chksum) call coupler_full_chksum('flux_ocn2ice+', nc, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + ! To print the value of frazil heat flux at the right time the following block ! needs to sit here rather than at the end of the coupler loop. if (check_stocks > 0) then diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index f0f4d825..59b8b498 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -123,7 +123,7 @@ module full_coupler_mod public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum public :: coupler_init, coupler_end, coupler_restart - public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum + public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, coupler_full_chksum public :: coupler_clock_type @@ -1081,23 +1081,9 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, CALL fms_diag_grid_end() !----------------------------------------------------------------------- - if ( do_endpoint_chksum ) then - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum('coupler_init+', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ice%slow_ice_PE) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum('coupler_init+', 0, Ocean, Ice_ocean_boundary) - endif - endif - - call fms_mpp_set_current_pelist() + if ( do_endpoint_chksum ) call full_coupler_chksum('coupler_init+', 0, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + call fms_memutils_print_memuse_stats('coupler_init') if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -1354,6 +1340,7 @@ subroutine coupler_chksum(id, timestep, Atm, Land, Ice) write(outunit,100) 'atm%t_bot', fms_mpp_chksum(atm%t_bot) write(outunit,100) 'atm%z_bot', fms_mpp_chksum(atm%z_bot) write(outunit,100) 'atm%p_bot', fms_mpp_chksum(atm%p_bot) + write(outunit,100) 'atm%u_bot', fms_mpp_chksum(atm%u_bot) write(outunit,100) 'atm%v_bot', fms_mpp_chksum(atm%v_bot) write(outunit,100) 'atm%p_surf', fms_mpp_chksum(atm%p_surf) @@ -1629,4 +1616,39 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble end subroutine coupler_set_clock_ids +!> \brief This subroutine sets the ID for clocks used in coupler_main + subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boundary, & + Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + + implicit none + + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type(atm_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ice_data_type), intent(in) :: Ice + type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary + type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary + type(atmos_land_boundary), intent(in) :: Atmos_land_boundary + type(ocean_public_type), intent(in) :: Ocean + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + + + call coupler_chksum(trim(id), timestep, Atm, Land, Ice) + + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum(trim(id), timestep, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_chksum(trim(id), timestep, Ocean, Ice_ocean_boundary) + endif + + call fms_mpp_set_current_pelist() + + end subroutine coupler_full_chksum + + end module full_coupler_mod From 660477cde84c6583428edd1233f6f8ea4940fd95 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 12:55:02 -0400 Subject: [PATCH 56/78] Revert "add coupler_full_chksum" This reverts commit ae1d8047485eacc319dc26037f01f65769ce0b9c. --- full/coupler_main.F90 | 36 ++++++++++++++++++++---- full/full_coupler_mod.F90 | 58 ++++++++++++--------------------------- 2 files changed, 48 insertions(+), 46 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index eab481b3..be68d6b2 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -429,6 +429,8 @@ program coupler_main conc_nthreads, coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) + if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) + call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization @@ -443,10 +445,21 @@ program coupler_main endif do nc = 1, num_cpld_calls + if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice) + call fms_mpp_set_current_pelist() - if (do_chksum) call coupler_full_chksum('MAIN_LOOP-', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & - Ocean, Ice_ocean_boundary) + if (do_chksum) then + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum('MAIN_LOOP-', nc, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_chksum('MAIN_LOOP-', nc, Ocean, Ice_ocean_boundary) + endif + call fms_mpp_set_current_pelist() + endif ! Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication ! points when running concurrently. The calls are placed next to each other in @@ -472,9 +485,20 @@ program coupler_main endif endif - if (do_chksum) call coupler_full_chksum('flux_ocn2ice+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) - + if (do_chksum) then + call coupler_chksum('flux_ocn2ice+', nc, Atm, Land, Ice) + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum('fluxocn2ice+', nc, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_public_type_chksum('fluxocn2ice+', nc, Ocean) + endif + call fms_mpp_set_current_pelist() + endif + ! To print the value of frazil heat flux at the right time the following block ! needs to sit here rather than at the end of the coupler loop. if (check_stocks > 0) then diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 59b8b498..f0f4d825 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -123,7 +123,7 @@ module full_coupler_mod public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum public :: coupler_init, coupler_end, coupler_restart - public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, coupler_full_chksum + public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum public :: coupler_clock_type @@ -1081,9 +1081,23 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, CALL fms_diag_grid_end() !----------------------------------------------------------------------- - if ( do_endpoint_chksum ) call full_coupler_chksum('coupler_init+', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) - + if ( do_endpoint_chksum ) then + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum('coupler_init+', 0, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ice%slow_ice_PE) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_chksum('coupler_init+', 0, Ocean, Ice_ocean_boundary) + endif + endif + + call fms_mpp_set_current_pelist() call fms_memutils_print_memuse_stats('coupler_init') if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -1340,7 +1354,6 @@ subroutine coupler_chksum(id, timestep, Atm, Land, Ice) write(outunit,100) 'atm%t_bot', fms_mpp_chksum(atm%t_bot) write(outunit,100) 'atm%z_bot', fms_mpp_chksum(atm%z_bot) write(outunit,100) 'atm%p_bot', fms_mpp_chksum(atm%p_bot) - write(outunit,100) 'atm%u_bot', fms_mpp_chksum(atm%u_bot) write(outunit,100) 'atm%v_bot', fms_mpp_chksum(atm%v_bot) write(outunit,100) 'atm%p_surf', fms_mpp_chksum(atm%p_surf) @@ -1616,39 +1629,4 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble end subroutine coupler_set_clock_ids -!> \brief This subroutine sets the ID for clocks used in coupler_main - subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boundary, & - Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) - - implicit none - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(atm_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice - type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary - type(atmos_land_boundary), intent(in) :: Atmos_land_boundary - type(ocean_public_type), intent(in) :: Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - - - call coupler_chksum(trim(id), timestep, Atm, Land, Ice) - - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum(trim(id), timestep, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum(trim(id), timestep, Ocean, Ice_ocean_boundary) - endif - - call fms_mpp_set_current_pelist() - - end subroutine coupler_full_chksum - - end module full_coupler_mod From 12f8fe1a30318aea5fdebdeca366a07239d5e2a5 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 13:48:24 -0400 Subject: [PATCH 57/78] fix typos --- full/full_coupler_mod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 59b8b498..0f096b7d 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1081,7 +1081,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, CALL fms_diag_grid_end() !----------------------------------------------------------------------- - if ( do_endpoint_chksum ) call full_coupler_chksum('coupler_init+', 0, Atm, Land, Ice, & + if ( do_endpoint_chksum ) call coupler_full_chksum('coupler_init+', 0, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) call fms_memutils_print_memuse_stats('coupler_init') @@ -1624,14 +1624,14 @@ subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boun character(len=*), intent(in) :: id integer , intent(in) :: timestep - type(atm_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ice_data_type), intent(in) :: Ice type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary - type(atmos_land_boundary), intent(in) :: Atmos_land_boundary - type(ocean_public_type), intent(in) :: Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary + type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary + type(ocean_public_type), intent(in) :: Ocean + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary call coupler_chksum(trim(id), timestep, Atm, Land, Ice) From 6fd7694718ea267cc479504e29264df8b811746d Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 14:24:47 -0400 Subject: [PATCH 58/78] restore flux clocks --- full/flux_exchange.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/full/flux_exchange.F90 b/full/flux_exchange.F90 index c1ac8381..35abf236 100644 --- a/full/flux_exchange.F90 +++ b/full/flux_exchange.F90 @@ -780,11 +780,11 @@ end subroutine flux_exchange_init subroutine flux_check_stocks(Time, Atm, Lnd, Ice, Ocn_state) - type(FmsTime_type), intent(in) :: Time - type(atmos_data_type), intent(inout), optional :: Atm - type(land_data_type), intent(inout), optional :: Lnd - type(ice_data_type), intent(inout), optional :: Ice - type(ocean_state_type), intent(inout), optional, pointer :: Ocn_state + type(FmsTime_type) :: Time + type(atmos_data_type), optional :: Atm + type(land_data_type), optional :: Lnd + type(ice_data_type), optional :: Ice + type(ocean_state_type), optional, pointer :: Ocn_state real :: ref_value integer :: i From da4b5651be19990093b80db595cb21b682b5ca42 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 14:25:59 -0400 Subject: [PATCH 59/78] restore flux clocks --- full/atm_land_ice_flux_exchange.F90 | 17 ++++++++++++++++- full/ice_ocean_flux_exchange.F90 | 9 ++++++++- full/land_ice_flux_exchange.F90 | 5 ++++- 3 files changed, 28 insertions(+), 3 deletions(-) diff --git a/full/atm_land_ice_flux_exchange.F90 b/full/atm_land_ice_flux_exchange.F90 index 11dab430..7da5221b 100644 --- a/full/atm_land_ice_flux_exchange.F90 +++ b/full/atm_land_ice_flux_exchange.F90 @@ -261,7 +261,7 @@ module atm_land_ice_flux_exchange_mod ! REDIST: same physical grid, different decomposition, must move data around ! DIRECT: same physical grid, same domain decomposition, can directly copy data integer, parameter :: REGRID=1, REDIST=2, DIRECT=3 - integer :: cplClock + integer :: cplClock, sfcClock, fluxAtmDnClock, regenClock, fluxAtmUpClock ! Exchange grid indices integer :: X1_GRID_ATM, X1_GRID_ICE, X1_GRID_LND @@ -624,6 +624,12 @@ subroutine atm_land_ice_flux_exchange_init(Time, Atm, Land, Ice, atmos_ice_bound call fms_mpp_domains_get_compute_domain(Land%domain, xsize=nxc_lnd, ysize=nyc_lnd) endif + !Balaji: clocks on atm%pe only + sfcClock = fms_mpp_clock_id( 'SFC boundary layer', flags=fms_clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + fluxAtmDnClock = fms_mpp_clock_id( 'Flux DN from atm', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) + regenClock = fms_mpp_clock_id( 'XGrid generation', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) + fluxAtmUpClock = fms_mpp_clock_id( 'Flux UP to atm', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) + do_init = .false. end subroutine atm_land_ice_flux_exchange_init @@ -721,6 +727,7 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar 'must call atm_land_ice_flux_exchange_init first', FATAL) !Balaji call fms_mpp_clock_begin(cplClock) + call fms_mpp_clock_begin(sfcClock) ! [2] allocate storage for variables that are also used in flux_up_to_atmos allocate ( & ex_t_surf (n_xgrid_sfc), & @@ -1216,6 +1223,7 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar #endif + ! call mpp_clock_end(fluxClock) zrefm = 10.0 zrefh = z_ref_heat ! ---- optimize calculation ---- @@ -1924,6 +1932,7 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar endif !Balaji + call fms_mpp_clock_end(sfcClock) call fms_mpp_clock_end(cplClock) !======================================================================= @@ -2022,6 +2031,7 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun !Balaji call fms_mpp_clock_begin(cplClock) + call fms_mpp_clock_begin(fluxAtmDnClock) ov = .FALSE. !----------------------------------------------------------------------- !Balaji: fms_data_override calls moved here from coupler_main @@ -2681,6 +2691,7 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun used = fms_diag_send_data ( id_tauv, -Atmos_boundary%v_flux, Time ) !Balaji + call fms_mpp_clock_end(fluxAtmDnClock) call fms_mpp_clock_end(cplClock) !======================================================================= @@ -2699,6 +2710,7 @@ subroutine generate_sfc_xgrid( Land, Ice ) !Balaji call fms_mpp_clock_begin(cplClock) + call fms_mpp_clock_begin(regenClock) call fms_mpp_domains_get_compute_domain(Ice%Domain, isc, iec, jsc, jec) @@ -2719,6 +2731,7 @@ subroutine generate_sfc_xgrid( Land, Ice ) endif !Balaji + call fms_mpp_clock_end(regenClock) call fms_mpp_clock_end(cplClock) return end subroutine generate_sfc_xgrid @@ -2785,6 +2798,7 @@ subroutine flux_up_to_atmos ( Time, Land, Ice, Land_Ice_Atmos_Boundary, Land_bou !Balaji call fms_mpp_clock_begin(cplClock) + call fms_mpp_clock_begin(fluxAtmUpClock) !----------------------------------------------------------------------- !Balaji: data_override calls moved here from coupler_main call fms_data_override ( 'ICE', 't_surf', Ice%t_surf, Time) @@ -3190,6 +3204,7 @@ subroutine flux_up_to_atmos ( Time, Land, Ice, Land_Ice_Atmos_Boundary, Land_bou & radius=Radius, ier=ier, verbose='stock move EVAP*HLV (Ice->ATm) ') !Balaji + call fms_mpp_clock_end(fluxAtmUpClock) call fms_mpp_clock_end(cplClock) end subroutine flux_up_to_atmos diff --git a/full/ice_ocean_flux_exchange.F90 b/full/ice_ocean_flux_exchange.F90 index b8d98473..a0219d9f 100644 --- a/full/ice_ocean_flux_exchange.F90 +++ b/full/ice_ocean_flux_exchange.F90 @@ -48,7 +48,7 @@ module ice_ocean_flux_exchange_mod logical :: debug_stocks = .false. logical :: do_area_weighted_flux = .false. - integer :: cplOcnClock + integer :: cplOcnClock, fluxOceanIceClock, fluxIceOceanClock real :: Dt_cpl integer, allocatable :: slow_ice_ocean_pelist(:) @@ -197,6 +197,8 @@ subroutine ice_ocean_flux_exchange_init(Time, Ice, Ocean, Ocean_state, ice_ocean slow_ice_ocean_pelist = slow_ice_ocean_pelist_in call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) cplOcnClock = fms_mpp_clock_id( 'Ice-ocean coupler', flags=fms_clock_flag_default, grain=CLOCK_COMPONENT ) + fluxIceOceanClock = fms_mpp_clock_id( 'Flux ice to ocean', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) + fluxOceanIceClock = fms_mpp_clock_id( 'Flux ocean to ice', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) endif end subroutine ice_ocean_flux_exchange_init @@ -235,6 +237,7 @@ subroutine flux_ice_to_ocean ( Time, Ice, Ocean, Ice_Ocean_Boundary ) logical :: used call fms_mpp_clock_begin(cplOcnClock) + call fms_mpp_clock_begin(fluxIceOceanClock) if(ASSOCIATED(Ice_Ocean_Boundary%u_flux) ) call flux_ice_to_ocean_redistribute( Ice, Ocean, & Ice%flux_u, Ice_Ocean_Boundary%u_flux, Ice_Ocean_Boundary%xtype, .FALSE. ) @@ -309,6 +312,8 @@ subroutine flux_ice_to_ocean ( Time, Ice, Ocean, Ice_Ocean_Boundary ) if(ASSOCIATED(Ice_Ocean_Boundary%q_flux) ) call flux_ice_to_ocean_redistribute( Ice, Ocean, & Ice%flux_q, Ice_Ocean_Boundary%q_flux, Ice_Ocean_Boundary%xtype, do_area_weighted_flux ) + call fms_mpp_clock_end(fluxIceOceanClock) + call fms_mpp_clock_end(cplOcnClock) !----------------------------------------------------------------------- end subroutine flux_ice_to_ocean @@ -384,6 +389,7 @@ subroutine flux_ocean_to_ice ( Time, Ocean, Ice, Ocean_Ice_Boundary ) logical :: used call fms_mpp_clock_begin(cplOcnClock) + call fms_mpp_clock_begin(fluxOceanIceClock) select case (Ocean_Ice_Boundary%xtype) case(DIRECT) @@ -441,6 +447,7 @@ subroutine flux_ocean_to_ice ( Time, Ocean, Ice, Ocean_Ice_Boundary ) call fms_mpp_error( FATAL, 'flux_ocean_to_ice: Ocean_Ice_Boundary%xtype must be DIRECT or REDIST.' ) end select + call fms_mpp_clock_end(fluxOceanIceClock) call fms_mpp_clock_end(cplOcnClock) !----------------------------------------------------------------------- diff --git a/full/land_ice_flux_exchange.F90 b/full/land_ice_flux_exchange.F90 index c31b9f0a..7a6e6312 100644 --- a/full/land_ice_flux_exchange.F90 +++ b/full/land_ice_flux_exchange.F90 @@ -42,7 +42,7 @@ module land_ice_flux_exchange_mod public :: flux_land_to_ice, land_ice_flux_exchange_init - integer :: cplClock + integer :: cplClock, fluxLandIceClock logical :: do_runoff real :: Dt_cpl contains @@ -61,6 +61,7 @@ subroutine land_ice_flux_exchange_init(Land, Ice, land_ice_boundary, Dt_cpl_in, do_runoff = do_runoff_in cplClock = cplClock_in Dt_cpl = Dt_cpl_in + fluxLandIceClock = fms_mpp_clock_id( 'Flux land to ice', flags=fms_clock_flag_default, grain=CLOCK_ROUTINE ) if (do_runoff) then call fms_xgrid_setup_xmap(xmap_runoff, (/ 'LND', 'OCN' /), & @@ -113,6 +114,7 @@ subroutine flux_land_to_ice( Time, Land, Ice, Land_Ice_Boundary ) !Balaji call fms_mpp_clock_begin(cplClock) + call fms_mpp_clock_begin(fluxLandIceClock) ! ccc = conservation_check(Land%discharge, 'LND', xmap_runoff) ! if (fms_mpp_pe()==fms_mpp_root_pe()) print *,'RUNOFF', ccc @@ -152,6 +154,7 @@ subroutine flux_land_to_ice( Time, Land, Ice, Land_Ice_Boundary ) Land_Ice_Boundary%calving_hflx = 0.0 endif + call fms_mpp_clock_end(fluxLandIceClock) call fms_mpp_clock_end(cplClock) end subroutine flux_land_to_ice From 5d2fb1739793e3352cb986d954990a91a9f2c067 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 14:33:29 -0400 Subject: [PATCH 60/78] fix comment --- full/full_coupler_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 59b8b498..9a589f80 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1616,7 +1616,7 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble end subroutine coupler_set_clock_ids -!> \brief This subroutine sets the ID for clocks used in coupler_main +!> \brief This subroutine calls coupler_chksum as well as atmos_ice_land_chksum and ocean_chksum subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boundary, & Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) From 365899a659ee739547fc04553ff66ed1c2ae250c Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 15:19:18 -0400 Subject: [PATCH 61/78] add coupler_stocks subroutines --- full/coupler_main.F90 | 26 ++++------------- full/full_coupler_mod.F90 | 60 +++++++++++++++++++++++++++++++++++++-- 2 files changed, 64 insertions(+), 22 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index eab481b3..cfa196f1 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -437,10 +437,8 @@ program coupler_main !----------------------------------------------------------------------- !------ ocean/slow-ice integration loop ------ - if (check_stocks >= 0) then - call fms_mpp_set_current_pelist() - call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state) - endif + if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & + coupler_clocks, init_stocks=.True.) do nc = 1, num_cpld_calls @@ -477,14 +475,7 @@ program coupler_main ! To print the value of frazil heat flux at the right time the following block ! needs to sit here rather than at the end of the coupler loop. - if (check_stocks > 0) then - call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks) - if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then - call fms_mpp_set_current_pelist() - call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) - endif - call fms_mpp_clock_end(coupler_clocks%flux_check_stocks) - endif + if (check_stocks > 0) call coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clock) if (do_ice .and. Ice%pe) then if (Ice%slow_ice_pe) then @@ -874,16 +865,11 @@ program coupler_main enddo 102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) - call fms_mpp_set_current_pelist() - call fms_mpp_clock_begin(coupler_clocks%final_flux_check_stocks) - if (check_stocks >= 0) then - call fms_mpp_set_current_pelist() - call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) - endif - call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks) + if( check_stocks >=0 ) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & + coupler_clocks, finish_stocks=.True.) - call fms_mpp_set_current_pelist() !----------------------------------------------------------------------- + call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%main) call fms_mpp_clock_begin(coupler_clocks%termination) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 0f096b7d..8b9cb2e5 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -108,7 +108,6 @@ module full_coupler_mod public :: flux_down_from_atmos, flux_up_to_atmos public :: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice public :: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish - public :: flux_check_stocks, flux_init_stocks public :: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks public :: flux_atmos_to_ocean, flux_ex_arrays_dealloc public :: atmos_tracer_driver_gather_data @@ -126,7 +125,8 @@ module full_coupler_mod public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, coupler_full_chksum public :: coupler_clock_type - + + public :: coupler_flux_init_finish_stocks, coupler_flux_check_stocks !----------------------------------------------------------------------- #include @@ -1650,5 +1650,61 @@ subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boun end subroutine coupler_full_chksum +!> \brief This subroutine calls flux_init_stocks or does the final call to flux_check_stocks + subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & + coupler_clocks, init_stocks, finish_stocks) + + implicit none + + type(FmsTime_type), intent(in) :: Time + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ocean_state_type), pointer, intent(in) :: Ocean_state + type(coupler_clock_type), intent(in) :: coupler_clocks + logical, optional, intent(in) :: init_stocks, finish_stocks + + logical :: init, finish + + init=.False. ; if(present(init_stocks)) init=init_stocks + finish=.False. ; if(present(finish_stocks)) finish=finish_stocks + + if(init) then + call fms_mpp_set_current_pelist() + call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state) + else if(finish) then + call fms_mpp_set_current_pelist() + call fms_mpp_clock_begin(coupler_clocks%final_flux_check_stocks) + if (check_stocks >= 0) then + call fms_mpp_set_current_pelist() + call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) + endif + call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks) + else + call mpp_error(FATAL, 'coupler_flux_init_finish_stocks: either init or finish needs to be .True.') + end if + + end subroutine coupler_flux_init_stocks + +!> \brief This subroutine calls flux_init_stocks + subroutine coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clocks) + + implicit none + + integer, intent(in) :: nc + type(FmsTime_type), intent(in) :: Time + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ice_data_type), intent(in) :: Ice + type(ocean_state_type), pointer, intent(in) :: Ocean_state + type(coupler_clock_type), intent(in) :: coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks) + if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then + call fms_mpp_set_current_pelist() + call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) + endif + call fms_mpp_clock_end(coupler_clocks%flux_check_stocks) + + end subroutine coupler_flux_check_stocks end module full_coupler_mod From c6e33788eff307e3262c9e101ce7efd2744411ee Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 15:21:12 -0400 Subject: [PATCH 62/78] Revert "add coupler_stocks subroutines" This reverts commit 365899a659ee739547fc04553ff66ed1c2ae250c. --- full/coupler_main.F90 | 26 +++++++++++++---- full/full_coupler_mod.F90 | 60 ++------------------------------------- 2 files changed, 22 insertions(+), 64 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index cfa196f1..eab481b3 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -437,8 +437,10 @@ program coupler_main !----------------------------------------------------------------------- !------ ocean/slow-ice integration loop ------ - if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & - coupler_clocks, init_stocks=.True.) + if (check_stocks >= 0) then + call fms_mpp_set_current_pelist() + call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state) + endif do nc = 1, num_cpld_calls @@ -475,7 +477,14 @@ program coupler_main ! To print the value of frazil heat flux at the right time the following block ! needs to sit here rather than at the end of the coupler loop. - if (check_stocks > 0) call coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clock) + if (check_stocks > 0) then + call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks) + if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then + call fms_mpp_set_current_pelist() + call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) + endif + call fms_mpp_clock_end(coupler_clocks%flux_check_stocks) + endif if (do_ice .and. Ice%pe) then if (Ice%slow_ice_pe) then @@ -865,11 +874,16 @@ program coupler_main enddo 102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) - if( check_stocks >=0 ) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & - coupler_clocks, finish_stocks=.True.) + call fms_mpp_set_current_pelist() + call fms_mpp_clock_begin(coupler_clocks%final_flux_check_stocks) + if (check_stocks >= 0) then + call fms_mpp_set_current_pelist() + call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) + endif + call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks) -!----------------------------------------------------------------------- call fms_mpp_set_current_pelist() +!----------------------------------------------------------------------- call fms_mpp_clock_end(coupler_clocks%main) call fms_mpp_clock_begin(coupler_clocks%termination) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 8b9cb2e5..0f096b7d 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -108,6 +108,7 @@ module full_coupler_mod public :: flux_down_from_atmos, flux_up_to_atmos public :: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice public :: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish + public :: flux_check_stocks, flux_init_stocks public :: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks public :: flux_atmos_to_ocean, flux_ex_arrays_dealloc public :: atmos_tracer_driver_gather_data @@ -125,8 +126,7 @@ module full_coupler_mod public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, coupler_full_chksum public :: coupler_clock_type - - public :: coupler_flux_init_finish_stocks, coupler_flux_check_stocks + !----------------------------------------------------------------------- #include @@ -1650,61 +1650,5 @@ subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boun end subroutine coupler_full_chksum -!> \brief This subroutine calls flux_init_stocks or does the final call to flux_check_stocks - subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & - coupler_clocks, init_stocks, finish_stocks) - - implicit none - - type(FmsTime_type), intent(in) :: Time - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ocean_state_type), pointer, intent(in) :: Ocean_state - type(coupler_clock_type), intent(in) :: coupler_clocks - logical, optional, intent(in) :: init_stocks, finish_stocks - - logical :: init, finish - - init=.False. ; if(present(init_stocks)) init=init_stocks - finish=.False. ; if(present(finish_stocks)) finish=finish_stocks - - if(init) then - call fms_mpp_set_current_pelist() - call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state) - else if(finish) then - call fms_mpp_set_current_pelist() - call fms_mpp_clock_begin(coupler_clocks%final_flux_check_stocks) - if (check_stocks >= 0) then - call fms_mpp_set_current_pelist() - call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) - endif - call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks) - else - call mpp_error(FATAL, 'coupler_flux_init_finish_stocks: either init or finish needs to be .True.') - end if - - end subroutine coupler_flux_init_stocks - -!> \brief This subroutine calls flux_init_stocks - subroutine coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clocks) - - implicit none - - integer, intent(in) :: nc - type(FmsTime_type), intent(in) :: Time - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice - type(ocean_state_type), pointer, intent(in) :: Ocean_state - type(coupler_clock_type), intent(in) :: coupler_clocks - - call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks) - if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then - call fms_mpp_set_current_pelist() - call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) - endif - call fms_mpp_clock_end(coupler_clocks%flux_check_stocks) - - end subroutine coupler_flux_check_stocks end module full_coupler_mod From ce62da944bb42dda471a7eb0b0f0e99d97e7b987 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 10 May 2024 15:46:36 -0400 Subject: [PATCH 63/78] fix mistakes --- full/coupler_main.F90 | 2 +- full/full_coupler_mod.F90 | 25 +++++++++++++------------ 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index cfa196f1..13d7dd81 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -475,7 +475,7 @@ program coupler_main ! To print the value of frazil heat flux at the right time the following block ! needs to sit here rather than at the end of the coupler loop. - if (check_stocks > 0) call coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clock) + if (check_stocks > 0) call coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clocks) if (do_ice .and. Ice%pe) then if (Ice%slow_ice_pe) then diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 8b9cb2e5..5cc3214f 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1656,11 +1656,12 @@ subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & implicit none - type(FmsTime_type), intent(in) :: Time - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ocean_state_type), pointer, intent(in) :: Ocean_state - type(coupler_clock_type), intent(in) :: coupler_clocks + type(FmsTime_type), intent(in) :: Time + type(atmos_data_type), intent(inout) :: Atm + type(land_data_type), intent(inout) :: Land + type(ice_data_type), intent(inout) :: Ice + type(ocean_state_type), pointer, intent(inout) :: Ocean_state + type(coupler_clock_type), intent(inout) :: coupler_clocks logical, optional, intent(in) :: init_stocks, finish_stocks logical :: init, finish @@ -1680,10 +1681,10 @@ subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & endif call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks) else - call mpp_error(FATAL, 'coupler_flux_init_finish_stocks: either init or finish needs to be .True.') + call fms_mpp_error(FATAL, 'coupler_flux_init_finish_stocks: either init or finish needs to be .True.') end if - end subroutine coupler_flux_init_stocks + end subroutine coupler_flux_init_finish_stocks !> \brief This subroutine calls flux_init_stocks subroutine coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clocks) @@ -1692,11 +1693,11 @@ subroutine coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coup integer, intent(in) :: nc type(FmsTime_type), intent(in) :: Time - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice - type(ocean_state_type), pointer, intent(in) :: Ocean_state - type(coupler_clock_type), intent(in) :: coupler_clocks + type(atmos_data_type), intent(inout) :: Atm + type(land_data_type), intent(inout) :: Land + type(ice_data_type), intent(inout) :: Ice + type(ocean_state_type), pointer, intent(inout) :: Ocean_state + type(coupler_clock_type), intent(inout) :: coupler_clocks call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks) if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then From c26aa4c9c5757dae125182d2c37123b2718d33f6 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Sat, 18 May 2024 13:07:02 -0400 Subject: [PATCH 64/78] change full_chksum to _ocean_chksum --- full/coupler_main.F90 | 21 +++++++++++++++------ full/full_coupler_mod.F90 | 29 +++++++++++------------------ 2 files changed, 26 insertions(+), 24 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index eab481b3..91517785 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -429,6 +429,8 @@ program coupler_main conc_nthreads, coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) + if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) + call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization @@ -444,9 +446,12 @@ program coupler_main do nc = 1, num_cpld_calls - if (do_chksum) call coupler_full_chksum('MAIN_LOOP-', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & - Ocean, Ice_ocean_boundary) + if (do_chksum) then + call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice) + call coupler_atmos_ice_land_ocean_chksum('MAIN_LOOP-', nc, Atm, Land, Ice,& + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & + Ocean, Ice_ocean_boundary) + end if ! Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication ! points when running concurrently. The calls are placed next to each other in @@ -472,8 +477,12 @@ program coupler_main endif endif - if (do_chksum) call coupler_full_chksum('flux_ocn2ice+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + if (do_chksum) then + call coupler_chksum('flux_ocn2ice+', nc, Atm, Land, Ice) + call coupler_atmos_ice_land_ocean_chksum('flux_ocn2ice+', nc, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & + Ocean, Ice_ocean_boundary) + end if ! To print the value of frazil heat flux at the right time the following block ! needs to sit here rather than at the end of the coupler loop. @@ -889,7 +898,7 @@ program coupler_main if (do_chksum) call coupler_chksum('coupler_end-', nc, Atm, Land, Ice) call coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& - Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & + Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & Time, Time_start, Time_end, Time_restart_current) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 765e746c..5dde9e17 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -123,7 +123,8 @@ module full_coupler_mod public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum public :: coupler_init, coupler_end, coupler_restart - public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum, coupler_full_chksum + public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum + public :: coupler_atmos_ice_land_ocean_chksum public :: coupler_clock_type @@ -1118,19 +1119,13 @@ subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_bounda integer :: num_ice_bc_restart, num_ocn_bc_restart if ( do_endpoint_chksum ) then - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum('coupler_end', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif + call coupler_atmos_ice_land_ocean_chksum('coupler_end', 0, Atm, Land, Ice, Land, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmo_land_boundary, Ocean, & + Ice_ocean_boundary) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) call slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum('coupler_end', 0, Ocean, Ice_ocean_boundary) - endif endif call fms_mpp_set_current_pelist() @@ -1617,11 +1612,11 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble end subroutine coupler_set_clock_ids !> \brief This subroutine calls coupler_chksum as well as atmos_ice_land_chksum and ocean_chksum - subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boundary, & - Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) - + subroutine coupler_atmos_ice_land_ocean_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boundary,& + Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary, Ocean_ice_boundary) + implicit none - + character(len=*), intent(in) :: id integer , intent(in) :: timestep type(atmos_data_type), intent(in) :: Atm @@ -1632,9 +1627,7 @@ subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boun type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary type(ocean_public_type), intent(in) :: Ocean type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - - - call coupler_chksum(trim(id), timestep, Atm, Land, Ice) + type(ocean_ice_boundary_type), intent(in), optional :: Ocean_ice_boundary if (Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) @@ -1648,7 +1641,7 @@ subroutine coupler_full_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boun call fms_mpp_set_current_pelist() - end subroutine coupler_full_chksum + end subroutine coupler_atmos_ice_land_ocean_chksum end module full_coupler_mod From 2fca138676d336446c57418d1b5aa34a200572a7 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 20 May 2024 08:31:41 -0400 Subject: [PATCH 65/78] fix mistakes get it to compile --- full/full_coupler_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 37b32771..f9f2f857 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -125,7 +125,8 @@ module full_coupler_mod public :: coupler_init, coupler_end, coupler_restart public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum public :: coupler_atmos_ice_land_ocean_chksum - + public :: coupler_flux_init_finish_stocks, coupler_flux_check_stocks + public :: coupler_clock_type !----------------------------------------------------------------------- @@ -1082,8 +1083,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, CALL fms_diag_grid_end() !----------------------------------------------------------------------- - if ( do_endpoint_chksum ) call coupler_full_chksum('coupler_init+', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + if ( do_endpoint_chksum ) call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, & + Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) call fms_memutils_print_memuse_stats('coupler_init') @@ -1119,9 +1120,8 @@ subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_bounda integer :: num_ice_bc_restart, num_ocn_bc_restart if ( do_endpoint_chksum ) then - call coupler_atmos_ice_land_ocean_chksum('coupler_end', 0, Atm, Land, Ice, Land, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmo_land_boundary, Ocean, & - Ice_ocean_boundary) + call coupler_atmos_ice_land_ocean_chksum('coupler_end', 0, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) call slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) From 60e45ee4c4f6fdecb61f2a72fc539f134ba97b26 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 20 May 2024 09:26:27 -0400 Subject: [PATCH 66/78] stock changes disappeared? adding them back in --- full/coupler_main.F90 | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 2c7266cb..c13eb364 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -439,10 +439,8 @@ program coupler_main !----------------------------------------------------------------------- !------ ocean/slow-ice integration loop ------ - if (check_stocks >= 0) then - call fms_mpp_set_current_pelist() - call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state) - endif + if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & + coupler_clocks, init_stocks=.True.) do nc = 1, num_cpld_calls @@ -876,14 +874,9 @@ program coupler_main enddo 102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) - call fms_mpp_set_current_pelist() - call fms_mpp_clock_begin(coupler_clocks%final_flux_check_stocks) - if (check_stocks >= 0) then - call fms_mpp_set_current_pelist() - call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state) - endif - call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks) - + if( check_stocks >=0 ) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & + coupler_clocks, finish_stocks=.True.) + call fms_mpp_set_current_pelist() !----------------------------------------------------------------------- call fms_mpp_clock_end(coupler_clocks%main) From d5bd58a3327802cc6a153546f0cdc4e644b8fe1f Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 20 May 2024 12:12:08 -0400 Subject: [PATCH 67/78] its not that simple --- full/full_coupler_mod.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index f9f2f857..fc6862a6 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1081,13 +1081,19 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, ! Call to daig_grid_end to free up memory used during regional ! output setup CALL fms_diag_grid_end() - + !----------------------------------------------------------------------- - if ( do_endpoint_chksum ) call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, & - Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + if ( do_endpoint_chksum ) then + call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + if (Ice%slow_ice_PE) then + call fms_mpp_set_current_pelist(Ice%slow_pelist) + call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) + end if + end if call fms_memutils_print_memuse_stats('coupler_init') - + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) write(errunit,*) 'Exiting coupler_init at '& @@ -1125,7 +1131,7 @@ subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_bounda if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) call slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) - endif + end if endif call fms_mpp_set_current_pelist() @@ -1466,7 +1472,7 @@ subroutine slow_ice_chksum(id, timestep, Ice, Ocean_ice_boundary) call ice_data_type_chksum( id, timestep, Ice) call ocn_ice_bnd_type_chksum( id, timestep, Ocean_ice_boundary) - + end subroutine slow_ice_chksum From b4157152f07055f3507194d630970e2e070268f4 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 20 May 2024 14:16:19 -0400 Subject: [PATCH 68/78] register clock ids at once --- full/full_coupler_mod.F90 | 185 ++++++++++++++++++-------------------- 1 file changed, 87 insertions(+), 98 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index e6ea3ee4..26dd14dc 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -608,7 +608,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, !> The pelists need to be set before initializing the clocks call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist, & - slow_ice_ocean_pelist, ensemble_id, clock_set='model_init_clocks') + slow_ice_ocean_pelist, ensemble_id) !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then @@ -986,9 +986,6 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, endif ! end of Ocean%is_ocean_pe - call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist, & - slow_ice_ocean_pelist, ensemble_id, clock_set='coupler_clocks') - !--------------------------------------------- if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) @@ -1521,7 +1518,7 @@ end subroutine ocean_chksum !> \brief This subroutine sets the ID for clocks used in coupler_main subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist,& - slow_ice_ocean_pelist, ensemble_id, clock_set) + slow_ice_ocean_pelist, ensemble_id) implicit none @@ -1533,101 +1530,93 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble integer, dimension(:), intent(in) :: slow_ice_ocean_pelist integer, dimension(:,:), intent(in) :: ensemble_pelist integer, intent(in) :: ensemble_id - character(len=*), intent(in) :: clock_set - - if( trim(clock_set) == 'model_init_clocks' ) then - !> initialization clock - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) - endif - if (Ice%pe) then - if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) - elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) - else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") - endif - coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) - endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) - - call fms_mpp_set_current_pelist() - coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) - coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) - - else if( trim(clock_set) == 'coupler_clocks' ) then - If(Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) - end if - if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) - coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) - endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) - coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) - coupler_clocks%atmos_tracer_driver_gather_data & - = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) - coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) - coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') - if (.not. do_concurrent_radiation) & - coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) - coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) - coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) - coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) - coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) - coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) - coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) - if (do_concurrent_radiation) then - coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) - coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) - endif - coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') - coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) - coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) - endif - if (Ice%pe) then - if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) - coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) - coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) - - if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) - coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) - coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) - coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) - call fms_mpp_set_current_pelist(Ice%pelist) - coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) - coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) - - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) + !> initialization clock + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + coupler_clocks%atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) + endif + if (Land%pe) then + call fms_mpp_set_current_pelist(Land%pelist) + coupler_clocks%land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) + endif + if (Ice%pe) then + if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) + elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) + else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") endif - - call fms_mpp_set_current_pelist() - coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) - coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) - coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) - - else - call fms_mpp_error(FATAL, 'clock_set not recognized in coupler_set_clock_ids') - + coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + coupler_clocks%ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) + endif + call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) + coupler_clocks%flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) + + call fms_mpp_set_current_pelist() + coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) + coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) + + If(Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) end if - - end subroutine coupler_set_clock_ids + if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) + coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) + coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) + endif + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) + coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) + coupler_clocks%atmos_tracer_driver_gather_data & + = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) + coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) + coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') + if (.not. do_concurrent_radiation) & + coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) + coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) + coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) + coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) + coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) + coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) + if (do_concurrent_radiation) then + coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) + endif + coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') + coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) + coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) + endif + if (Ice%pe) then + if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) + coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) + coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) + + if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) + coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) + coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) + coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) + + call fms_mpp_set_current_pelist(Ice%pelist) + coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) + coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) + + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) + endif + + call fms_mpp_set_current_pelist() + coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) + coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) + coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) + +end subroutine coupler_set_clock_ids end module full_coupler_mod From ef42d5ca4e548a20871ea0a56f0f1bbf60c0a242 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 20 May 2024 17:20:09 -0400 Subject: [PATCH 69/78] github merge gone wrong --- full/flux_exchange.F90 | 12 +++--- full/full_coupler_mod.F90 | 78 ++++++--------------------------------- 2 files changed, 18 insertions(+), 72 deletions(-) diff --git a/full/flux_exchange.F90 b/full/flux_exchange.F90 index 35abf236..1fc473f6 100644 --- a/full/flux_exchange.F90 +++ b/full/flux_exchange.F90 @@ -779,12 +779,12 @@ end subroutine flux_exchange_init !! component. subroutine flux_check_stocks(Time, Atm, Lnd, Ice, Ocn_state) - - type(FmsTime_type) :: Time - type(atmos_data_type), optional :: Atm - type(land_data_type), optional :: Lnd - type(ice_data_type), optional :: Ice - type(ocean_state_type), optional, pointer :: Ocn_state + + type(FmsTime_type), intent(in) :: Time + type(atmos_data_type), intent(inout), optional :: Atm + type(land_data_type), intent(inout), optional :: Lnd + type(ice_data_type), intent(inout), optional :: Ice + type(ocean_state_type), intent(inout), optional, pointer :: Ocn_state real :: ref_value integer :: i diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index bb1db1a4..18474168 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1623,6 +1623,18 @@ subroutine coupler_atmos_ice_land_ocean_chksum(id, timestep, Atm, Land, Ice, Lan type(ocean_public_type), intent(in) :: Ocean type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary type(ocean_ice_boundary_type), intent(in), optional :: Ocean_ice_boundary + + if (Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call atmos_ice_land_chksum(trim(id), timestep, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + endif + if (Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(Ocean%pelist) + call ocean_chksum(trim(id), timestep, Ocean, Ice_ocean_boundary) + endif + + call fms_mpp_set_current_pelist() end subroutine coupler_atmos_ice_land_ocean_chksum @@ -1684,70 +1696,4 @@ subroutine coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coup end subroutine coupler_flux_check_stocks -======= - call fms_mpp_set_current_pelist() - coupler_clocks%main = fms_mpp_clock_id( 'Main loop' ) - coupler_clocks%termination = fms_mpp_clock_id( 'Termination' ) - - If(Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' ) - end if - if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - coupler_clocks%flux_ocean_to_ice = fms_mpp_clock_id( 'flux_ocean_to_ice' ) - coupler_clocks%flux_ice_to_ocean = fms_mpp_clock_id( 'flux_ice_to_ocean' ) - endif - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - coupler_clocks%atm = fms_mpp_clock_id( 'ATM' ) - coupler_clocks%atmos_loop = fms_mpp_clock_id( ' ATM: atmos loop' ) - coupler_clocks%atmos_tracer_driver_gather_data & - = fms_mpp_clock_id( ' A-L: atmos_tracer_driver_gather_data' ) - coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) - coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') - if (.not. do_concurrent_radiation) & - coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) - coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) - coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) - coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) - coupler_clocks%update_ice_model_fast = fms_mpp_clock_id( ' A-L: update_ice_model_fast' ) - coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) - coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) - if (do_concurrent_radiation) then - coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) - coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) - endif - coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') - coupler_clocks%update_land_model_slow = fms_mpp_clock_id( ' ATM: update_land_model_slow' ) - coupler_clocks%flux_land_to_ice = fms_mpp_clock_id( ' ATM: flux_land_to_ice' ) - endif - if (Ice%pe) then - if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist) - coupler_clocks%set_ice_surface_fast = fms_mpp_clock_id( ' Ice: set_ice_surface fast' ) - coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' ) - - if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist) - coupler_clocks%set_ice_surface_slow = fms_mpp_clock_id( ' Ice: set_ice_surface slow' ) - coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' ) - coupler_clocks%flux_ice_to_ocean_stocks = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' ) - - call fms_mpp_set_current_pelist(Ice%pelist) - coupler_clocks%set_ice_surface_exchange = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' ) - coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' ) - - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' ) - endif - - call fms_mpp_set_current_pelist() - coupler_clocks%flux_check_stocks = fms_mpp_clock_id( 'flux_check_stocks' ) - coupler_clocks%intermediate_restart = fms_mpp_clock_id( 'intermediate restart' ) - coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' ) - -end subroutine coupler_set_clock_ids - ->>>>>>> origin/update_file_version end module full_coupler_mod From 5e9270a76fb6ebcd7e40c4ff6578c1815bbe954a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 20 May 2024 17:22:34 -0400 Subject: [PATCH 70/78] make things pretty! --- full/full_coupler_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 18474168..7f1486a2 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1529,8 +1529,8 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble endif if (Ice%pe) then if (Ice%shared_slow_fast_PEs) then ; call fms_mpp_set_current_pelist(Ice%pelist) - elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) + elseif (Ice%fast_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%fast_pelist) + elseif (Ice%slow_ice_pe) then ; call fms_mpp_set_current_pelist(Ice%slow_pelist) else ; call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") endif coupler_clocks%ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) From 6d74405a5818b82bc52eb2b091c2e533973ee7ee Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 22 May 2024 11:59:00 -0400 Subject: [PATCH 71/78] remove public flux_stocks --- full/full_coupler_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 18474168..489deadd 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -108,7 +108,6 @@ module full_coupler_mod public :: flux_down_from_atmos, flux_up_to_atmos public :: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice public :: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish - public :: flux_check_stocks, flux_init_stocks public :: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks public :: flux_atmos_to_ocean, flux_ex_arrays_dealloc public :: atmos_tracer_driver_gather_data From c4f5873694e823dec56eedee0a374d467af16916 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 22 May 2024 14:47:11 -0400 Subject: [PATCH 72/78] comments --- full/full_coupler_mod.F90 | 77 ++++++++++++++++++++------------------- 1 file changed, 39 insertions(+), 38 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index a0acbb85..4a3651d7 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1492,10 +1492,10 @@ end subroutine slow_ice_chksum !! after you exit. This is only necessary if you need to return to the global pelist. subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type (ocean_public_type), intent(in) :: Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + character(len=*), intent(in) :: id !< ID labelling the set of CHECKSUMS + integer , intent(in) :: timestep !< Timestep + type (ocean_public_type), intent(in) :: Ocean !< Ocean + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary ! initialization clock if (Atm%pe) then @@ -1611,17 +1611,17 @@ subroutine coupler_atmos_ice_land_ocean_chksum(id, timestep, Atm, Land, Ice, Lan implicit none - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice - type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary - type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary - type(ocean_public_type), intent(in) :: Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - type(ocean_ice_boundary_type), intent(in), optional :: Ocean_ice_boundary + character(len=*), intent(in) :: id !< ID labelling the set of checksums + integer , intent(in) :: timestep !< timestep + type(atmos_data_type), intent(in) :: Atm !< Atm + type(land_data_type), intent(in) :: Land !< Land + type(ice_data_type), intent(in) :: Ice !< Ice + type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary !< Atmos_land_boundary + type(ocean_public_type), intent(in) :: Ocean !< Ocean + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary !< Ice_ocean_boundary + type(ocean_ice_boundary_type), intent(in), optional :: Ocean_ice_boundary !< Ocean_ice_boundary if (Atm%pe) then call fms_mpp_set_current_pelist(Atm%pelist) @@ -1643,13 +1643,14 @@ subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & implicit none - type(FmsTime_type), intent(in) :: Time - type(atmos_data_type), intent(inout) :: Atm - type(land_data_type), intent(inout) :: Land - type(ice_data_type), intent(inout) :: Ice - type(ocean_state_type), pointer, intent(inout) :: Ocean_state - type(coupler_clock_type), intent(inout) :: coupler_clocks - logical, optional, intent(in) :: init_stocks, finish_stocks + type(FmsTime_type), intent(in) :: Time !< current Time + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_data_type), intent(inout) :: Land !< Land + type(ice_data_type), intent(inout) :: Ice !< Ice + type(ocean_state_type), pointer, intent(inout) :: Ocean_state !< Ocean_state + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + logical, optional, intent(in) :: init_stocks, finish_stocks !< control flags to either call flux_init_stocks or + !! the final flux_check_stocks logical :: init, finish @@ -1673,18 +1674,18 @@ subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & end subroutine coupler_flux_init_finish_stocks -!> \brief This subroutine calls flux_init_stocks +!> \brief This subroutine calls flux_check_stocks subroutine coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clocks) implicit none - integer, intent(in) :: nc - type(FmsTime_type), intent(in) :: Time - type(atmos_data_type), intent(inout) :: Atm - type(land_data_type), intent(inout) :: Land - type(ice_data_type), intent(inout) :: Ice - type(ocean_state_type), pointer, intent(inout) :: Ocean_state - type(coupler_clock_type), intent(inout) :: coupler_clocks + integer, intent(in) :: nc !< current outerloop timestep + type(FmsTime_type), intent(in) :: Time !< Time + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_data_type), intent(inout) :: Land !< Land + type(ice_data_type), intent(inout) :: Ice !< Ice + type(ocean_state_type), pointer, intent(inout) :: Ocean_state !< Ocean_state + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks) if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then From cdfe0494d441c3388b5a16a6383e19bc04faf235 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 23 May 2024 12:38:54 -0400 Subject: [PATCH 73/78] remove fms/main --- full/full_coupler_mod.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 0b09640a..1913587b 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -385,7 +385,6 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, ierr = check_nml_error (io, 'coupler_nml') !----- read date and calendar type from restart file ----- - if (fms2_io_file_exists('INPUT/coupler.res')) then call fms2_io_ascii_read('INPUT/coupler.res', restart_file) read(restart_file(1), *) calendar_type @@ -589,7 +588,6 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Ice%slow_ice_pe = ANY(Ice%slow_pelist(:) .EQ. fms_mpp_pe()) Ice%pe = Ice%fast_ice_pe .OR. Ice%slow_ice_pe call fms_mpp_declare_pelist(slow_ice_ocean_pelist) - !--- dynamic threading turned off when affinity placement is in use !$ call omp_set_dynamic(.FALSE.) !--- nested OpenMP enabled for OpenMP concurrent components @@ -644,7 +642,6 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, call fms_mpp_set_current_pelist() mainClock = fms_mpp_clock_id( 'Main loop' ) termClock = fms_mpp_clock_id( 'Termination' ) ->>>>>>> fms/main !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then From 73c84e38e6ebdd182086f731b86452fd036cd014 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 23 May 2024 12:45:34 -0400 Subject: [PATCH 74/78] merging gone sloppy --- full/coupler_main.F90 | 4 ++-- full/full_coupler_mod.F90 | 32 -------------------------------- 2 files changed, 2 insertions(+), 34 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index a46f096d..7dfac3b6 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -416,8 +416,8 @@ program coupler_main call fms_mpp_init() !these clocks are on the global pelist - initClock = fms_mpp_clock_id( 'Initialization' ) - call fms_mpp_clock_begin(initClock) + coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) + call fms_mpp_clock_begin(coupler_clocks%initialization) call fms_init call fmsconstants_init diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 1913587b..ecfeb3d4 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -611,38 +611,6 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, call coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist, & slow_ice_ocean_pelist, ensemble_id) - !--- initialization clock - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - id_atmos_model_init = fms_mpp_clock_id( ' Init: atmos_model_init ' ) - endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - id_land_model_init = fms_mpp_clock_id( ' Init: land_model_init ' ) - endif - if (Ice%pe) then - if (Ice%shared_slow_fast_PEs) then - call fms_mpp_set_current_pelist(Ice%pelist) - elseif (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - elseif (Ice%slow_ice_pe) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) - else - call fms_mpp_error(FATAL, "All Ice%pes must be a part of Ice%fast_ice_pe or Ice%slow_ice_pe") - endif - id_ice_model_init = fms_mpp_clock_id( ' Init: ice_model_init ' ) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - id_ocean_model_init = fms_mpp_clock_id( ' Init: ocean_model_init ' ) - endif - call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:)) - id_flux_exchange_init = fms_mpp_clock_id( ' Init: flux_exchange_init' ) - - call fms_mpp_set_current_pelist() - mainClock = fms_mpp_clock_id( 'Main loop' ) - termClock = fms_mpp_clock_id( 'Termination' ) - !Write out messages on root PEs if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then write( text,'(a,2i6,a,i2.2)' )'Atmos PE range: ', Atm%pelist(1) , Atm%pelist(atmos_npes) ,& From 531389813b3a729ab53ce35b18bc49bb29c3f5dc Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 31 May 2024 09:44:56 -0400 Subject: [PATCH 75/78] missed merge fixes --- full/coupler_main.F90 | 2 +- full/full_coupler_mod.F90 | 48 +++------------------------------------ 2 files changed, 4 insertions(+), 46 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index c7ce7983..e916ccb1 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -886,7 +886,7 @@ program coupler_main if (do_chksum) call coupler_chksum('coupler_end-', nc, Atm, Land, Ice) call coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & - Time, Time_start, Time_end, Time_restart_current) + Time, Time_start, Time_end, Time_restart_current) call fms_mpp_clock_end(coupler_clocks%termination) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index d9568c48..b5610143 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -229,48 +229,6 @@ module full_coupler_mod use_hyper_thread, concurrent_ice, slow_ice_with_ocean, & do_endpoint_chksum, combined_ice_and_ocean - type coupler_clock_type - integer :: initialization - integer :: main - integer :: generate_sfc_xgrid - integer :: flux_ocean_to_ice - integer :: flux_ice_to_ocean - integer :: atm - integer :: atmos_loop - integer :: atmos_tracer_driver_gather_data - integer :: sfc_boundary_layer - integer :: update_atmos_model_dynamics - integer :: serial_radiation - integer :: update_atmos_model_down - integer :: flux_down_from_atmos - integer :: update_land_model_fast - integer :: update_ice_model_fast - integer :: flux_up_to_atmos - integer :: update_atmos_model_up - integer :: concurrent_radiation - integer :: concurrent_atmos - integer :: update_atmos_model_state - integer :: update_land_model_slow - integer :: flux_land_to_ice - integer :: set_ice_surface_fast - integer :: update_ice_model_slow_fast - integer :: set_ice_surface_slow - integer :: update_ice_model_slow_slow - integer :: flux_ice_to_ocean_stocks - integer :: set_ice_surface_exchange - integer :: update_ice_model_slow_exchange - integer :: ocean - integer :: flux_check_stocks - integer :: intermediate_restart - integer :: final_flux_check_stocks - integer :: termination - integer :: atmos_model_init - integer :: land_model_init - integer :: ice_model_init - integer :: ocean_model_init - integer :: flux_exchange_init - end type coupler_clock_type - !> coupler_clock_type derived type consist of all clock ids that will be set and used !! in full coupler_main. type coupler_clock_type @@ -1135,13 +1093,13 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) if (Ice%slow_ice_PE) then - call fms_mpp_set_current_pelist(Ice%slow_pelist) + call fms_mpp_set_current_pelist(Ice%slow_pelist) call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) end if end if call fms_memutils_print_memuse_stats('coupler_init') - + if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then call DATE_AND_TIME(walldate, walltime, wallzone, wallvalues) write(errunit,*) 'Exiting coupler_init at '& @@ -1519,7 +1477,7 @@ subroutine slow_ice_chksum(id, timestep, Ice, Ocean_ice_boundary) call ice_data_type_chksum( id, timestep, Ice) call ocn_ice_bnd_type_chksum( id, timestep, Ocean_ice_boundary) - + end subroutine slow_ice_chksum From b04c41a5188fd1ea40a5510115bec6ade05bdcb9 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 31 May 2024 09:48:12 -0400 Subject: [PATCH 76/78] add comments for tom --- full/full_coupler_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index b5610143..63b41173 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1662,7 +1662,10 @@ subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & logical, optional, intent(in) :: init_stocks, finish_stocks !< control flags to either call flux_init_stocks or !! the final flux_check_stocks - logical :: init, finish + logical :: init, finish !< control flags set to False. by default and takes on the value of init_stocks and + !! finish_stocks if these optional arguments are provided. + !! If true, either flux_init_stocks or + !! final flux_check_stocks will be called. init=.False. ; if(present(init_stocks)) init=init_stocks finish=.False. ; if(present(finish_stocks)) finish=finish_stocks From d6751167c93283c432e590b481e9f4fa93f8ef35 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 31 May 2024 09:49:49 -0400 Subject: [PATCH 77/78] why is .emacs not working --- full/flux_exchange.F90 | 2 +- full/full_coupler_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/full/flux_exchange.F90 b/full/flux_exchange.F90 index 5ce7b4f1..e7f07b59 100644 --- a/full/flux_exchange.F90 +++ b/full/flux_exchange.F90 @@ -759,7 +759,7 @@ end subroutine flux_exchange_init !! component. subroutine flux_check_stocks(Time, Atm, Lnd, Ice, Ocn_state) - + type(FmsTime_type), intent(in) :: Time type(atmos_data_type), intent(inout), optional :: Atm type(land_data_type), intent(inout), optional :: Lnd diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 63b41173..e678a8f2 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1087,7 +1087,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, ! Call to daig_grid_end to free up memory used during regional ! output setup CALL fms_diag_grid_end() - + !----------------------------------------------------------------------- if ( do_endpoint_chksum ) then call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & From 7b50298ed22c7c17c21fe02c37e0e9f66ab007a0 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 31 May 2024 10:18:47 -0400 Subject: [PATCH 78/78] missed coupler_chksum replacement --- full/coupler_main.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index e916ccb1..af91c7a9 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -443,8 +443,6 @@ program coupler_main coupler_clocks, init_stocks=.True.) do nc = 1, num_cpld_calls - if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice) - call fms_mpp_set_current_pelist() if (do_chksum) then call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice)