diff --git a/SourceMods.noresm2/src.drv/cime_comp_mod.F90 b/SourceMods.noresm2/src.drv/cime_comp_mod.F90 index 89ac4520..4567b907 100644 --- a/SourceMods.noresm2/src.drv/cime_comp_mod.F90 +++ b/SourceMods.noresm2/src.drv/cime_comp_mod.F90 @@ -34,10 +34,10 @@ module cime_comp_mod use shr_mem_mod, only: shr_mem_init, shr_mem_getusage use shr_cal_mod, only: shr_cal_date2ymd, shr_cal_ymd2date, shr_cal_advdateInt use shr_cal_mod, only: shr_cal_ymds2rday_offset - use shr_orb_mod, only: shr_orb_params + use shr_orb_mod, only: shr_orb_params, shr_orb_doalbavg !+tht added doalbavg use shr_frz_mod, only: shr_frz_freezetemp_init + use shr_flux_mod, only: shr_flux_docoare !+tht option for COARE flux computation use shr_reprosum_mod, only: shr_reprosum_setopts - use shr_taskmap_mod, only: shr_taskmap_write use mct_mod ! mct_ wrappers for mct lib use perf_mod use ESMF @@ -54,24 +54,21 @@ module cime_comp_mod use wav_comp_mct , only: wav_init=>wav_init_mct, wav_run=>wav_run_mct, wav_final=>wav_final_mct use rof_comp_mct , only: rof_init=>rof_init_mct, rof_run=>rof_run_mct, rof_final=>rof_final_mct use esp_comp_mct , only: esp_init=>esp_init_mct, esp_run=>esp_run_mct, esp_final=>esp_final_mct - use iac_comp_mct , only: iac_init=>iac_init_mct, iac_run=>iac_run_mct, iac_final=>iac_final_mct !---------------------------------------------------------------------------- ! cpl7 modules !---------------------------------------------------------------------------- ! mpi comm data & routines, plus logunit and loglevel - use seq_comm_mct, only: CPLID, GLOID, logunit, loglevel, info_taskmap_comp + use seq_comm_mct, only: CPLID, GLOID, logunit, loglevel use seq_comm_mct, only: ATMID, LNDID, OCNID, ICEID, GLCID, ROFID, WAVID, ESPID use seq_comm_mct, only: ALLATMID,ALLLNDID,ALLOCNID,ALLICEID,ALLGLCID,ALLROFID,ALLWAVID,ALLESPID use seq_comm_mct, only: CPLALLATMID,CPLALLLNDID,CPLALLOCNID,CPLALLICEID use seq_comm_mct, only: CPLALLGLCID,CPLALLROFID,CPLALLWAVID,CPLALLESPID use seq_comm_mct, only: CPLATMID,CPLLNDID,CPLOCNID,CPLICEID,CPLGLCID,CPLROFID,CPLWAVID,CPLESPID - use seq_comm_mct, only: IACID, ALLIACID, CPLALLIACID, CPLIACID use seq_comm_mct, only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct, only: num_inst_ocn, num_inst_ice, num_inst_glc use seq_comm_mct, only: num_inst_wav, num_inst_esp - use seq_comm_mct, only: num_inst_iac use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_phys use seq_comm_mct, only: num_inst_total, num_inst_max use seq_comm_mct, only: seq_comm_iamin, seq_comm_name, seq_comm_namelen @@ -104,7 +101,6 @@ module cime_comp_mod use seq_timemgr_mod, only: seq_timemgr_alarm_rofrun use seq_timemgr_mod, only: seq_timemgr_alarm_wavrun use seq_timemgr_mod, only: seq_timemgr_alarm_esprun - use seq_timemgr_mod, only: seq_timemgr_alarm_iacrun use seq_timemgr_mod, only: seq_timemgr_alarm_barrier use seq_timemgr_mod, only: seq_timemgr_alarm_pause use seq_timemgr_mod, only: seq_timemgr_pause_active @@ -128,7 +124,7 @@ module cime_comp_mod ! flux calc routines use seq_flux_mct, only: seq_flux_init_mct, seq_flux_initexch_mct, seq_flux_ocnalb_mct - use seq_flux_mct, only: seq_flux_atmocn_mct, seq_flux_atmocnexch_mct, seq_flux_readnl_mct + use seq_flux_mct, only: seq_flux_atmocn_mct, seq_flux_atmocnexch_mct ! domain fraction routines use seq_frac_mct, only : seq_frac_init, seq_frac_set @@ -153,18 +149,15 @@ module cime_comp_mod use seq_flds_mod, only : seq_flds_w2x_fluxes, seq_flds_x2w_fluxes use seq_flds_mod, only : seq_flds_r2x_fluxes, seq_flds_x2r_fluxes use seq_flds_mod, only : seq_flds_set - use seq_flds_mod, only : seq_flds_z2x_fluxes, seq_flds_x2z_fluxes ! component type and accessor functions - use component_type_mod, only: component_get_iamin_compid, component_get_suffix - use component_type_mod, only: component_get_iamroot_compid - use component_type_mod, only: component_get_name, component_get_c2x_cx - use component_type_mod, only: atm, lnd, ice, ocn, rof, glc, wav, esp, iac - use component_mod, only: component_init_pre - use component_mod, only: component_init_cc, component_init_cx - use component_mod, only: component_run, component_final - use component_mod, only: component_init_areacor, component_init_aream - use component_mod, only: component_exch, component_diag + use component_type_mod , only: component_get_iamin_compid, component_get_suffix + use component_type_mod , only: component_get_name, component_get_c2x_cx + use component_type_mod , only: atm, lnd, ice, ocn, rof, glc, wav, esp + use component_mod , only: component_init_pre + use component_mod , only: component_init_cc, component_init_cx, component_run, component_final + use component_mod , only: component_init_areacor, component_init_aream + use component_mod , only: component_exch, component_diag ! prep routines (includes mapping routines between components and merging routines) use prep_lnd_mod @@ -175,7 +168,6 @@ module cime_comp_mod use prep_ocn_mod use prep_atm_mod use prep_aoflux_mod - use prep_iac_mod !--- mapping routines --- use seq_map_type_mod @@ -188,48 +180,8 @@ module cime_comp_mod private - ! public data - public :: timing_dir, mpicom_GLOID - - ! public routines - public :: cime_pre_init1 - public :: cime_pre_init2 - public :: cime_init - public :: cime_run - public :: cime_final - - ! private routines - private :: cime_esmf_readnl - private :: cime_printlogheader - private :: cime_comp_barriers - private :: cime_cpl_init - private :: cime_run_atmocn_fluxes - private :: cime_run_ocn_albedos - private :: cime_run_atm_setup_send - private :: cime_run_atm_recv_post - private :: cime_run_ocn_setup_send - private :: cime_run_ocn_recv_post - private :: cime_run_atmocn_setup - private :: cime_run_lnd_setup_send - private :: cime_run_lnd_recv_post - private :: cime_run_glc_setup_send - private :: cime_run_glc_accum_avg - private :: cime_run_glc_recv_post - private :: cime_run_rof_setup_send - private :: cime_run_rof_recv_post - private :: cime_run_ice_setup_send - private :: cime_run_ice_recv_post - private :: cime_run_wav_setup_send - private :: cime_run_wav_recv_post - private :: cime_run_iac_setup_send - private :: cime_run_iac_recv_post - private :: cime_run_update_fractions - private :: cime_run_calc_budgets1 - private :: cime_run_calc_budgets2 - private :: cime_run_calc_budgets3 - private :: cime_run_write_history - private :: cime_run_write_restart - private :: cime_write_performance_checkpoint + public cime_pre_init1, cime_pre_init2, cime_init, cime_run, cime_final + public timing_dir, mpicom_GLOID #include @@ -263,7 +215,6 @@ module cime_comp_mod type(mct_aVect) , pointer :: fractions_gx(:) ! Fractions on glc grid, cpl processes type(mct_aVect) , pointer :: fractions_rx(:) ! Fractions on rof grid, cpl processes type(mct_aVect) , pointer :: fractions_wx(:) ! Fractions on wav grid, cpl processes - type(mct_aVect) , pointer :: fractions_zx(:) ! Fractions on iac grid, cpl processes !--- domain equivalent 2d grid size --- integer :: atm_nx, atm_ny ! nx, ny of 2d grid, if known @@ -273,7 +224,6 @@ module cime_comp_mod integer :: rof_nx, rof_ny integer :: glc_nx, glc_ny integer :: wav_nx, wav_ny - integer :: iac_nx, iac_ny !---------------------------------------------------------------------------- ! Infodata: inter-model control flags, domain info @@ -295,7 +245,6 @@ module cime_comp_mod type (ESMF_Clock), target :: EClock_r ! rof clock type (ESMF_Clock), target :: EClock_w ! wav clock type (ESMF_Clock), target :: EClock_e ! esp clock - type (ESMF_Clock), target :: EClock_z ! iac clock logical :: restart_alarm ! restart alarm logical :: history_alarm ! history alarm @@ -311,7 +260,6 @@ module cime_comp_mod logical :: rofrun_alarm ! rof run alarm logical :: wavrun_alarm ! wav run alarm logical :: esprun_alarm ! esp run alarm - logical :: iacrun_alarm ! iac run alarm logical :: tprof_alarm ! timing profile alarm logical :: barrier_alarm ! barrier alarm logical :: t1hr_alarm ! alarm every hour @@ -393,7 +341,6 @@ module cime_comp_mod logical :: flood_present ! .true. => rof is computing flood logical :: wav_present ! .true. => wav is present logical :: esp_present ! .true. => esp is present - logical :: iac_present ! .true. => iac is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input @@ -405,7 +352,6 @@ module cime_comp_mod logical :: rof_prognostic ! .true. => rof comp expects input logical :: wav_prognostic ! .true. => wav comp expects input logical :: esp_prognostic ! .true. => esp comp expects input - logical :: iac_prognostic ! .true. => iac comp expects input logical :: atm_c2_lnd ! .true. => atm to lnd coupling on logical :: atm_c2_ocn ! .true. => atm to ocn coupling on @@ -416,7 +362,6 @@ module cime_comp_mod logical :: lnd_c2_glc ! .true. => lnd to glc coupling on logical :: ocn_c2_atm ! .true. => ocn to atm coupling on logical :: ocn_c2_ice ! .true. => ocn to ice coupling on - logical :: ocn_c2_glcshelf ! .true. => ocn to glc ice shelf coupling on logical :: ocn_c2_wav ! .true. => ocn to wav coupling on logical :: ice_c2_atm ! .true. => ice to atm coupling on logical :: ice_c2_ocn ! .true. => ice to ocn coupling on @@ -427,14 +372,8 @@ module cime_comp_mod logical :: glc_c2_lnd ! .true. => glc to lnd coupling on logical :: glc_c2_ocn ! .true. => glc to ocn coupling on logical :: glc_c2_ice ! .true. => glc to ice coupling on - logical :: glcshelf_c2_ocn ! .true. => glc ice shelf to ocn coupling on - logical :: glcshelf_c2_ice ! .true. => glc ice shelf to ice coupling on logical :: wav_c2_ocn ! .true. => wav to ocn coupling on - logical :: iac_c2_lnd ! .true. => iac to lnd coupling on - logical :: iac_c2_atm ! .true. => iac to atm coupling on - logical :: lnd_c2_iac ! .true. => lnd to iac coupling on - logical :: dead_comps ! .true. => dead components logical :: esmf_map_flag ! .true. => use esmf for mapping @@ -461,7 +400,6 @@ module cime_comp_mod character(CL) :: rof_gnam ! rof grid character(CL) :: glc_gnam ! glc grid character(CL) :: wav_gnam ! wav grid - character(CL) :: iac_gnam ! iac grid logical :: samegrid_ao ! samegrid atm and ocean logical :: samegrid_al ! samegrid atm and land @@ -474,7 +412,6 @@ module cime_comp_mod logical :: samegrid_og ! samegrid glc and ocean logical :: samegrid_ig ! samegrid glc and ice logical :: samegrid_alo ! samegrid atm, lnd, ocean - logical :: samegrid_zl ! samegrid iac and land logical :: read_restart ! local read restart flag character(CL) :: rest_file ! restart file path + filename @@ -482,10 +419,12 @@ module cime_comp_mod logical :: shr_map_dopole ! logical for dopole in shr_map_mod logical :: domain_check ! .true. => check consistency of domains logical :: reprosum_use_ddpdd ! setup reprosum, use ddpdd - logical :: reprosum_allow_infnan ! setup reprosum, allow INF and NaN in summands real(r8) :: reprosum_diffmax ! setup reprosum, set rel_diff_max logical :: reprosum_recompute ! setup reprosum, recompute if tolerance exceeded + integer :: shr_flux_scheme !+tht option for COARE flux computation (=0,1) + logical :: shr_alb_cosz_avg !+tht option for using cosz time-step average in albedos + logical :: output_perf = .false. ! require timing data output for this pe logical :: in_first_day = .true. ! currently simulating first day @@ -533,9 +472,7 @@ module cime_comp_mod &Sa_co2diag:Sa_co2prog' ! --- other --- - character(len=cs) :: cime_model - integer :: driver_id ! ID for multi-driver setup integer :: ocnrun_count ! number of times ocn run alarm went on logical :: exists ! true if file exists integer :: ierr ! MPI error return @@ -563,7 +500,6 @@ module cime_comp_mod integer :: nthreads_ROFID ! OMP glc number of threads integer :: nthreads_WAVID ! OMP wav number of threads integer :: nthreads_ESPID ! OMP esp number of threads - integer :: nthreads_IACID ! OMP iac number of threads integer :: pethreads_GLOID ! OMP number of threads per task @@ -584,7 +520,6 @@ module cime_comp_mod integer :: mpicom_CPLALLGLCID ! MPI comm for CPLALLGLCID integer :: mpicom_CPLALLROFID ! MPI comm for CPLALLROFID integer :: mpicom_CPLALLWAVID ! MPI comm for CPLALLWAVID - integer :: mpicom_CPLALLIACID ! MPI comm for CPLALLIACID integer :: iam_GLOID ! pe number in global id logical :: iamin_CPLID ! pe associated with CPLID @@ -598,7 +533,6 @@ module cime_comp_mod logical :: iamin_CPLALLGLCID ! pe associated with CPLALLGLCID logical :: iamin_CPLALLROFID ! pe associated with CPLALLROFID logical :: iamin_CPLALLWAVID ! pe associated with CPLALLWAVID - logical :: iamin_CPLALLIACID ! pe associated with CPLALLIACID !---------------------------------------------------------------------------- @@ -621,7 +555,6 @@ module cime_comp_mod integer, parameter :: comp_num_rof = 6 integer, parameter :: comp_num_wav = 7 integer, parameter :: comp_num_esp = 8 - integer, parameter :: comp_num_iac = 9 !---------------------------------------------------------------------------- ! misc @@ -629,7 +562,7 @@ module cime_comp_mod integer, parameter :: ens1=1 ! use first instance of ensemble only integer, parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed - integer :: eai, eli, eoi, eii, egi, eri, ewi, eei, exi, efi, ezi ! component instance counters + integer :: eai, eli, eoi, eii, egi, eri, ewi, eei, exi, efi ! component instance counters !---------------------------------------------------------------------------- ! formats @@ -664,11 +597,8 @@ subroutine cime_pre_init1(esmf_log_option) logical :: comp_iamin(num_inst_total) character(len=seq_comm_namelen) :: comp_name(num_inst_total) integer :: it + integer :: driver_id integer :: driver_comm - integer :: npes_CPLID - logical :: verbose_taskmap_output - character(len=8) :: c_cpl_inst ! coupler instance number - character(len=8) :: c_cpl_npes ! number of pes in coupler !--- NorCPM modify, declares integer :: mppwidth,npes=0,mem,myid,mynewid,mem1 integer :: new_comm ,rank_local,comm_enscomp @@ -747,10 +677,12 @@ subroutine cime_pre_init1(esmf_log_option) if (iamroot_GLOID) output_perf = .true. call seq_comm_getinfo(CPLID,mpicom=mpicom_CPLID,& - iamroot=iamroot_CPLID,npes=npes_CPLID, & - nthreads=nthreads_CPLID,iam=comp_comm_iam(it)) + iamroot=iamroot_CPLID,nthreads=nthreads_CPLID,& + iam=comp_comm_iam(it)) if (iamroot_CPLID) output_perf = .true. + if (iamin_CPLID) complist = trim(complist)//' cpl' + comp_id(it) = CPLID comp_comm(it) = mpicom_CPLID iamin_CPLID = seq_comm_iamin(CPLID) @@ -764,6 +696,9 @@ subroutine cime_pre_init1(esmf_log_option) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(ATMID(eai), mpicom=comp_comm(it), & nthreads=nthreads_ATMID, iam=comp_comm_iam(it)) + if (seq_comm_iamin(ATMID(eai))) then + complist = trim(complist)//' '//trim(seq_comm_name(ATMID(eai))) + endif if (seq_comm_iamroot(ATMID(eai))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLATMID, mpicom=mpicom_CPLALLATMID) @@ -776,6 +711,9 @@ subroutine cime_pre_init1(esmf_log_option) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(LNDID(eli), mpicom=comp_comm(it), & nthreads=nthreads_LNDID, iam=comp_comm_iam(it)) + if (seq_comm_iamin(LNDID(eli))) then + complist = trim(complist)//' '//trim(seq_comm_name(LNDID(eli))) + endif if (seq_comm_iamroot(LNDID(eli))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLLNDID, mpicom=mpicom_CPLALLLNDID) @@ -788,6 +726,9 @@ subroutine cime_pre_init1(esmf_log_option) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(OCNID(eoi), mpicom=comp_comm(it), & nthreads=nthreads_OCNID, iam=comp_comm_iam(it)) + if (seq_comm_iamin (OCNID(eoi))) then + complist = trim(complist)//' '//trim(seq_comm_name(OCNID(eoi))) + endif if (seq_comm_iamroot(OCNID(eoi))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLOCNID, mpicom=mpicom_CPLALLOCNID) @@ -800,6 +741,9 @@ subroutine cime_pre_init1(esmf_log_option) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(ICEID(eii), mpicom=comp_comm(it), & nthreads=nthreads_ICEID, iam=comp_comm_iam(it)) + if (seq_comm_iamin (ICEID(eii))) then + complist = trim(complist)//' '//trim(seq_comm_name(ICEID(eii))) + endif if (seq_comm_iamroot(ICEID(eii))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLICEID, mpicom=mpicom_CPLALLICEID) @@ -811,6 +755,9 @@ subroutine cime_pre_init1(esmf_log_option) comp_iamin(it) = seq_comm_iamin(comp_id(it)) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(GLCID(egi), mpicom=comp_comm(it), nthreads=nthreads_GLCID, iam=comp_comm_iam(it)) + if (seq_comm_iamin (GLCID(egi))) then + complist = trim(complist)//' '//trim(seq_comm_name(GLCID(egi))) + endif if (seq_comm_iamroot(GLCID(egi))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLGLCID, mpicom=mpicom_CPLALLGLCID) @@ -823,6 +770,9 @@ subroutine cime_pre_init1(esmf_log_option) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(ROFID(eri), mpicom=comp_comm(it), & nthreads=nthreads_ROFID, iam=comp_comm_iam(it)) + if (seq_comm_iamin(ROFID(eri))) then + complist = trim(complist)//' '//trim( seq_comm_name(ROFID(eri))) + endif if (seq_comm_iamroot(ROFID(eri))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLROFID, mpicom=mpicom_CPLALLROFID) @@ -835,34 +785,24 @@ subroutine cime_pre_init1(esmf_log_option) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(WAVID(ewi), mpicom=comp_comm(it), & nthreads=nthreads_WAVID, iam=comp_comm_iam(it)) + if (seq_comm_iamin(WAVID(ewi))) then + complist = trim(complist)//' '//trim(seq_comm_name(WAVID(ewi))) + endif if (seq_comm_iamroot(WAVID(ewi))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLWAVID, mpicom=mpicom_CPLALLWAVID) iamin_CPLALLWAVID = seq_comm_iamin(CPLALLWAVID) - ! IAC mods - do ezi = 1,num_inst_iac - it=it+1 - comp_id(it) = IACID(ezi) - comp_iamin(it) = seq_comm_iamin(comp_id(it)) - comp_name(it) = seq_comm_name(comp_id(it)) - call seq_comm_getinfo(IACID(ezi), mpicom=comp_comm(it), & - nthreads=nthreads_IACID, iam=comp_comm_iam(it)) - if (seq_comm_iamin(IACID(ezi))) then - complist = trim(complist)//' '//trim(seq_comm_name(IACID(ezi))) - endif - if (seq_comm_iamroot(IACID(ezi))) output_perf = .true. - enddo - call seq_comm_getinfo(CPLALLIACID, mpicom=mpicom_CPLALLIACID) - iamin_CPLALLIACID = seq_comm_iamin(CPLALLIACID) - - do eei = 1,num_inst_esp + do eei = 1,num_inst_esp it=it+1 comp_id(it) = ESPID(eei) comp_iamin(it) = seq_comm_iamin(comp_id(it)) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(ESPID(eei), mpicom=comp_comm(it), & nthreads=nthreads_ESPID, iam=comp_comm_iam(it)) + if (seq_comm_iamin (ESPID(eei))) then + complist = trim(complist)//' '//trim(seq_comm_name(ESPID(eei))) + endif enddo ! ESP components do not use the coupler (they are 'external') @@ -884,42 +824,6 @@ subroutine cime_pre_init1(esmf_log_option) call shr_file_setLogLevel(loglevel) endif - !---------------------------------------------------------- - !| Output task-to-node mapping data for coupler - !---------------------------------------------------------- - - if (info_taskmap_comp > 0) then - ! Identify SMP nodes and process/SMP mapping for the coupler. - ! (Assume that processor names are SMP node names on SMP clusters.) - - if (iamin_CPLID) then - - if (info_taskmap_comp == 1) then - verbose_taskmap_output = .false. - else - verbose_taskmap_output = .true. - endif - - write(c_cpl_inst,'(i8)') num_inst_driver - - if (iamroot_CPLID) then - write(c_cpl_npes,'(i8)') npes_CPLID - write(logunit,'(3A)') trim(adjustl(c_cpl_npes)), & - ' pes participating in computation of CPL instance #', & - trim(adjustl(c_cpl_inst)) - call shr_sys_flush(logunit) - endif - - call t_startf("shr_taskmap_write") - call shr_taskmap_write(logunit, mpicom_CPLID, & - 'CPL #'//trim(adjustl(c_cpl_inst)), & - verbose=verbose_taskmap_output ) - call t_stopf("shr_taskmap_write") - - endif - - endif - !---------------------------------------------------------- ! Log info about the environment settings !---------------------------------------------------------- @@ -938,7 +842,7 @@ subroutine cime_pre_init1(esmf_log_option) !---------------------------------------------------------- ! Read ESMF namelist settings !---------------------------------------------------------- - call cime_esmf_readnl(NLFileName, mpicom_GLOID, esmf_log_option) + call esmf_readnl(NLFileName, mpicom_GLOID, esmf_log_option) ! ! When using io servers (pio_async_interface=.true.) the server tasks do not return from @@ -949,8 +853,9 @@ subroutine cime_pre_init1(esmf_log_option) end subroutine cime_pre_init1 !=============================================================================== - - subroutine cime_esmf_readnl(NLFileName, mpicom, esmf_logfile_kind) + !******************************************************************************* + !=============================================================================== + subroutine esmf_readnl(NLFileName, mpicom, esmf_logfile_kind) use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit character(len=*), intent(in) :: NLFileName @@ -988,7 +893,7 @@ subroutine cime_esmf_readnl(NLFileName, mpicom, esmf_logfile_kind) call mpi_bcast(esmf_logfile_kind, CS, MPI_CHARACTER, 0, mpicom, ierr) - end subroutine cime_esmf_readnl + end subroutine esmf_readnl !=============================================================================== !******************************************************************************* @@ -1017,11 +922,10 @@ subroutine cime_pre_init2() !---------------------------------------------------------- !| Timer initialization (has to be after mpi init) !---------------------------------------------------------- - maxthreads = max(nthreads_GLOID,nthreads_CPLID,nthreads_ATMID, & nthreads_LNDID,nthreads_ICEID,nthreads_OCNID,nthreads_GLCID, & - nthreads_ROFID, nthreads_WAVID, nthreads_ESPID, nthreads_IACID, & - pethreads_GLOID ) + nthreads_ROFID, nthreads_WAVID, nthreads_ESPID, pethreads_GLOID ) + call t_initf(NLFileName, LogPrint=.true., mpicom=mpicom_GLOID, & MasterTask=iamroot_GLOID,MaxThreads=maxthreads) @@ -1047,16 +951,11 @@ subroutine cime_pre_init2() call seq_infodata_init(infodata,nlfilename, GLOID, pioid) end if - !---------------------------------------------------------- - ! Read shr_flux namelist settings - !---------------------------------------------------------- - call seq_flux_readnl_mct(nlfilename, CPLID) - !---------------------------------------------------------- ! Print Model heading and copyright message !---------------------------------------------------------- - if (iamroot_CPLID) call cime_printlogheader() + if (iamroot_CPLID) call seq_cime_printlogheader() !---------------------------------------------------------- !| Initialize coupled fields (depends on infodata) @@ -1092,7 +991,6 @@ subroutine cime_pre_init2() rof_present=rof_present , & wav_present=wav_present , & esp_present=esp_present , & - iac_present=iac_present , & single_column=single_column , & aqua_planet=aqua_planet , & cpl_seq_option=cpl_seq_option , & @@ -1126,16 +1024,16 @@ subroutine cime_pre_init2() rof_gnam=rof_gnam , & glc_gnam=glc_gnam , & wav_gnam=wav_gnam , & - iac_gnam=iac_gnam , & tfreeze_option = tfreeze_option , & cpl_decomp=seq_mctext_decomp , & shr_map_dopole=shr_map_dopole , & + flux_scheme=shr_flux_scheme , & !+tht option for COARE flux computation + alb_cosz_avg=shr_alb_cosz_avg , & !+tht option for using time-step avg cosz for albedos wall_time_limit=wall_time_limit , & force_stop_at=force_stop_at , & reprosum_use_ddpdd=reprosum_use_ddpdd , & - reprosum_allow_infnan=reprosum_allow_infnan, & reprosum_diffmax=reprosum_diffmax , & - reprosum_recompute=reprosum_recompute , & + reprosum_recompute=reprosum_recompute, & max_cplstep_time=max_cplstep_time) ! above - cpl_decomp is set to pass the cpl_decomp value to seq_mctext_decomp @@ -1145,18 +1043,20 @@ subroutine cime_pre_init2() call shr_reprosum_setopts(& repro_sum_use_ddpdd_in = reprosum_use_ddpdd, & - repro_sum_allow_infnan_in = reprosum_allow_infnan, & repro_sum_rel_diff_max_in = reprosum_diffmax, & repro_sum_recompute_in = reprosum_recompute) + call shr_flux_docoare(shr_flux_scheme) !+tht option for COARE flux computation + call shr_orb_doalbavg(shr_alb_cosz_avg) !+tht option for albedo cosz avg'ing + ! Check cpl_seq_option - if (trim(cpl_seq_option) /= 'CESM1_MOD' .and. & - trim(cpl_seq_option) /= 'CESM1_MOD_TIGHT' .and. & - trim(cpl_seq_option) /= 'RASM_OPTION1' .and. & - trim(cpl_seq_option) /= 'RASM_OPTION2' .and. & - trim(cpl_seq_option) /= 'NUOPC' .and. & - trim(cpl_seq_option) /= 'NUOPC_TIGHT' ) then + if (trim(cpl_seq_option) /= 'CESM1_ORIG' .and. & + trim(cpl_seq_option) /= 'CESM1_ORIG_TIGHT' .and. & + trim(cpl_seq_option) /= 'CESM1_MOD' .and. & + trim(cpl_seq_option) /= 'CESM1_MOD_TIGHT' .and. & + trim(cpl_seq_option) /= 'RASM_OPTION1' .and. & + trim(cpl_seq_option) /= 'RASM_OPTION2' ) then call shr_sys_abort(subname//' invalid cpl_seq_option = '//trim(cpl_seq_option)) endif @@ -1198,9 +1098,6 @@ subroutine cime_pre_init2() call seq_comm_setnthreads(nthreads_ESPID) if (iamroot_GLOID) write(logunit,'(2A,2I4)') subname,' nthreads_ESPID = ',& nthreads_ESPID,seq_comm_getnthreads() - call seq_comm_setnthreads(nthreads_IACID) - if (iamroot_GLOID) write(logunit,'(2A,2I4)') subname,' nthreads_IACID = ',& - nthreads_IACID,seq_comm_getnthreads() if (iamroot_GLOID) write(logunit,*) ' ' call seq_comm_setnthreads(nthreads_GLOID) @@ -1213,8 +1110,7 @@ subroutine cime_pre_init2() call seq_timemgr_clockInit(seq_SyncClock, nlfilename, & read_restart, rest_file, pioid, mpicom_gloid, & EClock_d, EClock_a, EClock_l, EClock_o, & - EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e, & - EClock_z) + EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e) if (iamroot_CPLID) then call seq_timemgr_clockPrint(seq_SyncClock) @@ -1234,7 +1130,7 @@ subroutine cime_pre_init2() ! Initialize freezing point calculation for all components !---------------------------------------------------------- - call shr_frz_freezetemp_init(tfreeze_option, iamroot_GLOID) + call shr_frz_freezetemp_init(tfreeze_option) if (trim(orb_mode) == trim(seq_infodata_orb_variable_year)) then call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd) @@ -1292,7 +1188,6 @@ subroutine cime_pre_init2() ice_phase=1, & glc_phase=1, & wav_phase=1, & - iac_phase=1, & esp_phase=1) !---------------------------------------------------------- @@ -1337,6 +1232,9 @@ end subroutine cime_pre_init2 subroutine cime_init() + character(CL), allocatable :: comp_resume(:) + + 104 format( A, i10.8, i8) !----------------------------------------------------------------------------- @@ -1356,10 +1254,9 @@ subroutine cime_init() call t_startf('CPL:init_comps') if (iamroot_CPLID )then write(logunit,*) ' ' - write(logunit,F00) 'Initialize each component: atm, lnd, rof, ocn, ice, glc, wav, esp, iac' + write(logunit,F00) 'Initialize each component: atm, lnd, rof, ocn, ice, glc, wav, esp' call shr_sys_flush(logunit) endif - call seq_infodata_GetData(infodata, cime_model=cime_model) call t_startf('CPL:comp_init_pre_all') call component_init_pre(atm, ATMID, CPLATMID, CPLALLATMID, infodata, ntype='atm') @@ -1370,8 +1267,6 @@ subroutine cime_init() call component_init_pre(glc, GLCID, CPLGLCID, CPLALLGLCID, infodata, ntype='glc') call component_init_pre(wav, WAVID, CPLWAVID, CPLALLWAVID, infodata, ntype='wav') call component_init_pre(esp, ESPID, CPLESPID, CPLALLESPID, infodata, ntype='esp') - call component_init_pre(iac, IACID, CPLIACID, CPLALLIACID, infodata, ntype='iac') - call t_stopf('CPL:comp_init_pre_all') call t_startf('CPL:comp_init_cc_atm') @@ -1423,12 +1318,6 @@ subroutine cime_init() call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cc_esp') - call t_startf('comp_init_cc_iac') - call t_adj_detailf(+2) - call component_init_cc(Eclock_z, iac, iac_init, infodata, NLFilename) - call t_adj_detailf(-2) - call t_stopf('comp_init_cc_iac') - call t_startf('CPL:comp_init_cx_all') call t_adj_detailf(+2) call component_init_cx(atm, infodata) @@ -1438,7 +1327,6 @@ subroutine cime_init() call component_init_cx(ice, infodata) call component_init_cx(glc, infodata) call component_init_cx(wav, infodata) - call component_init_cx(iac, infodata) call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cx_all') @@ -1492,14 +1380,6 @@ subroutine cime_init() endif enddo - do ezi = 1,num_inst_iac - iamin_ID = component_get_iamin_compid(iac(ezi)) - if (iamin_ID) then - compname = component_get_name(iac(ezi)) - complist = trim(complist)//' '//trim(compname) - endif - enddo - do eei = 1,num_inst_esp iamin_ID = component_get_iamin_compid(esp(eei)) if (iamin_ID) then @@ -1512,7 +1392,6 @@ subroutine cime_init() call t_stopf('CPL:comp_list_all') call t_stopf('CPL:init_comps') - !---------------------------------------------------------- !| Determine coupling interactions based on present and prognostic flags !---------------------------------------------------------- @@ -1524,7 +1403,6 @@ subroutine cime_init() if (iamin_CPLALLGLCID) call seq_infodata_exchange(infodata,CPLALLGLCID,'cpl2glc_init') if (iamin_CPLALLROFID) call seq_infodata_exchange(infodata,CPLALLROFID,'cpl2rof_init') if (iamin_CPLALLWAVID) call seq_infodata_exchange(infodata,CPLALLWAVID,'cpl2wav_init') - if (iamin_CPLALLIACID) call seq_infodata_exchange(infodata,CPLALLIACID,'cpl2iac_init') if (iamroot_CPLID) then write(logunit,F00) 'Determine final settings for presence of surface components' @@ -1543,7 +1421,6 @@ subroutine cime_init() rof_present=rof_present, & rofice_present=rofice_present, & wav_present=wav_present, & - iac_present=iac_present, & esp_present=esp_present, & flood_present=flood_present, & atm_prognostic=atm_prognostic, & @@ -1552,11 +1429,9 @@ subroutine cime_init() iceberg_prognostic=iceberg_prognostic, & ocn_prognostic=ocn_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & - ocn_c2_glcshelf=ocn_c2_glcshelf, & glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & wav_prognostic=wav_prognostic, & - iac_prognostic=iac_prognostic, & esp_prognostic=esp_prognostic, & dead_comps=dead_comps, & esmf_map_flag=esmf_map_flag, & @@ -1567,7 +1442,6 @@ subroutine cime_init() glc_nx=glc_nx, glc_ny=glc_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & wav_nx=wav_nx, wav_ny=wav_ny, & - iac_nx=iac_nx, iac_ny=iac_ny, & atm_aero=atm_aero ) ! derive samegrid flags @@ -1620,12 +1494,7 @@ subroutine cime_init() glc_c2_lnd = .false. glc_c2_ocn = .false. glc_c2_ice = .false. - glcshelf_c2_ocn = .false. - glcshelf_c2_ice = .false. wav_c2_ocn = .false. - iac_c2_atm = .false. - iac_c2_lnd = .false. - lnd_c2_iac = .false. if (atm_present) then if (lnd_prognostic) atm_c2_lnd = .true. @@ -1638,14 +1507,12 @@ subroutine cime_init() if (atm_prognostic) lnd_c2_atm = .true. if (rof_prognostic) lnd_c2_rof = .true. if (glc_prognostic) lnd_c2_glc = .true. - if (iac_prognostic) lnd_c2_iac = .true. endif if (ocn_present) then if (atm_prognostic) ocn_c2_atm = .true. if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm if (ice_prognostic) ocn_c2_ice = .true. if (wav_prognostic) ocn_c2_wav = .true. - endif if (ice_present) then if (atm_prognostic) ice_c2_atm = .true. @@ -1660,21 +1527,11 @@ subroutine cime_init() if (glc_present) then if (glclnd_present .and. lnd_prognostic) glc_c2_lnd = .true. if (glcocn_present .and. ocn_prognostic) glc_c2_ocn = .true. - ! For now, glcshelf->ocn only activated if the ocean has activated ocn->glcshelf - if (ocn_c2_glcshelf .and. glcocn_present .and. ocn_prognostic) glcshelf_c2_ocn = .true. - ! For now, glacshelf->ice also controlled by ocean's ocn_c2_glcshelf flag - ! Note that ice also has to be prognostic for glcshelf_c2_ice to be true. - ! It is not expected that glc and ice would ever be run without ocn prognostic. - if (ocn_c2_glcshelf .and. glcice_present .and. ice_prognostic) glcshelf_c2_ice = .true. if (glcice_present .and. iceberg_prognostic) glc_c2_ice = .true. endif if (wav_present) then if (ocn_prognostic) wav_c2_ocn = .true. endif - if (iac_present) then - if (lnd_prognostic) iac_c2_lnd = .true. - if (atm_prognostic) iac_c2_atm = .true. - endif !---------------------------------------------------------- ! Set domain check and other flag @@ -1716,7 +1573,6 @@ subroutine cime_init() write(logunit,F0L)'rof/ice present = ',rofice_present write(logunit,F0L)'rof/flood present = ',flood_present write(logunit,F0L)'wav model present = ',wav_present - write(logunit,F0L)'iac model present = ',iac_present write(logunit,F0L)'esp model present = ',esp_present write(logunit,F0L)'atm model prognostic = ',atm_prognostic @@ -1728,7 +1584,6 @@ subroutine cime_init() write(logunit,F0L)'rof model prognostic = ',rof_prognostic write(logunit,F0L)'ocn rof prognostic = ',ocnrof_prognostic write(logunit,F0L)'wav model prognostic = ',wav_prognostic - write(logunit,F0L)'iac model prognostic = ',iac_prognostic write(logunit,F0L)'esp model prognostic = ',esp_prognostic write(logunit,F0L)'atm_c2_lnd = ',atm_c2_lnd @@ -1740,7 +1595,6 @@ subroutine cime_init() write(logunit,F0L)'lnd_c2_glc = ',lnd_c2_glc write(logunit,F0L)'ocn_c2_atm = ',ocn_c2_atm write(logunit,F0L)'ocn_c2_ice = ',ocn_c2_ice - write(logunit,F0L)'ocn_c2_glcshelf = ',ocn_c2_glcshelf write(logunit,F0L)'ocn_c2_wav = ',ocn_c2_wav write(logunit,F0L)'ice_c2_atm = ',ice_c2_atm write(logunit,F0L)'ice_c2_ocn = ',ice_c2_ocn @@ -1751,11 +1605,7 @@ subroutine cime_init() write(logunit,F0L)'glc_c2_lnd = ',glc_c2_lnd write(logunit,F0L)'glc_c2_ocn = ',glc_c2_ocn write(logunit,F0L)'glc_c2_ice = ',glc_c2_ice - write(logunit,F0L)'glcshelf_c2_ocn = ',glcshelf_c2_ocn - write(logunit,F0L)'glcshelf_c2_ice = ',glcshelf_c2_ice write(logunit,F0L)'wav_c2_ocn = ',wav_c2_ocn - write(logunit,F0L)'iac_c2_lnd = ',iac_c2_lnd - write(logunit,F0L)'iac_c2_atm = ',iac_c2_atm write(logunit,F0L)'dead components = ',dead_comps write(logunit,F0L)'domain_check = ',domain_check @@ -1766,7 +1616,6 @@ subroutine cime_init() write(logunit,F01)'ocn_nx,ocn_ny = ',ocn_nx,ocn_ny,trim(ocn_gnam) write(logunit,F01)'glc_nx,glc_ny = ',glc_nx,glc_ny,trim(glc_gnam) write(logunit,F01)'wav_nx,wav_ny = ',wav_nx,wav_ny,trim(wav_gnam) - write(logunit,F01)'iac_nx,iac_ny = ',iac_nx,iac_ny,trim(iac_gnam) write(logunit,F0L)'samegrid_ao = ',samegrid_ao write(logunit,F0L)'samegrid_al = ',samegrid_al write(logunit,F0L)'samegrid_ro = ',samegrid_ro @@ -1811,9 +1660,6 @@ subroutine cime_init() if (esp_prognostic .and. .not.esp_present) then call shr_sys_abort(subname//' ERROR: if prognostic esp must also have esp present') endif - if (iac_prognostic .and. .not.iac_present) then - call shr_sys_abort(subname//' ERROR: if prognostic iac must also have iac present') - endif #ifndef CPL_BYPASS if ((ice_prognostic .or. ocn_prognostic .or. lnd_prognostic) .and. .not. atm_present) then call shr_sys_abort(subname//' ERROR: if prognostic surface model must also have atm present') @@ -1822,11 +1668,6 @@ subroutine cime_init() if ((glclnd_present .or. glcocn_present .or. glcice_present) .and. .not.glc_present) then call shr_sys_abort(subname//' ERROR: if glcxxx present must also have glc present') endif - if ((ocn_c2_glcshelf .and. .not. glcshelf_c2_ocn) .or. (glcshelf_c2_ocn .and. .not. ocn_c2_glcshelf)) then - ! Current logic will not allow this to be true, but future changes could make it so, which may be nonsensical - call shr_sys_abort(subname//' ERROR: if glc_c2_ocn must also have ocn_c2_glc and vice versa. '//& - 'Boundary layer fluxes calculated in coupler require input from both components.') - endif if (rofice_present .and. .not.rof_present) then call shr_sys_abort(subname//' ERROR: if rofice present must also have rof present') endif @@ -1863,8 +1704,6 @@ subroutine cime_init() call shr_sys_abort(subname//' ERROR: rof_prognostic but num_inst_rof not num_inst_max') if (wav_prognostic .and. num_inst_wav /= num_inst_max) & call shr_sys_abort(subname//' ERROR: wav_prognostic but num_inst_wav not num_inst_max') - if (iac_prognostic .and. num_inst_iac /= num_inst_max) & - call shr_sys_abort(subname//' ERROR: iac_prognostic but num_inst_iac not num_inst_max') !---------------------------------------------------------- !| Initialize attribute vectors for prep_c2C_init_avs routines and fractions @@ -1877,22 +1716,20 @@ subroutine cime_init() call t_adj_detailf(+2) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_lnd) + call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) - call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_lnd) + call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd) - call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) + call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn) - call prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_c2_ice ) + call prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, rof_c2_ice ) call prep_rof_init(infodata, lnd_c2_rof) - call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) + call prep_glc_init(infodata, lnd_c2_glc) call prep_wav_init(infodata, atm_c2_wav, ocn_c2_wav, ice_c2_wav) - call prep_iac_init(infodata, lnd_c2_iac) - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) call t_stopf('CPL:init_maps') @@ -1954,7 +1791,7 @@ subroutine cime_init() !---------------------------------------------------------- areafact_samegrid = .false. -#if (defined E3SM_SCM_REPLAY ) +#if (defined BFB_CAM_SCAM_IOP ) if (.not.samegrid_alo) then call shr_sys_abort(subname//' ERROR: samegrid_alo is false - Must run with same atm/ocn/lnd grids when configured for scam iop') else @@ -1963,10 +1800,6 @@ subroutine cime_init() #endif if (single_column) areafact_samegrid = .true. -#ifdef COMPARE_TO_NUOPC - areafact_samegrid = .true. -#endif - call t_startf ('CPL:init_areacor') call t_adj_detailf(+2) @@ -1991,9 +1824,6 @@ subroutine cime_init() call mpi_barrier(mpicom_GLOID,ierr) if (wav_present) call component_init_areacor(wav, areafact_samegrid, seq_flds_w2x_fluxes) - call mpi_barrier(mpicom_GLOID,ierr) - if (iac_present) call component_init_areacor(iac, areafact_samegrid, seq_flds_z2x_fluxes) - call t_adj_detailf(-2) call t_stopf ('CPL:init_areacor') @@ -2034,10 +1864,6 @@ subroutine cime_init() call component_diag(infodata, wav, flow='c2x', comment='recv IC wav', & info_debug=info_debug) endif - if (iac_present) then - call component_diag(infodata, iac, flow='c2x', comment='recv IC iac', & - info_debug=info_debug) - endif if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -2059,7 +1885,6 @@ subroutine cime_init() allocate(fractions_gx(num_inst_frc)) allocate(fractions_rx(num_inst_frc)) allocate(fractions_wx(num_inst_frc)) - allocate(fractions_zx(num_inst_frc)) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) do efi = 1,num_inst_frc @@ -2073,10 +1898,10 @@ subroutine cime_init() call seq_frac_init(infodata, & atm(ens1), ice(ens1), lnd(ens1), & ocn(ens1), glc(ens1), rof(ens1), & - wav(ens1), iac(ens1), & + wav(ens1), & fractions_ax(efi), fractions_ix(efi), fractions_lx(efi), & fractions_ox(efi), fractions_gx(efi), fractions_rx(efi), & - fractions_wx(efi), fractions_zx(efi)) + fractions_wx(efi)) if (iamroot_CPLID) then write(logunit,*) ' ' @@ -2134,14 +1959,17 @@ subroutine cime_init() endif +!+tht albedo cosz option + call seq_timemgr_EClockGetData( EClock_d, dtime=dtime) !+tht do exi = 1,num_inst_xao !tcx is this correct? relation between xao and frc for ifrad and ofrad efi = mod((exi-1),num_inst_frc) + 1 eai = mod((exi-1),num_inst_atm) + 1 xao_ox => prep_aoflux_get_xao_ox() ! array over all instances a2x_ox => prep_ocn_get_a2x_ox() - call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi)) + call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi), dtime) !+tht dtime enddo +!-tht if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) @@ -2209,8 +2037,7 @@ subroutine cime_init() ! Data or dead atmosphere may just return on this phase. !---------------------------------------------------------- - if (atm_prognostic) then - + if (atm_present) then call t_startf('CPL:comp_init_cc_atm2') call t_adj_detailf(+2) @@ -2267,9 +2094,9 @@ subroutine cime_init() call seq_diag_zero_mct(mode='all') if (read_restart .and. iamin_CPLID) then call seq_rest_read(rest_file, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & + atm, lnd, ice, ocn, rof, glc, wav, esp, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, fractions_zx) + fractions_rx, fractions_gx, fractions_wx) endif call t_adj_detailf(-2) @@ -2286,22 +2113,12 @@ subroutine cime_init() if (glc_c2_ocn) then call prep_ocn_calc_g2x_ox(timer='CPL:init_glc2ocn') endif - - if (glcshelf_c2_ocn) then - call prep_ocn_shelf_calc_g2x_ox(timer='CPL:init_glc2ocn_shelf') - endif - if (rof_c2_ice) then call prep_ice_calc_r2x_ix(timer='CPL:init_rof2ice') endif if (glc_c2_ice) then call prep_ice_calc_g2x_ix(timer='CPL:init_glc2ice') endif - - if (glcshelf_c2_ice) then - call prep_ice_shelf_calc_g2x_ix(timer='CPL:init_glc2ice_shelf') - endif - if (rof_c2_lnd) then call prep_lnd_calc_r2x_lx(timer='CPL:init_rof2lnd') endif @@ -2310,6 +2127,22 @@ subroutine cime_init() endif endif + !---------------------------------------------------------- + !| Clear all resume signals + !---------------------------------------------------------- + allocate(comp_resume(num_inst_max)) + comp_resume = '' + call seq_infodata_putData(infodata, & + atm_resume=comp_resume(1:num_inst_atm), & + lnd_resume=comp_resume(1:num_inst_lnd), & + ocn_resume=comp_resume(1:num_inst_ocn), & + ice_resume=comp_resume(1:num_inst_ice), & + glc_resume=comp_resume(1:num_inst_glc), & + rof_resume=comp_resume(1:num_inst_rof), & + wav_resume=comp_resume(1:num_inst_wav), & + cpl_resume=comp_resume(1)) + deallocate(comp_resume) + !---------------------------------------------------------- !| Write histinit output file !---------------------------------------------------------- @@ -2326,9 +2159,9 @@ subroutine cime_init() call shr_sys_flush(logunit) endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, iac, & + atm, lnd, ice, ocn, rof, glc, wav, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -2353,26 +2186,21 @@ end subroutine cime_init !=============================================================================== subroutine cime_run() - use shr_string_mod, only: shr_string_listGetIndexF - use seq_comm_mct, only: atm_layout, lnd_layout, ice_layout - use seq_comm_mct, only: glc_layout, rof_layout, ocn_layout - use seq_comm_mct, only: wav_layout, esp_layout, iac_layout, num_inst_driver - use seq_comm_mct, only: seq_comm_inst - use seq_pauseresume_mod, only: seq_resume_store_comp, seq_resume_get_files - use seq_pauseresume_mod, only: seq_resume_free + use seq_comm_mct, only: atm_layout, lnd_layout, ice_layout, glc_layout, & + rof_layout, ocn_layout, wav_layout, esp_layout + use shr_string_mod, only: shr_string_listGetIndexF + use seq_comm_mct, only: num_inst_driver ! gptl timer lookup variables - integer, parameter :: hashcnt=7 - integer :: hashint(hashcnt) - ! Driver pause/resume - logical :: drv_pause ! Driver writes pause restart file - character(len=CL) :: drv_resume ! Driver resets state from restart file - character(len=CL), pointer :: resume_files(:) ! Component resume files - - type(ESMF_Time) :: etime_curr ! Current model time - real(r8) :: tbnds1_offset ! Time offset for call to seq_hist_writeaux - logical :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep - logical :: prep_glc_accum_avg_called ! Whether prep_glc_accum_avg has been called this timestep + integer, parameter :: hashcnt=7 + integer :: hashint(hashcnt) + ! Driver pause/resume + logical :: drv_pause ! Driver writes pause restart file + character(len=CL) :: drv_resume ! Driver resets state from restart file + + type(ESMF_Time) :: etime_curr ! Current model time + real(r8) :: tbnds1_offset ! Time offset for call to seq_hist_writeaux + logical :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep 101 format( A, i10.8, i8, 12A, A, F8.2, A, F8.2 ) 102 format( A, i10.8, i8, A, 8L3 ) @@ -2382,6 +2210,7 @@ subroutine cime_run() 108 format( A, f10.2, A, i8.8) 109 format( A, 2f10.3) + hashint = 0 call seq_infodata_putData(infodata,atm_phase=1,lnd_phase=1,ocn_phase=1,ice_phase=1) @@ -2404,15 +2233,6 @@ subroutine cime_run() force_stop_ymd = -1 force_stop_tod = -1 - ! --- Write out performance data for initialization - call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd, curr_tod=tod) - write(timing_file,'(a,i8.8,a1,i5.5)') & - trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod - - call t_set_prefixf("CPL:INIT_") - call cime_write_performance_checkpoint(output_perf,timing_file,mpicom_GLOID) - call t_unset_prefixf() - !|---------------------------------------------------------- !| Beginning of driver time step loop !|---------------------------------------------------------- @@ -2446,7 +2266,6 @@ subroutine cime_run() esprun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_esprun) ocnrun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_ocnrun) ocnnext_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_ocnnext) - iacrun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_iacrun) restart_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_restart) history_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_history) histavg_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_histavg) @@ -2457,19 +2276,16 @@ subroutine cime_run() ! Does the driver need to pause? drv_pause = pause_alarm .and. seq_timemgr_pause_component_active(drv_index) - if (glc_prognostic .or. do_hist_l2x1yrg) then + if (glc_prognostic) then ! Is it time to average fields to pass to glc? ! ! Note that the glcrun_avg_alarm just controls what is passed to glc in terms ! of averaged fields - it does NOT control when glc is called currently - ! glc will be called on the glcrun_alarm setting - but it might not be passed relevant ! info if the time averaging period to accumulate information passed to glc is greater - ! than the glcrun interval. - ! - ! Note also that we need to set glcrun_avg_alarm even if glc_prognostic is - ! false, if do_hist_l2x1yrg is set, so that we have valid cpl hist fields + ! than the glcrun interval glcrun_avg_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_glcrun_avg) - if (glc_prognostic .and. glcrun_avg_alarm .and. .not. glcrun_alarm) then + if (glcrun_avg_alarm .and. .not. glcrun_alarm) then write(logunit,*) 'ERROR: glcrun_avg_alarm is true, but glcrun_alarm is false' write(logunit,*) 'Make sure that NCPL_BASE_PERIOD, GLC_NCPL and GLC_AVG_PERIOD' write(logunit,*) 'are set so that glc averaging only happens at glc coupling times.' @@ -2499,7 +2315,6 @@ subroutine cime_run() if (month==1 .and. day==1 .and. tod==0) t1yr_alarm = .true. lnd2glc_averaged_now = .false. - prep_glc_accum_avg_called = .false. if (seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_datestop)) then if (iamroot_CPLID) then @@ -2539,7 +2354,7 @@ subroutine cime_run() write(logunit,102) ' Alarm_state: model date = ',ymd,tod, & ' aliogrw run alarms = ', atmrun_alarm, lndrun_alarm, & icerun_alarm, ocnrun_alarm, glcrun_alarm, & - rofrun_alarm, wavrun_alarm, esprun_alarm, iacrun_alarm + rofrun_alarm, wavrun_alarm, esprun_alarm write(logunit,102) ' Alarm_state: model date = ',ymd,tod, & ' 1.2.3.6.12.24 run alarms = ', t1hr_alarm, t2hr_alarm, & t3hr_alarm, t6hr_alarm, t12hr_alarm, t24hr_alarm @@ -2549,19 +2364,13 @@ subroutine cime_run() call t_stopf ('CPL:CLOCK_ADVANCE') - !---------------------------------------------------------- - !| IAC SETUP-SEND - !---------------------------------------------------------- - if (iac_present .and. iacrun_alarm) then - call cime_run_iac_setup_send() - endif - !---------------------------------------------------------- !| MAP ATM to OCN ! Set a2x_ox as a module variable in prep_ocn_mod ! This will be used later in the ice prep and in the ! atm/ocn flux calculation !---------------------------------------------------------- + if (iamin_CPLID .and. (atm_c2_ocn .or. atm_c2_ice)) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPRE1_BARRIER') call t_drvstartf ('CPL:OCNPRE1',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(3)) @@ -2576,69 +2385,368 @@ subroutine cime_run() !---------------------------------------------------------- !| ATM/OCN SETUP (rasm_option1) !---------------------------------------------------------- - ! The following maps to the ocean, computes atm/ocn fluxes, merges to the ocean, - ! accumulates ocn input and computes ocean albedos - if (ocn_present) then - if (trim(cpl_seq_option) == 'RASM_OPTION1') then - call cime_run_atmocn_setup(hashint) - end if + + if ((trim(cpl_seq_option) == 'RASM_OPTION1') .and. & + iamin_CPLID .and. ocn_present) then + + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCN1_BARRIER') + call t_drvstartf ('CPL:ATMOCN1',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(4)) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (ocn_prognostic) then + ! Map ice to ocn + if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') + + ! Map wav to ocn + if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') + endif + + !---------------------------------------------------------- + !| atm/ocn flux on atm grid (rasm_option1 and aoflux='atm') + !---------------------------------------------------------- + + if (trim(aoflux_grid) == 'atm') then + ! compute o2x_ax for flux_atmocn, will be updated before atm merge + ! do not use fractions because fractions here are NOT consistent with fractions in atm_mrg + if (ocn_c2_atm) call prep_atm_calc_o2x_ax(timer='CPL:atmoca_ocn2atm') + + call t_drvstartf ('CPL:atmocna_fluxa',barrier=mpicom_CPLID) + do exi = 1,num_inst_xao + eai = mod((exi-1),num_inst_atm) + 1 + eoi = mod((exi-1),num_inst_ocn) + 1 + efi = mod((exi-1),num_inst_frc) + 1 + a2x_ax => component_get_c2x_cx(atm(eai)) + o2x_ax => prep_atm_get_o2x_ax() ! array over all instances + xao_ax => prep_aoflux_get_xao_ax() ! array over all instances + call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) + enddo + call t_drvstopf ('CPL:atmocna_fluxa') + + if (atm_c2_ocn) call prep_aoflux_calc_xao_ox(timer='CPL:atmocna_atm2ocn') + endif ! aoflux_grid + + !---------------------------------------------------------- + !| atm/ocn flux on ocn grid (rasm_option1 and aoflux='ocn') + !---------------------------------------------------------- + + if (trim(aoflux_grid) == 'ocn') then + call t_drvstartf ('CPL:atmocnp_fluxo',barrier=mpicom_CPLID,hashint=hashint(6)) + do exi = 1,num_inst_xao + eai = mod((exi-1),num_inst_atm) + 1 + eoi = mod((exi-1),num_inst_ocn) + 1 + efi = mod((exi-1),num_inst_frc) + 1 + a2x_ox => prep_ocn_get_a2x_ox() + o2x_ox => component_get_c2x_cx(ocn(eoi)) + xao_ox => prep_aoflux_get_xao_ox() + call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) + enddo + call t_drvstopf ('CPL:atmocnp_fluxo',hashint=hashint(6)) + endif + + !---------------------------------------------------------- + !| ocn prep-merge (rasm_option1) + !---------------------------------------------------------- + + xao_ox => prep_aoflux_get_xao_ox() + call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') + + ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) + call prep_ocn_accum(timer='CPL:atmocnp_accum') + + !---------------------------------------------------------- + !| ocn albedos (rasm_option1) + ! (MUST BE AFTER prep_ocn_mrg for swnet to ocn to be computed properly + !---------------------------------------------------------- + + call t_drvstartf ('CPL:atmocnp_ocnalb', barrier=mpicom_CPLID,hashint=hashint(5)) + do exi = 1,num_inst_xao + efi = mod((exi-1),num_inst_frc) + 1 + eai = mod((exi-1),num_inst_atm) + 1 + xao_ox => prep_aoflux_get_xao_ox() ! array over all instances + a2x_ox => prep_ocn_get_a2x_ox() + call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi), dtime) !+tht dtime + enddo + call t_drvstopf ('CPL:atmocnp_ocnalb',hashint=hashint(5)) + + !---------------------------------------------------------- + !| ocn budget (rasm_option1) + !---------------------------------------------------------- + + if (do_budgets) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') + call t_drvstartf ('CPL:BUDGET0',budget=.true.,barrier=mpicom_CPLID) + xao_ox => prep_aoflux_get_xao_ox() ! array over all instances + call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & + do_o2x=.true., do_x2o=.true., do_xao=.true.) + call t_drvstopf ('CPL:BUDGET0',budget=.true.) + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ATMOCN1',cplrun=.true.,hashint=hashint(4)) endif !---------------------------------------------------------- - !| OCN SETUP-SEND (cesm1_mod, cesm1_mod_tight, or rasm_option1) + !| ATM/OCN SETUP-SEND (cesm1_orig, cesm1_orig_tight, cesm1_mod, cesm1_mod_tight, or rasm_option1) !---------------------------------------------------------- - if (ocn_present .and. ocnrun_alarm) then - if (trim(cpl_seq_option) == 'CESM1_MOD' .or. & - trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. & - trim(cpl_seq_option) == 'NUOPC_TIGHT' .or. & - trim(cpl_seq_option) == 'RASM_OPTION1') then - call cime_run_ocn_setup_send() - end if - endif + + if ((trim(cpl_seq_option) == 'CESM1_ORIG' .or. & + trim(cpl_seq_option) == 'CESM1_ORIG_TIGHT' .or. & + trim(cpl_seq_option) == 'CESM1_MOD' .or. & + trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. & + trim(cpl_seq_option) == 'RASM_OPTION1' ) .and. & + ocn_present .and. ocnrun_alarm) then + + !---------------------------------------------------- + ! "startup" wait (cesm1_orig, cesm1_mod, or rasm_option1) + !---------------------------------------------------- + + if (iamin_CPLALLOCNID) then + ! want to know the time the ocean pes waited for the cpl pes + ! at the first ocnrun_alarm, min ocean wait is wait time + ! do not use t_barrierf here since it can be "off", use mpi_barrier + do eoi = 1,num_inst_ocn + if (ocn(eoi)%iamin_compid) call t_drvstartf ('CPL:C2O_INITWAIT') + enddo + call mpi_barrier(mpicom_CPLALLOCNID,ierr) + do eoi = 1,num_inst_ocn + if (ocn(eoi)%iamin_compid) call t_drvstopf ('CPL:C2O_INITWAIT') + enddo + cpl2ocn_first = .false. + endif + + !---------------------------------------------------- + !| ocn average (cesm1_orig, cesm1_orig_tight, cesm1_mod, cesm1_mod_tight, or rasm_option1) + !---------------------------------------------------- + + if (iamin_CPLID .and. ocn_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPREP_BARRIER') + call t_drvstartf ('CPL:OCNPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + ! finish accumulating ocean inputs + ! reset the value of x2o_ox with the value in x2oacc_ox + ! (module variable in prep_ocn_mod) + call prep_ocn_accum_avg(timer_accum='CPL:ocnprep_avg') + + call component_diag(infodata, ocn, flow='x2c', comment= 'send ocn', & + info_debug=info_debug, timer_diag='CPL:ocnprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:OCNPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> ocn (cesm1_orig, cesm1_orig_tight, cesm1_mod, cesm1_mod_tight, or rasm_option1) + !---------------------------------------------------- + + if (iamin_CPLALLOCNID .and. ocn_prognostic) then + call component_exch(ocn, flow='x2c', & + infodata=infodata, infodata_string='cpl2ocn_run', & + mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & + timer_barrier='CPL:C2O_BARRIER', timer_comp_exch='CPL:C2O', & + timer_map_exch='CPL:c2o_ocnx2ocno', timer_infodata_exch='CPL:c2o_infoexch') + endif + + endif ! end of OCN SETUP !---------------------------------------------------------- !| LND SETUP-SEND !---------------------------------------------------------- + if (lnd_present .and. lndrun_alarm) then - call cime_run_lnd_setup_send() + + !---------------------------------------------------- + !| lnd prep-merge + !---------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:LNDPREP_BARRIER') + call t_drvstartf ('CPL:LNDPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (atm_c2_lnd) then + call prep_lnd_calc_a2x_lx(timer='CPL:lndprep_atm2lnd') + endif + + if (lnd_prognostic) then + call prep_lnd_mrg(infodata, timer_mrg='CPL:lndprep_mrgx2l') + + call component_diag(infodata, lnd, flow='x2c', comment= 'send lnd', & + info_debug=info_debug, timer_diag='CPL:lndprep_diagav') + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:LNDPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> lnd + !---------------------------------------------------- + + if (iamin_CPLALLLNDID) then + call component_exch(lnd, flow='x2c', & + infodata=infodata, infodata_string='cpl2lnd_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:C2L_BARRIER', timer_comp_exch='CPL:C2L', & + timer_map_exch='CPL:c2l_lndx2lndl', timer_infodata_exch='CPL:c2l_infoexch') + endif + endif !---------------------------------------------------------- !| ICE SETUP-SEND + ! Note that for atm->ice mapping below will leverage the assumption that the + ! ice and ocn are on the same grid and that mapping of atm to ocean is + ! done already for use by atmocn flux and ice model prep !---------------------------------------------------------- + if (ice_present .and. icerun_alarm) then - call cime_run_ice_setup_send() + + !---------------------------------------------------- + !| ice prep-merge + !---------------------------------------------------- + + if (iamin_CPLID .and. ice_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ICEPREP_BARRIER') + + call t_drvstartf ('CPL:ICEPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + + if (ocn_c2_ice) then + call prep_ice_calc_o2x_ix(timer='CPL:iceprep_ocn2ice') + endif + + if (atm_c2_ice) then + ! This is special to avoid remapping atm to ocn + ! Note it is constrained that different prep modules cannot + ! use or call each other + a2x_ox => prep_ocn_get_a2x_ox() ! array + call prep_ice_calc_a2x_ix(a2x_ox, timer='CPL:iceprep_atm2ice') + endif + + call prep_ice_mrg(infodata, timer_mrg='CPL:iceprep_mrgx2i') + + call component_diag(infodata, ice, flow='x2c', comment= 'send ice', & + info_debug=info_debug, timer_diag='CPL:iceprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ICEPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> ice + !---------------------------------------------------- + + if (iamin_CPLALLICEID .and. ice_prognostic) then + call component_exch(ice, flow='x2c', & + infodata=infodata, infodata_string='cpl2ice_run', & + mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & + timer_barrier='CPL:C2I_BARRIER', timer_comp_exch='CPL:C2I', & + timer_map_exch='CPL:c2i_icex2icei', timer_infodata_exch='CPL:ice_infoexch') + endif + endif !---------------------------------------------------------- !| WAV SETUP-SEND !---------------------------------------------------------- if (wav_present .and. wavrun_alarm) then - call cime_run_wav_setup_send() + + !---------------------------------------------------------- + !| wav prep-merge + !---------------------------------------------------------- + + if (iamin_CPLID .and. wav_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:WAVPREP_BARRIER') + + call t_drvstartf ('CPL:WAVPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (atm_c2_wav) then + call prep_wav_calc_a2x_wx(timer='CPL:wavprep_atm2wav') + endif + + if (ocn_c2_wav) then + call prep_wav_calc_o2x_wx(timer='CPL:wavprep_ocn2wav') + endif + + if (ice_c2_wav) then + call prep_wav_calc_i2x_wx(timer='CPL:wavprep_ice2wav') + endif + + call prep_wav_mrg(infodata, fractions_wx, timer_mrg='CPL:wavprep_mrgx2w') + + call component_diag(infodata, wav, flow='x2c', comment= 'send wav', & + info_debug=info_debug, timer_diag='CPL:wavprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:WAVPREP',cplrun=.true.) + endif + + !---------------------------------------------------------- + !| cpl -> wav + !---------------------------------------------------------- + + if (iamin_CPLALLWAVID .and. wav_prognostic) then + call component_exch(wav, flow='x2c', & + infodata=infodata, infodata_string='cpl2wav_run', & + mpicom_barrier=mpicom_CPLALLWAVID, run_barriers=run_barriers, & + timer_barrier='CPL:C2W_BARRIER', timer_comp_exch='CPL:C2W', & + timer_map_exch='CPL:c2w_wavx2wavw', timer_infodata_exch='CPL:c2w_infoexch') + endif + endif !---------------------------------------------------------- !| ROF SETUP-SEND !---------------------------------------------------------- + if (rof_present .and. rofrun_alarm) then - call cime_run_rof_setup_send() - endif - !---------------------------------------------------------- - !| RUN IAC MODEL - !---------------------------------------------------------- - if (iac_present .and. iacrun_alarm) then - call component_run(Eclock_z, iac, iac_run, infodata, & - seq_flds_x2c_fluxes=seq_flds_x2z_fluxes, & - seq_flds_c2x_fluxes=seq_flds_z2x_fluxes, & - comp_prognostic=iac_prognostic, comp_num=comp_num_iac, & - timer_barrier= 'CPL:IAC_RUN_BARRIER', timer_comp_run='CPL:IAC_RUN', & - run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=iac_layout) + !---------------------------------------------------- + !| rof prep-merge + !---------------------------------------------------- + + if (iamin_CPLID .and. rof_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPREP_BARRIER') + + call t_drvstartf ('CPL:ROFPREP', cplrun=.true., barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call prep_rof_accum_avg(timer='CPL:rofprep_l2xavg') + + if (lnd_c2_rof) then + call prep_rof_calc_l2r_rx(fractions_lx, timer='CPL:rofprep_lnd2rof') + endif + + call prep_rof_mrg(infodata, fractions_rx, timer_mrg='CPL:rofprep_mrgx2r') + + call component_diag(infodata, rof, flow='x2c', comment= 'send rof', & + info_debug=info_debug, timer_diag='CPL:rofprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ROFPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> rof + !---------------------------------------------------- + + if (iamin_CPLALLROFID .and. rof_prognostic) then + call component_exch(rof, flow='x2c', & + infodata=infodata, infodata_string='cpl2rof_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:C2R_BARRIER', timer_comp_exch='CPL:C2R', & + timer_map_exch='CPL:c2r_rofx2rofr', timer_infodata_exch='CPL:c2r_infoexch') + endif + endif !---------------------------------------------------------- !| RUN ICE MODEL !---------------------------------------------------------- + if (ice_present .and. icerun_alarm) then call component_run(Eclock_i, ice, ice_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2i_fluxes, & @@ -2651,6 +2759,7 @@ subroutine cime_run() !---------------------------------------------------------- !| RUN LND MODEL !---------------------------------------------------------- + if (lnd_present .and. lndrun_alarm) then call component_run(Eclock_l, lnd, lnd_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2l_fluxes, & @@ -2663,6 +2772,7 @@ subroutine cime_run() !---------------------------------------------------------- !| RUN ROF MODEL !---------------------------------------------------------- + if (rof_present .and. rofrun_alarm) then call component_run(Eclock_r, rof, rof_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2r_fluxes, & @@ -2675,6 +2785,7 @@ subroutine cime_run() !---------------------------------------------------------- !| RUN WAV MODEL !---------------------------------------------------------- + if (wav_present .and. wavrun_alarm) then call component_run(Eclock_w, wav, wav_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2w_fluxes, & @@ -2685,82 +2796,343 @@ subroutine cime_run() endif !---------------------------------------------------------- - !| RUN OCN MODEL (cesm1_mod_tight, nuopc_tight) + !| RUN OCN MODEL (cesm1_orig_tight or cesm1_mod_tight) !---------------------------------------------------------- - if (ocn_present .and. ocnrun_alarm) then - if (trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. trim(cpl_seq_option) == 'NUOPC_TIGHT') then - call component_run(Eclock_o, ocn, ocn_run, infodata, & - seq_flds_x2c_fluxes=seq_flds_x2o_fluxes, & - seq_flds_c2x_fluxes=seq_flds_o2x_fluxes, & - comp_prognostic=ocn_prognostic, comp_num=comp_num_ocn, & - timer_barrier= 'CPL:OCNT_RUN_BARRIER', timer_comp_run='CPL:OCNT_RUN', & - run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=ocn_layout) - endif - end if - !---------------------------------------------------------- - !| IAC RECV-POST - !---------------------------------------------------------- - if (iac_present .and. iacrun_alarm) then - call cime_run_iac_recv_post() + if ((trim(cpl_seq_option) == 'CESM1_ORIG_TIGHT' .or. & + trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' ) .and. & + ocn_present .and. ocnrun_alarm) then + call component_run(Eclock_o, ocn, ocn_run, infodata, & + seq_flds_x2c_fluxes=seq_flds_x2o_fluxes, & + seq_flds_c2x_fluxes=seq_flds_o2x_fluxes, & + comp_prognostic=ocn_prognostic, comp_num=comp_num_ocn, & + timer_barrier= 'CPL:OCNT_RUN_BARRIER', timer_comp_run='CPL:OCNT_RUN', & + run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=ocn_layout) endif !---------------------------------------------------------- - !| OCN RECV-POST (cesm1_mod_tight, nuopc_tight) + !| OCN RECV-POST (cesm1_orig_tight or cesm1_mod_tight) !---------------------------------------------------------- - if (ocn_present .and. ocnnext_alarm) then - if (trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. trim(cpl_seq_option) == 'NUOPC_TIGHT') then - call cime_run_ocn_recv_post() + + if ((trim(cpl_seq_option) == 'CESM1_ORIG_TIGHT' .or. & + trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' ) .and. & + ocn_present .and. ocnnext_alarm) then + + !---------------------------------------------------------- + !| ocn -> cpl (cesm1_orig_tight or cesm1_mod_tight) + !---------------------------------------------------------- + + if (iamin_CPLALLOCNID) then + call component_exch(ocn, flow='c2x', & + infodata=infodata, infodata_string='ocn2cpl_run', & + mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & + timer_barrier='CPL:O2CT_BARRIER', timer_comp_exch='CPL:O2CT', & + timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') endif - end if - !---------------------------------------------------------- - !| ATM/OCN SETUP (cesm1_mod or cesm1_mod_tight) - !---------------------------------------------------------- - ! The following maps to the ocean, computes atm/ocn fluxes, merges to the ocean, - ! accumulates ocn input and computes ocean albedos - if (ocn_present) then - if (trim(cpl_seq_option) == 'CESM1_MOD' .or. & - trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. & - trim(cpl_seq_option) == 'NUOPC' .or. & - trim(cpl_seq_option) == 'NUOPC_TIGHT' ) then - call cime_run_atmocn_setup(hashint) - end if - endif + !---------------------------------------------------------- + !| ocn post (cesm1_orig_tight or cesm1_mod_tight) + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPOSTT_BARRIER') + call t_drvstartf ('CPL:OCNPOSTT',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, ocn, flow='c2x', comment= 'recv ocn', & + info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:OCNPOSTT',cplrun=.true.) + endif - !---------------------------------------------------------- - !| LND RECV-POST - !---------------------------------------------------------- - if (lnd_present .and. lndrun_alarm) then - call cime_run_lnd_recv_post() endif !---------------------------------------------------------- - !| GLC SETUP-SEND + !| ATM/OCN SETUP (cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) !---------------------------------------------------------- - if (glc_present .and. glcrun_alarm) then - call cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_called) - endif + if ((trim(cpl_seq_option) == 'CESM1_ORIG' .or. & + trim(cpl_seq_option) == 'CESM1_ORIG_TIGHT' .or. & + trim(cpl_seq_option) == 'CESM1_MOD' .or. & + trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' ) .and. & + iamin_CPLID .and. ocn_present) then + + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCNP_BARRIER') + call t_drvstartf ('CPL:ATMOCNP',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(7)) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - ! ------------------------------------------------------------------------ - ! Also average lnd2glc fields if needed for requested l2x1yrg auxiliary history - ! files, even if running with a stub glc model. - ! ------------------------------------------------------------------------ - - if (do_hist_l2x1yrg .and. iamin_CPLID .and. glcrun_avg_alarm .and. & - .not. prep_glc_accum_avg_called) then - ! Checking .not. prep_glc_accum_avg_called ensures that we don't do this - ! averaging a second time if we already did it above (because we're running with - ! a prognostic glc model). - call cime_run_glc_accum_avg(lnd2glc_averaged_now, prep_glc_accum_avg_called) - end if + !---------------------------------------------------------- + !| ocn prep-merge (cesm1_orig or cesm1_orig_tight) + !---------------------------------------------------------- + + if (ocn_prognostic) then + ! Map ice to ocn + if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') + + ! Map wav to ocn + if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') + + if (cpl_seq_option == 'CESM1_ORIG' .or. & + cpl_seq_option == 'CESM1_ORIG_TIGHT') then + xao_ox => prep_aoflux_get_xao_ox() + call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') + + ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) + call prep_ocn_accum(timer='CPL:atmocnp_accum') + endif + endif + + !---------------------------------------------------------- + !| atm/ocn flux on atm grid ((cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) and aoflux='atm') + !---------------------------------------------------------- + + if (trim(aoflux_grid) == 'atm') then + ! compute o2x_ax for flux_atmocn, will be updated before atm merge + ! do not use fractions because fractions here are NOT consistent with fractions in atm_mrg + if (ocn_c2_atm) call prep_atm_calc_o2x_ax(timer='CPL:atmoca_ocn2atm') + + call t_drvstartf ('CPL:atmocna_fluxa',barrier=mpicom_CPLID) + do exi = 1,num_inst_xao + eai = mod((exi-1),num_inst_atm) + 1 + eoi = mod((exi-1),num_inst_ocn) + 1 + efi = mod((exi-1),num_inst_frc) + 1 + a2x_ax => component_get_c2x_cx(atm(eai)) + o2x_ax => prep_atm_get_o2x_ax() ! array over all instances + xao_ax => prep_aoflux_get_xao_ax() ! array over all instances + call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) + enddo + call t_drvstopf ('CPL:atmocna_fluxa') + + if (atm_c2_ocn) call prep_aoflux_calc_xao_ox(timer='CPL:atmocna_atm2ocn') + endif ! aoflux_grid + + !---------------------------------------------------------- + !| atm/ocn flux on ocn grid ((cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) and aoflux='ocn') + !---------------------------------------------------------- + + if (trim(aoflux_grid) == 'ocn') then + call t_drvstartf ('CPL:atmocnp_fluxo',barrier=mpicom_CPLID) + do exi = 1,num_inst_xao + eai = mod((exi-1),num_inst_atm) + 1 + eoi = mod((exi-1),num_inst_ocn) + 1 + efi = mod((exi-1),num_inst_frc) + 1 + a2x_ox => prep_ocn_get_a2x_ox() + o2x_ox => component_get_c2x_cx(ocn(eoi)) + xao_ox => prep_aoflux_get_xao_ox() + call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) + enddo + call t_drvstopf ('CPL:atmocnp_fluxo') + ! else if (trim(aoflux_grid) == 'atm') then + ! !--- compute later --- + ! + ! else if (trim(aoflux_grid) == 'exch') then + ! xao_ax => prep_aoflux_get_xao_ax() + ! xao_ox => prep_aoflux_get_xao_ox() + ! + ! call t_drvstartf ('CPL:atmocnp_fluxe',barrier=mpicom_CPLID) + ! call seq_flux_atmocnexch_mct( infodata, atm(eai), ocn(eoi), & + ! fractions_ax(efi), fractions_ox(efi), xao_ax(exi), xao_ox(exi) ) + ! call t_drvstopf ('CPL:atmocnp_fluxe') + endif ! aoflux_grid + + !---------------------------------------------------------- + !| ocn prep-merge (cesm1_mod or cesm1_mod_tight) + !---------------------------------------------------------- + + if (ocn_prognostic) then + if (cpl_seq_option == 'CESM1_MOD' .or. & + cpl_seq_option == 'CESM1_MOD_TIGHT') then + + xao_ox => prep_aoflux_get_xao_ox() + call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') + + ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) + call prep_ocn_accum(timer='CPL:atmocnp_accum') + endif + endif + + !---------------------------------------------------------- + !| ocn albedos (cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) + ! (MUST BE AFTER prep_ocn_mrg for swnet to ocn to be computed properly + !---------------------------------------------------------- + + call t_drvstartf ('CPL:atmocnp_ocnalb', barrier=mpicom_CPLID) + do exi = 1,num_inst_xao + efi = mod((exi-1),num_inst_frc) + 1 + eai = mod((exi-1),num_inst_atm) + 1 + xao_ox => prep_aoflux_get_xao_ox() ! array over all instances + a2x_ox => prep_ocn_get_a2x_ox() + call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi), dtime) !+tht dtime + enddo + call t_drvstopf ('CPL:atmocnp_ocnalb') + + !---------------------------------------------------------- + !| ocn budget (cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) + !---------------------------------------------------------- + + if (do_budgets) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') + call t_drvstartf ('CPL:BUDGET0',budget=.true.,barrier=mpicom_CPLID) + xao_ox => prep_aoflux_get_xao_ox() ! array over all instances + call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & + do_o2x=.true., do_x2o=.true., do_xao=.true.) + call t_drvstopf ('CPL:BUDGET0',budget=.true.) + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ATMOCNP',cplrun=.true.,hashint=hashint(7)) + endif + + !---------------------------------------------------------- + !| LND RECV-POST + !---------------------------------------------------------- + + if (lnd_present .and. lndrun_alarm) then + + !---------------------------------------------------------- + !| lnd -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLLNDID) then + call component_exch(lnd, flow='c2x', infodata=infodata, infodata_string='lnd2cpl_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:L2C_BARRIER', timer_comp_exch='CPL:L2C', & + timer_map_exch='CPL:l2c_lndl2lndx', timer_infodata_exch='lnd2cpl_run') + endif + + !---------------------------------------------------------- + !| lnd post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:LNDPOST_BARRIER') + call t_drvstartf ('CPL:LNDPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, lnd, flow='c2x', comment='recv lnd', & + info_debug=info_debug, timer_diag='CPL:lndpost_diagav') + + ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) + if (lnd_c2_rof) then + call prep_rof_accum(timer='CPL:lndpost_accl2r') + endif + if (lnd_c2_glc) then + call prep_glc_accum(timer='CPL:lndpost_accl2g' ) + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:LNDPOST',cplrun=.true.) + endif + endif + + !---------------------------------------------------------- + !| GLC SETUP-SEND + !---------------------------------------------------------- + + if (glc_present .and. glcrun_alarm) then + + !---------------------------------------------------- + !| glc prep-merge + !---------------------------------------------------- + + if (iamin_CPLID .and. glc_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:GLCPREP_BARRIER') + call t_drvstartf ('CPL:GLCPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (lnd_c2_glc) then + ! NOTE - only create appropriate input to glc if the avg_alarm is on + if (glcrun_avg_alarm) then + call prep_glc_accum_avg(timer='CPL:glcprep_avg') + lnd2glc_averaged_now = .true. + + ! Note that l2x_gx is obtained from mapping the module variable l2gacc_lx + call prep_glc_calc_l2x_gx(fractions_lx, timer='CPL:glcprep_lnd2glc') + + call prep_glc_mrg(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgx2g') + + call component_diag(infodata, glc, flow='x2c', comment='send glc', & + info_debug=info_debug, timer_diag='CPL:glcprep_diagav') + + else + call prep_glc_zero_fields() + end if ! glcrun_avg_alarm + end if ! lnd_c2_glc + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:GLCPREP',cplrun=.true.) + + end if ! iamin_CPLID .and. glc_prognostic + + ! Set the infodata field on all tasks (not just those with iamin_CPLID). + if (glc_prognostic) then + if (glcrun_avg_alarm) then + call seq_infodata_PutData(infodata, glc_valid_input=.true.) + else + call seq_infodata_PutData(infodata, glc_valid_input=.false.) + end if + end if + + !---------------------------------------------------- + !| cpl -> glc + !---------------------------------------------------- + + if (iamin_CPLALLGLCID .and. glc_prognostic) then + call component_exch(glc, flow='x2c', & + infodata=infodata, infodata_string='cpl2glc_run', & + mpicom_barrier=mpicom_CPLALLGLCID, run_barriers=run_barriers, & + timer_barrier='CPL:C2G_BARRIER', timer_comp_exch='CPL:C2G', & + timer_map_exch='CPL:c2g_glcx2glcg', timer_infodata_exch='CPL:c2g_infoexch') + endif + + endif + + !---------------------------------------------------------- + !| ROF RECV-POST + !---------------------------------------------------------- - !---------------------------------------------------------- - !| ROF RECV-POST - !---------------------------------------------------------- if (rof_present .and. rofrun_alarm) then - call cime_run_rof_recv_post() + + !---------------------------------------------------------- + !| rof -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLROFID) then + call component_exch(rof, flow='c2x', & + infodata=infodata, infodata_string='rof2cpl_run', & + mpicom_barrier=mpicom_CPLALLROFID, run_barriers=run_barriers, & + timer_barrier='CPL:R2C_BARRIER', timer_comp_exch='CPL:R2C', & + timer_map_exch='CPL:r2c_rofr2rofx', timer_infodata_exch='CPL:r2c_infoexch') + endif + + !---------------------------------------------------------- + !| rof post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPOST_BARRIER') + call t_drvstartf ('CPL:ROFPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, rof, flow='c2x', comment= 'recv rof', & + info_debug=info_debug, timer_diag='CPL:rofpost_diagav') + + if (rof_c2_lnd) then + call prep_lnd_calc_r2x_lx(timer='CPL:rofpost_rof2lnd') + endif + + if (rof_c2_ice) then + call prep_ice_calc_r2x_ix(timer='CPL:rofpost_rof2ice') + endif + + if (rof_c2_ocn) then + call prep_ocn_calc_r2x_ox(timer='CPL:rofpost_rof2ocn') + endif + + call t_drvstopf ('CPL:ROFPOST', cplrun=.true.) + endif endif + if (rof_present) then if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='DRIVER_ROFPOST_BARRIER') @@ -2768,8 +3140,6 @@ subroutine cime_run() if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (do_hist_r2x) then call t_drvstartf ('driver_rofpost_histaux', barrier=mpicom_CPLID) - ! Write coupler's hr2x file at 24 hour marks, - ! and at the end of the run interval, even if that's not at a 24 hour mark. write_hist_alarm = t24hr_alarm .or. stop_alarm do eri = 1,num_inst_rof inst_suffix = component_get_suffix(rof(eri)) @@ -2782,72 +3152,336 @@ subroutine cime_run() call t_drvstopf ('DRIVER_ROFPOST', cplrun=.true.) endif endif + !---------------------------------------------------------- !| Budget with old fractions !---------------------------------------------------------- - if (do_budgets) then - call cime_run_calc_budgets1() + + ! WJS (2-17-11): I am just using the first instance for the budgets because we + ! don't expect budgets to be conserved for our case (I case). Also note that we + ! don't expect budgets to be conserved for the interactive ensemble use case either. + ! tcraig (aug 2012): put this after rof->cpl so the budget sees the new r2x_rx. + ! it will also use the current r2x_ox here which is the value from the last timestep + ! consistent with the ocean coupling + + if (iamin_CPLID .and. do_budgets) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET1_BARRIER') + call t_drvstartf ('CPL:BUDGET1',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + if (lnd_present) then + call seq_diag_lnd_mct(lnd(ens1), fractions_lx(ens1), infodata, & + do_l2x=.true., do_x2l=.true.) + endif + if (rof_present) then + call seq_diag_rof_mct(rof(ens1), fractions_rx(ens1), infodata) + endif + if (ice_present) then + call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, & + do_x2i=.true.) + endif + call t_drvstopf ('CPL:BUDGET1',cplrun=.true.,budget=.true.) endif + !---------------------------------------------------------- !| ICE RECV-POST !---------------------------------------------------------- + if (ice_present .and. icerun_alarm) then - call cime_run_ice_recv_post() + + !---------------------------------------------------------- + !| ice -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLICEID) then + call component_exch(ice, flow='c2x', & + infodata=infodata, infodata_string='ice2cpl_run', & + mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & + timer_barrier='CPL:I2C_BARRIER', timer_comp_exch='CPL:I2C', & + timer_map_exch='CPL:i2c_icei2icex', timer_infodata_exch='CPL:i2c_infoexch') + endif + + !---------------------------------------------------------- + !| ice post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ICEPOST_BARRIER') + call t_drvstartf ('CPL:ICEPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, ice, flow='c2x', comment= 'recv ice', & + info_debug=info_debug, timer_diag='CPL:icepost_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ICEPOST',cplrun=.true.) + endif endif !---------------------------------------------------------- !| Update fractions based on new ice fractions !---------------------------------------------------------- - call cime_run_update_fractions() + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:FRACSET_BARRIER') + call t_drvstartf ('CPL:FRACSET',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + call t_drvstartf ('CPL:fracset_fracset',barrier=mpicom_CPLID) + + do efi = 1,num_inst_frc + eii = mod((efi-1),num_inst_ice) + 1 + + call seq_frac_set(infodata, ice(eii), & + fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) + enddo + call t_drvstopf ('CPL:fracset_fracset') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:FRACSET',cplrun=.true.) + endif !---------------------------------------------------------- !| ATM/OCN SETUP (rasm_option2) !---------------------------------------------------------- - ! The following maps to the ocean, computes atm/ocn fluxes, merges to the ocean, - ! accumulates ocn input and computes ocean albedos - if (ocn_present) then - if (trim(cpl_seq_option) == 'RASM_OPTION2') then - call cime_run_atmocn_setup(hashint) - end if + + if ((trim(cpl_seq_option) == 'RASM_OPTION2') .and. & + iamin_CPLID .and. ocn_present) then + + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCN2_BARRIER') + call t_drvstartf ('CPL:ATMOCN2',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (ocn_prognostic) then + ! Map ice to ocn + if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') + + ! Map wav to ocn + if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') + endif + + !---------------------------------------------------------- + !| atm/ocn flux on atm grid (rasm_option2 and aoflux_grid='atm') + !---------------------------------------------------------- + + if (trim(aoflux_grid) == 'atm') then + ! compute o2x_ax for flux_atmocn, will be updated before atm merge + ! can use fractions because fractions here are consistent with fractions in atm_mrg + if (ocn_c2_atm) call prep_atm_calc_o2x_ax(fractions_ox,timer='CPL:atmoca_ocn2atm') + + call t_drvstartf ('CPL:atmocna_fluxa',barrier=mpicom_CPLID) + do exi = 1,num_inst_xao + eai = mod((exi-1),num_inst_atm) + 1 + eoi = mod((exi-1),num_inst_ocn) + 1 + efi = mod((exi-1),num_inst_frc) + 1 + a2x_ax => component_get_c2x_cx(atm(eai)) + o2x_ax => prep_atm_get_o2x_ax() ! array over all instances + xao_ax => prep_aoflux_get_xao_ax() ! array over all instances + call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) + enddo + call t_drvstopf ('CPL:atmocna_fluxa') + + if (atm_c2_ocn) call prep_aoflux_calc_xao_ox(timer='CPL:atmocna_atm2ocn') + endif ! aoflux_grid + + !---------------------------------------------------------- + !| atm/ocn flux on ocn grid (rasm_option2 and aoflux_grid='ocn') + !---------------------------------------------------------- + + if (trim(aoflux_grid) == 'ocn') then + call t_drvstartf ('CPL:atmocnp_fluxo',barrier=mpicom_CPLID) + do exi = 1,num_inst_xao + eai = mod((exi-1),num_inst_atm) + 1 + eoi = mod((exi-1),num_inst_ocn) + 1 + efi = mod((exi-1),num_inst_frc) + 1 + a2x_ox => prep_ocn_get_a2x_ox() + o2x_ox => component_get_c2x_cx(ocn(eoi)) + xao_ox => prep_aoflux_get_xao_ox() + call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) + enddo + call t_drvstopf ('CPL:atmocnp_fluxo') + endif ! aoflux_grid + + !---------------------------------------------------------- + !| ocn prep-merge (rasm_option2) + !---------------------------------------------------------- + + xao_ox => prep_aoflux_get_xao_ox() + call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') + + ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) + call prep_ocn_accum(timer='CPL:atmocnp_accum') + + !---------------------------------------------------------- + !| ocn albedos (rasm_option2) + ! (MUST BE AFTER prep_ocn_mrg for swnet to ocn to be computed properly + !---------------------------------------------------------- + + call t_drvstartf ('CPL:atmocnp_ocnalb', barrier=mpicom_CPLID) + do exi = 1,num_inst_xao + efi = mod((exi-1),num_inst_frc) + 1 + eai = mod((exi-1),num_inst_atm) + 1 + xao_ox => prep_aoflux_get_xao_ox() ! array over all instances + a2x_ox => prep_ocn_get_a2x_ox() + call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi), dtime) !+tht dtime + enddo + call t_drvstopf ('CPL:atmocnp_ocnalb') + + !---------------------------------------------------------- + !| ocn budget (rasm_option2) + !---------------------------------------------------------- + + if (do_budgets) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') + call t_drvstartf ('CPL:BUDGET0',budget=.true.,barrier=mpicom_CPLID) + xao_ox => prep_aoflux_get_xao_ox() ! array over all instances + call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & + do_o2x=.true., do_x2o=.true., do_xao=.true.) + call t_drvstopf ('CPL:BUDGET0',budget=.true.) + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ATMOCN2',cplrun=.true.) endif !---------------------------------------------------------- !| OCN SETUP-SEND (rasm_option2) !---------------------------------------------------------- - if (ocn_present .and. ocnrun_alarm) then - if (trim(cpl_seq_option) == 'RASM_OPTION2') then - call cime_run_ocn_setup_send() - end if + + if ((trim(cpl_seq_option) == 'RASM_OPTION2' ) .and. & + ocn_present .and. ocnrun_alarm) then + + !---------------------------------------------------- + ! "startup" wait (rasm_option2) + !---------------------------------------------------- + + if (iamin_CPLALLOCNID) then + ! want to know the time the ocean pes waited for the cpl pes + ! at the first ocnrun_alarm, min ocean wait is wait time + ! do not use t_barrierf here since it can be "off", use mpi_barrier + do eoi = 1,num_inst_ocn + if (ocn(eoi)%iamin_compid) call t_drvstartf ('CPL:C2O_INITWAIT') + enddo + call mpi_barrier(mpicom_CPLALLOCNID,ierr) + do eoi = 1,num_inst_ocn + if (ocn(eoi)%iamin_compid) call t_drvstopf ('CPL:C2O_INITWAIT') + enddo + cpl2ocn_first = .false. + endif + + !---------------------------------------------------- + !| ocn average (rasm_option2) + !---------------------------------------------------- + + if (iamin_CPLID .and. ocn_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPRE2_BARRIER') + call t_drvstartf ('CPL:OCNPRE2',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + ! finish accumulating ocean inputs + ! reset the value of x2o_ox with the value in x2oacc_ox + ! (module variable in prep_ocn_mod) + call prep_ocn_accum_avg(timer_accum='CPL:ocnprep_avg') + + call component_diag(infodata, ocn, flow='x2c', comment= 'send ocn', & + info_debug=info_debug, timer_diag='CPL:ocnprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:OCNPRE2',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> ocn (rasm_option2) + !---------------------------------------------------- + + if (iamin_CPLALLOCNID .and. ocn_prognostic) then + call component_exch(ocn, flow='x2c', & + infodata=infodata, infodata_string='cpl2ocn_run', & + mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & + timer_barrier='CPL:C2O2_BARRIER', timer_comp_exch='CPL:C2O2', & + timer_map_exch='CPL:c2o2_ocnx2ocno', timer_infodata_exch='CPL:c2o2_infoexch') + endif + endif !---------------------------------------------------------- !| ATM SETUP-SEND !---------------------------------------------------------- + if (atm_present .and. atmrun_alarm) then - call cime_run_atm_setup_send() + + !---------------------------------------------------------- + !| atm prep-merge + !---------------------------------------------------------- + + if (iamin_CPLID .and. atm_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMPREP_BARRIER') + call t_drvstartf ('CPL:ATMPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (ocn_c2_atm) then + if (trim(aoflux_grid) == 'ocn') then + ! map xao_ox states and fluxes to xao_ax if fluxes were computed on ocn grid + call prep_aoflux_calc_xao_ax(fractions_ox, flds='states_and_fluxes', & + timer='CPL:atmprep_xao2atm') + endif + + ! recompute o2x_ax now for the merge with fractions associated with merge + call prep_atm_calc_o2x_ax(fractions_ox, timer='CPL:atmprep_ocn2atm') + + ! map xao_ox albedos to the atm grid, these are always computed on the ocean grid + call prep_aoflux_calc_xao_ax(fractions_ox, flds='albedos', timer='CPL:atmprep_alb2atm') + endif + + if (ice_c2_atm) then + call prep_atm_calc_i2x_ax(fractions_ix, timer='CPL:atmprep_ice2atm') + endif + + if (lnd_c2_atm) then + call prep_atm_calc_l2x_ax(fractions_lx, timer='CPL:atmprep_lnd2atm') + endif + + if (associated(xao_ax)) then + call prep_atm_mrg(infodata, fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:atmprep_mrgx2a') + endif + + call component_diag(infodata, atm, flow='x2c', comment= 'send atm', info_debug=info_debug, & + timer_diag='CPL:atmprep_diagav') + + call t_drvstopf ('CPL:ATMPREP',cplrun=.true.) + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + endif + + !---------------------------------------------------------- + !| cpl -> atm + !---------------------------------------------------------- + + if (iamin_CPLALLATMID .and. atm_prognostic) then + call component_exch(atm, flow='x2c', infodata=infodata, infodata_string='cpl2atm_run', & + mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & + timer_barrier='CPL:C2A_BARRIER', timer_comp_exch='CPL:C2A', & + timer_map_exch='CPL:c2a_atmx2atmg', timer_infodata_exch='CPL:c2a_infoexch') + endif + endif !---------------------------------------------------------- - !| RUN OCN MODEL (NOT cesm1_mod_tight or nuopc_tight) + !| RUN OCN MODEL (NOT cesm1_orig_tight or cesm1_mod_tight) !---------------------------------------------------------- - if (ocn_present .and. ocnrun_alarm) then - if (trim(cpl_seq_option) == 'CESM1_MOD' .or. & - trim(cpl_seq_option) == 'RASM_OPTION1' .or. & - trim(cpl_seq_option) == 'RASM_OPTION2' .or. & - trim(cpl_seq_option) == 'NUOPC') then - call component_run(Eclock_o, ocn, ocn_run, infodata, & - seq_flds_x2c_fluxes=seq_flds_x2o_fluxes, & - seq_flds_c2x_fluxes=seq_flds_o2x_fluxes, & - comp_prognostic=ocn_prognostic, comp_num=comp_num_ocn, & - timer_barrier= 'CPL:OCN_RUN_BARRIER', timer_comp_run='CPL:OCN_RUN', & - run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=ocn_layout) - endif - end if + + if ((trim(cpl_seq_option) /= 'CESM1_ORIG_TIGHT' .and. & + trim(cpl_seq_option) /= 'CESM1_MOD_TIGHT' ) .and. & + ocn_present .and. ocnrun_alarm) then + call component_run(Eclock_o, ocn, ocn_run, infodata, & + seq_flds_x2c_fluxes=seq_flds_x2o_fluxes, & + seq_flds_c2x_fluxes=seq_flds_o2x_fluxes, & + comp_prognostic=ocn_prognostic, comp_num=comp_num_ocn, & + timer_barrier= 'CPL:OCN_RUN_BARRIER', timer_comp_run='CPL:OCN_RUN', & + run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=ocn_layout) + endif !---------------------------------------------------------- !| RUN ATM MODEL !---------------------------------------------------------- + if (atm_present .and. atmrun_alarm) then call component_run(Eclock_a, atm, atm_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2a_fluxes, & @@ -2860,6 +3494,7 @@ subroutine cime_run() !---------------------------------------------------------- !| RUN GLC MODEL !---------------------------------------------------------- + if (glc_present .and. glcrun_alarm) then call component_run(Eclock_g, glc, glc_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2g_fluxes, & @@ -2872,52 +3507,210 @@ subroutine cime_run() !---------------------------------------------------------- !| WAV RECV-POST !---------------------------------------------------------- + if (wav_present .and. wavrun_alarm) then - call cime_run_wav_recv_post() + + !---------------------------------------------------------- + !| wav -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLWAVID) then + call component_exch(wav, flow='c2x', infodata=infodata, infodata_string='wav2cpl_run', & + mpicom_barrier=mpicom_CPLALLWAVID, run_barriers=run_barriers, & + timer_barrier='CPL:W2C_BARRIER', timer_comp_exch='CPL:W2C', & + timer_map_exch='CPL:w2c_wavw2wavx', timer_infodata_exch='CPL:w2c_infoexch') + endif + + !---------------------------------------------------------- + !| wav post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:WAVPOST_BARRIER') + call t_drvstartf ('CPL:WAVPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, wav, flow='c2x', comment= 'recv wav', & + info_debug=info_debug, timer_diag='CPL:wavpost_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:WAVPOST',cplrun=.true.) + endif endif !---------------------------------------------------------- !| GLC RECV-POST !---------------------------------------------------------- + if (glc_present .and. glcrun_alarm) then - call cime_run_glc_recv_post() + + !---------------------------------------------------------- + !| glc -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLGLCID) then + call component_exch(glc, flow='c2x', infodata=infodata, infodata_string='glc2cpl_run', & + mpicom_barrier=mpicom_CPLALLGLCID, run_barriers=run_barriers, & + timer_barrier='CPL:G2C_BARRIER', timer_comp_exch='CPL:G2C', & + timer_map_exch='CPL:g2c_glcg2glcx', timer_infodata_exch='CPL:g2c_infoexch') + endif + + !---------------------------------------------------------- + !| glc post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:GLCPOST_BARRIER') + call t_drvstartf ('CPL:GLCPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, glc, flow='c2x', comment= 'recv glc', & + info_debug=info_debug, timer_diag='CPL:glcpost_diagav') + + if (glc_c2_lnd) then + call prep_lnd_calc_g2x_lx(timer='CPL:glcpost_glc2lnd') + endif + + if (glc_c2_ice) then + call prep_ice_calc_g2x_ix(timer='CPL:glcpost_glc2ice') + endif + + if (glc_c2_ocn) then + call prep_ocn_calc_g2x_ox(timer='CPL:glcpost_glc2ocn') + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:GLCPOST',cplrun=.true.) + endif endif !---------------------------------------------------------- !| ATM RECV-POST !---------------------------------------------------------- + if (atm_present .and. atmrun_alarm) then - call cime_run_atm_recv_post + + !---------------------------------------------------------- + !| atm -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLATMID) then + call component_exch(atm, flow='c2x', infodata=infodata, infodata_string='atm2cpl_run', & + mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & + timer_barrier='CPL:A2C_BARRIER', timer_comp_exch='CPL:A2C', & + timer_map_exch='CPL:a2c_atma2atmx', timer_infodata_exch='CPL:a2c_infoexch') + endif + + !---------------------------------------------------------- + !| atm post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMPOST_BARRIER') + call t_drvstartf ('CPL:ATMPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, atm, flow='c2x', comment= 'recv atm', & + info_debug=info_debug, timer_diag='CPL:atmpost_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ATMPOST',cplrun=.true.) + endif endif !---------------------------------------------------------- !| Budget with new fractions !---------------------------------------------------------- - if (do_budgets) then - call cime_run_calc_budgets2() - endif - !---------------------------------------------------------- - !| OCN RECV-POST (NOT cesm1_mod_tight or nuopc_tight) - !---------------------------------------------------------- - if (ocn_present .and. ocnnext_alarm) then - if (trim(cpl_seq_option) == 'CESM1_MOD' .or. & - trim(cpl_seq_option) == 'RASM_OPTION1' .or. & - trim(cpl_seq_option) == 'RASM_OPTION2' .or. & - trim(cpl_seq_option) == 'NUOPC') then - call cime_run_ocn_recv_post() - end if - end if + if (iamin_CPLID .and. do_budgets) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET2_BARRIER') + + call t_drvstartf ('CPL:BUDGET2',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + if (atm_present) then + call seq_diag_atm_mct(atm(ens1), fractions_ax(ens1), infodata, & + do_a2x=.true., do_x2a=.true.) + endif + if (ice_present) then + call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, & + do_i2x=.true.) + endif + call t_drvstopf ('CPL:BUDGET2',cplrun=.true.,budget=.true.) + + call t_drvstartf ('CPL:BUDGET3',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + call seq_diag_accum_mct() + call t_drvstopf ('CPL:BUDGET3',cplrun=.true.,budget=.true.) + + call t_drvstartf ('CPL:BUDGETF',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + if (.not. dead_comps) then + call seq_diag_print_mct(EClock_d,stop_alarm,budget_inst, & + budget_daily, budget_month, budget_ann, budget_ltann, budget_ltend) + endif + call seq_diag_zero_mct(EClock=EClock_d) + + call t_drvstopf ('CPL:BUDGETF',cplrun=.true.,budget=.true.) + endif + + !---------------------------------------------------------- + !| OCN RECV-POST (NOT cesm1_orig_tight and cesm1_mod_tight) + !---------------------------------------------------------- + + if ((trim(cpl_seq_option) /= 'CESM1_ORIG_TIGHT' .and. & + trim(cpl_seq_option) /= 'CESM1_MOD_TIGHT' ) .and. & + ocn_present .and. ocnnext_alarm) then + + !---------------------------------------------------------- + !| ocn -> cpl (NOT cesm1_orig_tight and cesm1_mod_tight) + !---------------------------------------------------------- + + if (iamin_CPLALLOCNID) then + call component_exch(ocn, flow='c2x', & + infodata=infodata, infodata_string='ocn2cpl_run', & + mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & + timer_barrier='CPL:O2C_BARRIER', timer_comp_exch='CPL:O2C', & + timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') + endif + + !---------------------------------------------------------- + !| ocn post (NOT cesm1_orig_tight and cesm1_mod_tight) + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPOST_BARRIER') + call t_drvstartf ('CPL:OCNPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, ocn, flow='c2x', comment= 'recv ocn', & + info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:OCNPOST',cplrun=.true.) + endif + endif !---------------------------------------------------------- !| Write driver restart file !---------------------------------------------------------- - call cime_run_write_restart(drv_pause, restart_alarm, drv_resume) + if ( (restart_alarm .or. drv_pause) .and. iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:RESTART_BARRIER') + call t_drvstartf ('CPL:RESTART',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + if (iamroot_CPLID) then + write(logunit,104) ' Write restart file at ',ymd,tod + call shr_sys_flush(logunit) + endif + + call seq_rest_write(EClock_d, seq_SyncClock, infodata, & + atm, lnd, ice, ocn, rof, glc, wav, esp, & + fractions_ax, fractions_lx, fractions_ix, fractions_ox, & + fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:RESTART',cplrun=.true.) + endif !---------------------------------------------------------- !| Write history file, only AVs on CPLID !---------------------------------------------------------- - call cime_run_write_history() if (iamin_CPLID) then @@ -2931,16 +3724,16 @@ subroutine cime_run() endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, iac, & + atm, lnd, ice, ocn, rof, glc, wav, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif if (do_histavg) then call seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & + atm, lnd, ice, ocn, rof, glc, wav, histavg_alarm, & trim(cpl_inst_tag)) endif @@ -3050,6 +3843,8 @@ subroutine cime_run() if (t1yr_alarm .and. .not. lnd2glc_averaged_now) then write(logunit,*) 'ERROR: histaux_l2x1yrg requested;' write(logunit,*) 'it is the year boundary, but lnd2glc fields were not averaged this time step.' + write(logunit,*) 'One possible reason is that you are running with a stub glc model.' + write(logunit,*) '(It only works to request histaux_l2x1yrg if running with a prognostic glc model.)' call shr_sys_abort(subname// & ' do_hist_l2x1yrg and t1yr_alarm are true, but lnd2glc_averaged_now is false') end if @@ -3106,105 +3901,21 @@ subroutine cime_run() ! Make sure that all couplers are here in multicoupler mode before running ESP component if (num_inst_driver > 1) then call mpi_barrier(global_comm, ierr) - end if - ! Gather up each instance's 'resume' files (written before 'pause') - do eai = 1, num_inst_atm - call seq_resume_store_comp(atm(eai)%oneletterid, & - atm(eai)%cdata_cc%resume_filename, num_inst_atm, & - ATMID(eai), component_get_iamroot_compid(atm(eai))) - end do - do eli = 1, num_inst_lnd - call seq_resume_store_comp(lnd(eli)%oneletterid, & - lnd(eli)%cdata_cc%resume_filename, num_inst_lnd, & - LNDID(eli), component_get_iamroot_compid(lnd(eli))) - end do - do eoi = 1, num_inst_ocn - call seq_resume_store_comp(ocn(eoi)%oneletterid, & - ocn(eoi)%cdata_cc%resume_filename, num_inst_ocn, & - OCNID(eoi), component_get_iamroot_compid(ocn(eoi))) - end do - do eii = 1, num_inst_ice - call seq_resume_store_comp(ice(eii)%oneletterid, & - ice(eii)%cdata_cc%resume_filename, num_inst_ice, & - ICEID(eii), component_get_iamroot_compid(ice(eii))) - end do - do eri = 1, num_inst_rof - call seq_resume_store_comp(rof(eri)%oneletterid, & - rof(eri)%cdata_cc%resume_filename, num_inst_rof, & - ROFID(eri), component_get_iamroot_compid(rof(eri))) - end do - do egi = 1, num_inst_glc - call seq_resume_store_comp(glc(egi)%oneletterid, & - glc(egi)%cdata_cc%resume_filename, num_inst_glc, & - GLCID(egi), component_get_iamroot_compid(glc(egi))) - end do - do ewi = 1, num_inst_wav - call seq_resume_store_comp(wav(ewi)%oneletterid, & - wav(ewi)%cdata_cc%resume_filename, num_inst_wav, & - WAVID(ewi), component_get_iamroot_compid(wav(ewi))) - end do - ! Here we pass 1 as num_inst_driver as num_inst_driver is used inside - call seq_resume_store_comp('x', drv_resume, 1, & - driver_id, iamroot_CPLID) - call component_run(Eclock_e, esp, esp_run, infodata, & - comp_prognostic=esp_prognostic, comp_num=comp_num_esp, & + endif + call component_run(Eclock_e, esp, esp_run, infodata, & + comp_prognostic=esp_prognostic, comp_num=comp_num_esp, & timer_barrier= 'CPL:ESP_RUN_BARRIER', timer_comp_run='CPL:ESP_RUN', & run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=esp_layout) - !--------------------------------------------------------------------- !| ESP computes resume options for other components -- update everyone !--------------------------------------------------------------------- - call seq_resume_get_files('a', resume_files) - if (associated(resume_files)) then - do eai = 1, num_inst_atm - atm(eai)%cdata_cc%resume_filename = resume_files(ATMID(eai)) - end do - end if - call seq_resume_get_files('l', resume_files) - if (associated(resume_files)) then - do eli = 1, num_inst_lnd - lnd(eli)%cdata_cc%resume_filename = resume_files(LNDID(eli)) - end do - end if - call seq_resume_get_files('o', resume_files) - if (associated(resume_files)) then - do eoi = 1, num_inst_ocn - ocn(eoi)%cdata_cc%resume_filename = resume_files(OCNID(eoi)) - end do - end if - call seq_resume_get_files('i', resume_files) - if (associated(resume_files)) then - do eii = 1, num_inst_ice - ice(eii)%cdata_cc%resume_filename = resume_files(ICEID(eii)) - end do - end if - call seq_resume_get_files('r', resume_files) - if (associated(resume_files)) then - do eri = 1, num_inst_rof - rof(eri)%cdata_cc%resume_filename = resume_files(ROFID(eri)) - end do - end if - call seq_resume_get_files('g', resume_files) - if (associated(resume_files)) then - do egi = 1, num_inst_glc - glc(egi)%cdata_cc%resume_filename = resume_files(GLCID(egi)) - end do - end if - call seq_resume_get_files('w', resume_files) - if (associated(resume_files)) then - do ewi = 1, num_inst_wav - wav(ewi)%cdata_cc%resume_filename = resume_files(WAVID(ewi)) - end do - end if - call seq_resume_get_files('x', resume_files) - if (associated(resume_files)) then - drv_resume = resume_files(driver_id) - end if - end if + call seq_infodata_exchange(infodata, CPLALLESPID, 'esp2cpl_run') + endif !---------------------------------------------------------- !| RESUME (read restart) if signaled !---------------------------------------------------------- + call seq_infodata_GetData(infodata, cpl_resume=drv_resume) if (len_trim(drv_resume) > 0) then if (iamroot_CPLID) then write(logunit,103) subname,' Reading restart (resume) file ',trim(drv_resume) @@ -3212,12 +3923,13 @@ subroutine cime_run() end if if (iamin_CPLID) then call seq_rest_read(drv_resume, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & + atm, lnd, ice, ocn, rof, glc, wav, esp, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, fractions_zx) + fractions_rx, fractions_gx, fractions_wx) end if ! Clear the resume file so we don't try to read it again drv_resume = ' ' + call seq_infodata_PutData(infodata, cpl_resume=drv_resume) end if !---------------------------------------------------------- @@ -3289,8 +4001,7 @@ subroutine cime_run() lnd(ens1)%iamroot_compid .or. & ice(ens1)%iamroot_compid .or. & glc(ens1)%iamroot_compid .or. & - wav(ens1)%iamroot_compid .or. & - iac(ens1)%iamroot_compid) then + wav(ens1)%iamroot_compid) then call shr_mem_getusage(msize,mrss,.true.) write(logunit,105) ' memory_write: model date = ',ymd,tod, & @@ -3317,14 +4028,30 @@ subroutine cime_run() if ((tod == 0) .and. in_first_day) then in_first_day = .false. endif + call t_adj_detailf(+1) + + call t_startf("CPL:sync1_tprof") + call mpi_barrier(mpicom_GLOID,ierr) + call t_stopf("CPL:sync1_tprof") write(timing_file,'(a,i8.8,a1,i5.5)') & - trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod + trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod - call t_set_prefixf("CPL:RUN_LOOP_") - call cime_write_performance_checkpoint(output_perf,timing_file,mpicom_GLOID) + call t_set_prefixf("CPL:") + if (output_perf) then + call t_prf(filename=trim(timing_file), mpicom=mpicom_GLOID, & + num_outpe=0, output_thispe=output_perf) + else + call t_prf(filename=trim(timing_file), mpicom=mpicom_GLOID, & + num_outpe=0) + endif call t_unset_prefixf() + call t_startf("CPL:sync2_tprof") + call mpi_barrier(mpicom_GLOID,ierr) + call t_stopf("CPL:sync2_tprof") + + call t_adj_detailf(-1) endif call t_stopf ('CPL:TPROF_WRITE') @@ -3344,7 +4071,6 @@ subroutine cime_run() call mpi_barrier(mpicom_GLOID,ierr) call t_stopf ('CPL:RUN_LOOP_BSTOP') - call seq_resume_free() Time_end = mpi_wtime() end subroutine cime_run @@ -3357,6 +4083,7 @@ subroutine cime_final() use shr_pio_mod, only : shr_pio_finalize use shr_wv_sat_mod, only: shr_wv_sat_final + character(len=cs) :: cime_model !------------------------------------------------------------------------ ! Finalization of all models @@ -3379,13 +4106,13 @@ subroutine cime_final() call component_final(EClock_o, ocn, ocn_final) call component_final(EClock_g, glc, glc_final) call component_final(EClock_w, wav, wav_final) - call component_final(EClock_w, iac, iac_final) !------------------------------------------------------------------------ ! End the run cleanly !------------------------------------------------------------------------ call shr_wv_sat_final() + call seq_infodata_GetData(infodata, cime_model=cime_model) call shr_pio_finalize( ) call shr_mpi_min(msize ,msize0,mpicom_GLOID,' driver msize0', all=.true.) @@ -3419,11 +4146,9 @@ subroutine cime_final() call t_adj_detailf(-1) call t_stopf ('CPL:FINAL') - call t_set_prefixf("CPL:FINAL_") - - call t_startf("sync1_tprf") + call t_startf("sync3_tprof") call mpi_barrier(mpicom_GLOID,ierr) - call t_stopf("sync1_tprf") + call t_stopf("sync3_tprof") if (output_perf) then call t_prf(trim(timing_dir)//'/model_timing'//trim(cpl_inst_tag), & @@ -3433,8 +4158,6 @@ subroutine cime_final() mpicom=mpicom_GLOID) endif - call t_unset_prefixf() - call t_finalizef() end subroutine cime_final @@ -3443,7 +4166,7 @@ end subroutine cime_final !******************************************************************************* !=============================================================================== - subroutine cime_printlogheader() + subroutine seq_cime_printlogheader() !----------------------------------------------------------------------- ! @@ -3459,10 +4182,12 @@ subroutine cime_printlogheader() character(len=8) :: ctime ! System time integer :: values(8) character :: date*8, time*10, zone*5 + character(len=cs) :: cime_model !------------------------------------------------------------------------------- call date_and_time (date, time, zone, values) + call seq_infodata_GetData(infodata, cime_model=cime_model) cdate(1:2) = date(5:6) cdate(3:3) = '/' cdate(4:5) = date(7:8) @@ -3487,7 +4212,7 @@ subroutine cime_printlogheader() write(logunit,*)' ' write(logunit,*)' ' - end subroutine cime_printlogheader + end subroutine seq_cime_printlogheader !=============================================================================== @@ -3503,8 +4228,6 @@ subroutine cime_comp_barriers(mpicom, timer) endif end subroutine cime_comp_barriers - !=============================================================================== - subroutine cime_cpl_init(comm_in, comm_out, num_inst_driver, id) !----------------------------------------------------------------------- ! @@ -3531,7 +4254,7 @@ subroutine cime_cpl_init(comm_in, comm_out, num_inst_driver, id) call shr_mpi_commsize(comm_in, numpes, ' cime_cpl_init') num_inst_driver = 1 - id = 1 ! For compatiblity with component instance numbering + id = 0 if (mype == 0) then ! Read coupler namelist if it exists @@ -3568,1110 +4291,6 @@ subroutine cime_cpl_init(comm_in, comm_out, num_inst_driver, id) call shr_mpi_chkerr(ierr,subname//' mpi_comm_split') end if call shr_mpi_commsize(comm_out, drvpes, ' cime_cpl_init') - end subroutine cime_cpl_init - !=============================================================================== - - subroutine cime_run_atmocn_fluxes(hashint) - integer, intent(inout) :: hashint(:) - - !---------------------------------------------------------- - !| atm/ocn flux on atm grid - !---------------------------------------------------------- - if (trim(aoflux_grid) == 'atm') then - ! compute o2x_ax for flux_atmocn, will be updated before atm merge - ! do not use fractions because fractions here are NOT consistent with fractions in atm_mrg - if (ocn_c2_atm) call prep_atm_calc_o2x_ax(timer='CPL:atmoca_ocn2atm') - - call t_drvstartf ('CPL:atmocna_fluxa',barrier=mpicom_CPLID, hashint=hashint(6)) - do exi = 1,num_inst_xao - eai = mod((exi-1),num_inst_atm) + 1 - eoi = mod((exi-1),num_inst_ocn) + 1 - efi = mod((exi-1),num_inst_frc) + 1 - a2x_ax => component_get_c2x_cx(atm(eai)) - o2x_ax => prep_atm_get_o2x_ax() ! array over all instances - xao_ax => prep_aoflux_get_xao_ax() ! array over all instances - call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) - enddo - call t_drvstopf ('CPL:atmocna_fluxa',hashint=hashint(6)) - - if (atm_c2_ocn) call prep_aoflux_calc_xao_ox(timer='CPL:atmocna_atm2ocn') - endif ! aoflux_grid - - !---------------------------------------------------------- - !| atm/ocn flux on ocn grid - !---------------------------------------------------------- - if (trim(aoflux_grid) == 'ocn') then - call t_drvstartf ('CPL:atmocnp_fluxo',barrier=mpicom_CPLID, hashint=hashint(6)) - do exi = 1,num_inst_xao - eai = mod((exi-1),num_inst_atm) + 1 - eoi = mod((exi-1),num_inst_ocn) + 1 - efi = mod((exi-1),num_inst_frc) + 1 - a2x_ox => prep_ocn_get_a2x_ox() - o2x_ox => component_get_c2x_cx(ocn(eoi)) - xao_ox => prep_aoflux_get_xao_ox() - call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) - enddo - call t_drvstopf ('CPL:atmocnp_fluxo',hashint=hashint(6)) - endif ! aoflux_grid - - end subroutine cime_run_atmocn_fluxes - -!---------------------------------------------------------------------------------- - - subroutine cime_run_ocn_albedos(hashint) - integer, intent(inout) :: hashint(:) - - call t_drvstartf ('CPL:atmocnp_ocnalb', barrier=mpicom_CPLID, hashint=hashint(5)) - do exi = 1,num_inst_xao - efi = mod((exi-1),num_inst_frc) + 1 - eai = mod((exi-1),num_inst_atm) + 1 - xao_ox => prep_aoflux_get_xao_ox() ! array over all instances - a2x_ox => prep_ocn_get_a2x_ox() - call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi)) - enddo - call t_drvstopf ('CPL:atmocnp_ocnalb', hashint=hashint(5)) - - end subroutine cime_run_ocn_albedos - -!---------------------------------------------------------------------------------- - - subroutine cime_run_atm_setup_send() - - !---------------------------------------------------------- - !| atm prep-merge - !---------------------------------------------------------- - - if (iamin_CPLID .and. atm_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMPREP_BARRIER') - call t_drvstartf ('CPL:ATMPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (ocn_c2_atm) then - if (trim(aoflux_grid) == 'ocn') then - ! map xao_ox states and fluxes to xao_ax if fluxes were computed on ocn grid - call prep_aoflux_calc_xao_ax(fractions_ox, flds='states_and_fluxes', & - timer='CPL:atmprep_xao2atm') - endif - - ! recompute o2x_ax now for the merge with fractions associated with merge - call prep_atm_calc_o2x_ax(fractions_ox, timer='CPL:atmprep_ocn2atm') - - ! map xao_ox albedos to the atm grid, these are always computed on the ocean grid - call prep_aoflux_calc_xao_ax(fractions_ox, flds='albedos', timer='CPL:atmprep_alb2atm') - endif - if (ice_c2_atm) then - call prep_atm_calc_i2x_ax(fractions_ix, timer='CPL:atmprep_ice2atm') - endif - if (lnd_c2_atm) then - call prep_atm_calc_l2x_ax(fractions_lx, timer='CPL:atmprep_lnd2atm') - endif - if (iac_c2_atm) then - call prep_atm_calc_z2x_ax(fractions_zx, timer='CPL:atmprep_iac2atm') - endif - if (associated(xao_ax)) then - call prep_atm_mrg(infodata, fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:atmprep_mrgx2a') - endif - - call component_diag(infodata, atm, flow='x2c', comment= 'send atm', info_debug=info_debug, & - timer_diag='CPL:atmprep_diagav') - - call t_drvstopf ('CPL:ATMPREP',cplrun=.true.) - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - endif - - !---------------------------------------------------------- - !| cpl -> atm - !---------------------------------------------------------- - - if (iamin_CPLALLATMID .and. atm_prognostic) then - call component_exch(atm, flow='x2c', infodata=infodata, infodata_string='cpl2atm_run', & - mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & - timer_barrier='CPL:C2A_BARRIER', timer_comp_exch='CPL:C2A', & - timer_map_exch='CPL:c2a_atmx2atmg', timer_infodata_exch='CPL:c2a_infoexch') - endif - - end subroutine cime_run_atm_setup_send - -!---------------------------------------------------------------------------------- - - subroutine cime_run_atm_recv_post() - - !---------------------------------------------------------- - !| atm -> cpl - !---------------------------------------------------------- - if (iamin_CPLALLATMID) then - call component_exch(atm, flow='c2x', infodata=infodata, infodata_string='atm2cpl_run', & - mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & - timer_barrier='CPL:A2C_BARRIER', timer_comp_exch='CPL:A2C', & - timer_map_exch='CPL:a2c_atma2atmx', timer_infodata_exch='CPL:a2c_infoexch') - endif - - !---------------------------------------------------------- - !| atm post - !---------------------------------------------------------- - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMPOST_BARRIER') - call t_drvstartf ('CPL:ATMPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, atm, flow='c2x', comment= 'recv atm', & - info_debug=info_debug, timer_diag='CPL:atmpost_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ATMPOST',cplrun=.true.) - endif - - end subroutine cime_run_atm_recv_post - -!---------------------------------------------------------------------------------- - - subroutine cime_run_ocn_setup_send() - - !---------------------------------------------------- - ! "startup" wait - !---------------------------------------------------- - if (iamin_CPLALLOCNID) then - ! want to know the time the ocean pes waited for the cpl pes - ! at the first ocnrun_alarm, min ocean wait is wait time - ! do not use t_barrierf here since it can be "off", use mpi_barrier - do eoi = 1,num_inst_ocn - if (ocn(eoi)%iamin_compid) call t_drvstartf ('CPL:C2O_INITWAIT') - enddo - call mpi_barrier(mpicom_CPLALLOCNID,ierr) - do eoi = 1,num_inst_ocn - if (ocn(eoi)%iamin_compid) call t_drvstopf ('CPL:C2O_INITWAIT') - enddo - cpl2ocn_first = .false. - endif - - !---------------------------------------------------- - ! ocn average - !---------------------------------------------------- - if (iamin_CPLID .and. ocn_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPREP_BARRIER') - call t_drvstartf ('CPL:OCNPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - ! finish accumulating ocean inputs - ! reset the value of x2o_ox with the value in x2oacc_ox (module variable in prep_ocn_mod) - call prep_ocn_accum_avg(timer_accum='CPL:ocnprep_avg') - - call component_diag(infodata, ocn, flow='x2c', comment= 'send ocn', & - info_debug=info_debug, timer_diag='CPL:ocnprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:OCNPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - ! cpl -> ocn - !---------------------------------------------------- - if (iamin_CPLALLOCNID .and. ocn_prognostic) then - call component_exch(ocn, flow='x2c', & - infodata=infodata, infodata_string='cpl2ocn_run', & - mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & - timer_barrier='CPL:C2O_BARRIER', timer_comp_exch='CPL:C2O', & - timer_map_exch='CPL:c2o_ocnx2ocno', timer_infodata_exch='CPL:c2o_infoexch') - endif - - end subroutine cime_run_ocn_setup_send - - !---------------------------------------------------------------------------------- - - subroutine cime_run_ocn_recv_post() - - !---------------------------------------------------------- - ! ocn -> cpl - !---------------------------------------------------------- - if (iamin_CPLALLOCNID) then - call component_exch(ocn, flow='c2x', & - infodata=infodata, infodata_string='ocn2cpl_run', & - mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & - timer_barrier='CPL:O2CT_BARRIER', timer_comp_exch='CPL:O2CT', & - timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') - endif - - !---------------------------------------------------------- - ! ocn post - !---------------------------------------------------------- - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPOSTT_BARRIER') - call t_drvstartf ('CPL:OCNPOSTT',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, ocn, flow='c2x', comment= 'recv ocn', & - info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') - - call cime_run_ocnglc_coupling() - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:OCNPOSTT',cplrun=.true.) - endif - - end subroutine cime_run_ocn_recv_post - - !---------------------------------------------------------------------------------- - subroutine cime_run_iac_setup_send() - - !------------------------------------------------------- - ! | iac prep-merge - !------------------------------------------------------- - - if (iamin_CPLID .and. iac_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:IACPREP_BARRIER') - - call t_drvstartf ('CPL:IACPREP', cplrun=.true., barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - ! Average our accumulators - call prep_iac_accum_avg(timer='CPL:iacprep_l2xavg') - - ! Setup lnd inputs on iac grid. Right now I think they will be the same - ! thing, but I'm trying to code for the general case - if (lnd_c2_iac) then - call prep_iac_calc_l2x_zx(timer='CPL:iacprep_lnd2iac') - endif - - - call prep_iac_mrg(infodata, fractions_zx, timer_mrg='CPL:iacprep_mrgx2z') - - call component_diag(infodata, iac, flow='x2c', comment= 'send iac', & - info_debug=info_debug, timer_diag='CPL:iacprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:IACPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - !| cpl -> iac - !---------------------------------------------------- - - if (iamin_CPLALLIACID .and. iac_prognostic) then - call component_exch(iac, flow='x2c', & - infodata=infodata, infodata_string='cpl2iac_run', & - mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & - timer_barrier='CPL:C2Z_BARRIER', timer_comp_exch='CPL:C2Z', & - timer_map_exch='CPL:c2z_iacx2iacr', timer_infodata_exch='CPL:c2z_infoexch') - endif - - end subroutine cime_run_iac_setup_send - - !---------------------------------------------------------------------------------- - subroutine cime_run_iac_recv_post() - - !---------------------------------------------------------- - !| iac -> cpl - !---------------------------------------------------------- - - if (iamin_CPLALLIACID) then - call component_exch(rof, flow='c2x', & - infodata=infodata, infodata_string='iac2cpl_run', & - mpicom_barrier=mpicom_CPLALLIACID, run_barriers=run_barriers, & - timer_barrier='CPL:Z2C_BARRIER', timer_comp_exch='CPL:Z2C', & - timer_map_exch='CPL:z2c_iacr2iacx', timer_infodata_exch='CPL:z2c_infoexch') - endif - - !---------------------------------------------------------- - !| iac post - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:IACPOST_BARRIER') - call t_drvstartf ('CPL:IACPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, iac, flow='c2x', comment= 'recv iac', & - info_debug=info_debug, timer_diag='CPL:iacpost_diagav') - - ! TRS I think this is wrong - review these prep functions. I think it's more likely - if (iac_c2_lnd) then - call prep_lnd_calc_z2x_lx(timer='CPL:iacpost_iac2lnd') - endif - - if (iac_c2_atm) then - call prep_atm_calc_z2x_ax(fractions_zx, timer='CPL:iacpost_iac2atm') - endif - - call t_drvstopf ('CPL:IACPOST', cplrun=.true.) - endif - - end subroutine cime_run_iac_recv_post - - !---------------------------------------------------------------------------------- - - subroutine cime_run_atmocn_setup(hashint) - integer, intent(inout) :: hashint(:) - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCNP_BARRIER') - call t_drvstartf ('CPL:ATMOCNP',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(7)) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (trim(cpl_seq_option(1:5)) == 'NUOPC') then - if (atm_c2_ocn) call prep_ocn_calc_a2x_ox(timer='CPL:atmocnp_atm2ocn') - end if - - if (ocn_prognostic) then - ! Map to ocn - if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') - if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') - if (trim(cpl_seq_option(1:5)) == 'NUOPC') then - if (rof_c2_ocn) call prep_ocn_calc_r2x_ox(timer='CPL:atmocnp_rof2ocn') - if (glc_c2_ocn) call prep_ocn_calc_g2x_ox(timer='CPL:atmocnp_glc2ocn') - end if - end if - - ! atm/ocn flux on either atm or ocean grid - call cime_run_atmocn_fluxes(hashint) - - ! ocn prep-merge (cesm1_mod or cesm1_mod_tight) - if (ocn_prognostic) then -#if COMPARE_TO_NUOPC - !This is need to compare to nuopc - if (.not. skip_ocean_run) then - ! ocn prep-merge - xao_ox => prep_aoflux_get_xao_ox() - call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') - - ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) - call prep_ocn_accum(timer='CPL:atmocnp_accum') - end if -#else - ! ocn prep-merge - xao_ox => prep_aoflux_get_xao_ox() - call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') - - ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) - call prep_ocn_accum(timer='CPL:atmocnp_accum') -#endif - end if - - !---------------------------------------------------------- - ! ocn albedos - ! (MUST BE AFTER prep_ocn_mrg for swnet to ocn to be computed properly - !---------------------------------------------------------- - call cime_run_ocn_albedos(hashint) - - !---------------------------------------------------------- - ! ocn budget - !---------------------------------------------------------- - if (do_budgets) then - call cime_run_calc_budgets3() - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ATMOCNP',cplrun=.true.,hashint=hashint(7)) - end if - - end subroutine cime_run_atmocn_setup - -!---------------------------------------------------------------------------------- - - subroutine cime_run_ocnglc_coupling() - !--------------------------------------- - ! Description: Run calculation of coupling fluxes between OCN and GLC - ! Note: this happens in the coupler to allow it be calculated on the - ! ocean time step but the GLC grid. - !--------------------------------------- - - if (glc_present) then - - if (ocn_c2_glcshelf .and. glcshelf_c2_ocn) then - ! the boundary flux calculations done in the coupler require inputs from both GLC and OCN, - ! so they will only be valid if both OCN->GLC and GLC->OCN - - call prep_glc_calc_o2x_gx(timer='CPL:glcprep_ocn2glc') !remap ocean fields to o2x_g at ocean couping interval - - call prep_glc_calculate_subshelf_boundary_fluxes ! this is actual boundary layer flux calculation - !this outputs - !x2g_g/g2x_g, where latter is going - !to ocean, so should get remapped to - !ocean grid in prep_ocn_shelf_calc_g2x_ox - call prep_ocn_shelf_calc_g2x_ox(timer='CPL:glcpost_glcshelf2ocn') - !Map g2x_gx shelf fields that were updated above, to g2x_ox. - !Do this at intrinsic coupling - !frequency - call prep_glc_accum_ocn(timer='CPL:glcprep_accum_ocn') !accum x2g_g fields here into x2g_gacc - endif - - if (glcshelf_c2_ice) then - call prep_ice_shelf_calc_g2x_ix(timer='CPL:glcpost_glcshelf2ice') - !Map g2x_gx shelf fields to g2x_ix. - !Do this at intrinsic coupling - !frequency. This is perhaps an - !unnecessary place to put this - !call, since these fields aren't - !changing on the intrinsic - !timestep. But I don't think it's - !unsafe to do it here. - endif - - endif - - end subroutine cime_run_ocnglc_coupling - -!---------------------------------------------------------------------------------- - - subroutine cime_run_lnd_setup_send() - - !---------------------------------------------------- - !| lnd prep-merge - !---------------------------------------------------- - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:LNDPREP_BARRIER') - call t_drvstartf ('CPL:LNDPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (atm_c2_lnd) call prep_lnd_calc_a2x_lx(timer='CPL:lndprep_atm2lnd') - if (trim(cpl_seq_option(1:5)) == 'NUOPC') then - if (glc_c2_lnd) call prep_lnd_calc_g2x_lx(timer='CPL:glcpost_glc2lnd') - end if - - ! IAC export onto lnd grid - if (iac_c2_lnd) then - call prep_lnd_calc_z2x_lx(timer='CPL:lndprep_iac2lnd') - endif - - if (lnd_prognostic) then - call prep_lnd_mrg(infodata, timer_mrg='CPL:lndprep_mrgx2l') - - call component_diag(infodata, lnd, flow='x2c', comment= 'send lnd', & - info_debug=info_debug, timer_diag='CPL:lndprep_diagav') - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:LNDPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - !| cpl -> lnd - !---------------------------------------------------- - if (iamin_CPLALLLNDID) then - call component_exch(lnd, flow='x2c', & - infodata=infodata, infodata_string='cpl2lnd_run', & - mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & - timer_barrier='CPL:C2L_BARRIER', timer_comp_exch='CPL:C2L', & - timer_map_exch='CPL:c2l_lndx2lndl', timer_infodata_exch='CPL:c2l_infoexch') - endif - - end subroutine cime_run_lnd_setup_send - -!---------------------------------------------------------------------------------- - - subroutine cime_run_lnd_recv_post() - - !---------------------------------------------------------- - !| lnd -> cpl - !---------------------------------------------------------- - if (iamin_CPLALLLNDID) then - call component_exch(lnd, flow='c2x', infodata=infodata, infodata_string='lnd2cpl_run', & - mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & - timer_barrier='CPL:L2C_BARRIER', timer_comp_exch='CPL:L2C', & - timer_map_exch='CPL:l2c_lndl2lndx', timer_infodata_exch='lnd2cpl_run') - endif - - !---------------------------------------------------------- - !| lnd post - !---------------------------------------------------------- - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:LNDPOST_BARRIER') - call t_drvstartf ('CPL:LNDPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, lnd, flow='c2x', comment='recv lnd', & - info_debug=info_debug, timer_diag='CPL:lndpost_diagav') - - ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) - if (lnd_c2_rof) call prep_rof_accum(timer='CPL:lndpost_accl2r') - if (lnd_c2_glc .or. do_hist_l2x1yrg) call prep_glc_accum_lnd(timer='CPL:lndpost_accl2g' ) - if (lnd_c2_iac) call prep_iac_accum(timer='CPL:lndpost_accl2z') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:LNDPOST',cplrun=.true.) - endif - - end subroutine cime_run_lnd_recv_post - -!---------------------------------------------------------------------------------- - - subroutine cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_called) - - logical, intent(inout) :: lnd2glc_averaged_now ! Set to .true. if lnd2glc averages are taken this timestep (otherwise left unchanged) - logical, intent(inout) :: prep_glc_accum_avg_called ! Set to .true. if prep_glc_accum_avg is called here (otherwise left unchanged) - - !---------------------------------------------------- - !| glc prep-merge - !---------------------------------------------------- - if (iamin_CPLID .and. glc_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:GLCPREP_BARRIER') - call t_drvstartf ('CPL:GLCPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - ! NOTE - only create appropriate input to glc if the avg_alarm is on - if (lnd_c2_glc .or. ocn_c2_glcshelf) then - if (glcrun_avg_alarm) then - call prep_glc_accum_avg(timer='CPL:glcprep_avg', & - lnd2glc_averaged_now=lnd2glc_averaged_now) - prep_glc_accum_avg_called = .true. - - if (lnd_c2_glc) then - ! Note that l2x_gx is obtained from mapping the module variable l2gacc_lx - call prep_glc_calc_l2x_gx(fractions_lx, timer='CPL:glcprep_lnd2glc') - - call prep_glc_mrg_lnd(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgx2g') - endif - - call component_diag(infodata, glc, flow='x2c', comment='send glc', & - info_debug=info_debug, timer_diag='CPL:glcprep_diagav') - - else - call prep_glc_zero_fields() - endif ! glcrun_avg_alarm - end if ! lnd_c2_glc or ocn_c2_glcshelf - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:GLCPREP',cplrun=.true.) - - end if ! iamin_CPLID .and. glc_prognostic - - ! Set the infodata field on all tasks (not just those with iamin_CPLID). - if (glc_prognostic) then - if (glcrun_avg_alarm) then - call seq_infodata_PutData(infodata, glc_valid_input=.true.) - else - call seq_infodata_PutData(infodata, glc_valid_input=.false.) - end if - end if - - !---------------------------------------------------- - !| cpl -> glc - !---------------------------------------------------- - if (iamin_CPLALLGLCID .and. glc_prognostic) then - call component_exch(glc, flow='x2c', & - infodata=infodata, infodata_string='cpl2glc_run', & - mpicom_barrier=mpicom_CPLALLGLCID, run_barriers=run_barriers, & - timer_barrier='CPL:C2G_BARRIER', timer_comp_exch='CPL:C2G', & - timer_map_exch='CPL:c2g_glcx2glcg', timer_infodata_exch='CPL:c2g_infoexch') - endif - - end subroutine cime_run_glc_setup_send - -!---------------------------------------------------------------------------------- - - subroutine cime_run_glc_accum_avg(lnd2glc_averaged_now, prep_glc_accum_avg_called) - ! Calls glc_accum_avg in case it's needed but hasn't already been called - - logical, intent(inout) :: lnd2glc_averaged_now ! Set to .true. if lnd2glc averages were taken this timestep (otherwise left unchanged) - logical, intent(inout) :: prep_glc_accum_avg_called ! Set to .true. if prep_glc_accum_avg is called here (otherwise left unchanged) - - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:AVG_L2X1YRG_BARRIER') - call t_drvstartf ('CPL:AVG_L2X1YRG',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call prep_glc_accum_avg(timer='CPL:glcprep_avg', & - lnd2glc_averaged_now=lnd2glc_averaged_now) - prep_glc_accum_avg_called = .true. - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:AVG_L2X1YRG',cplrun=.true.) - end subroutine cime_run_glc_accum_avg - -!---------------------------------------------------------------------------------- - - subroutine cime_run_glc_recv_post() - - !---------------------------------------------------------- - ! glc -> cpl - !---------------------------------------------------------- - if (iamin_CPLALLGLCID) then - call component_exch(glc, flow='c2x', infodata=infodata, infodata_string='glc2cpl_run', & - mpicom_barrier=mpicom_CPLALLGLCID, run_barriers=run_barriers, & - timer_barrier='CPL:G2C_BARRIER', timer_comp_exch='CPL:G2C', & - timer_map_exch='CPL:g2c_glcg2glcx', timer_infodata_exch='CPL:g2c_infoexch') - endif - - !---------------------------------------------------------- - ! glc post - !---------------------------------------------------------- - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:GLCPOST_BARRIER') - call t_drvstartf ('CPL:GLCPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, glc, flow='c2x', comment= 'recv glc', & - info_debug=info_debug, timer_diag='CPL:glcpost_diagav') - - if (trim(cpl_seq_option(1:5)) /= 'NUOPC') then - if (glc_c2_lnd) call prep_lnd_calc_g2x_lx(timer='CPL:glcpost_glc2lnd') - if (glc_c2_ocn) call prep_ocn_calc_g2x_ox(timer='CPL:glcpost_glc2ocn') - if (glc_c2_ice) call prep_ice_calc_g2x_ix(timer='CPL:glcpost_glc2ice') - end if - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:GLCPOST',cplrun=.true.) - endif - - end subroutine cime_run_glc_recv_post - -!---------------------------------------------------------------------------------- - - subroutine cime_run_rof_setup_send() - - !---------------------------------------------------- - ! rof prep-merge - !---------------------------------------------------- - if (iamin_CPLID .and. rof_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPREP_BARRIER') - - call t_drvstartf ('CPL:ROFPREP', cplrun=.true., barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call prep_rof_accum_avg(timer='CPL:rofprep_l2xavg') - - if (lnd_c2_rof) call prep_rof_calc_l2r_rx(fractions_lx, timer='CPL:rofprep_lnd2rof') - - call prep_rof_mrg(infodata, fractions_rx, timer_mrg='CPL:rofprep_mrgx2r', cime_model=cime_model) - - call component_diag(infodata, rof, flow='x2c', comment= 'send rof', & - info_debug=info_debug, timer_diag='CPL:rofprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ROFPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - ! cpl -> rof - !---------------------------------------------------- - if (iamin_CPLALLROFID .and. rof_prognostic) then - call component_exch(rof, flow='x2c', & - infodata=infodata, infodata_string='cpl2rof_run', & - mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & - timer_barrier='CPL:C2R_BARRIER', timer_comp_exch='CPL:C2R', & - timer_map_exch='CPL:c2r_rofx2rofr', timer_infodata_exch='CPL:c2r_infoexch') - endif - - end subroutine cime_run_rof_setup_send - -!---------------------------------------------------------------------------------- - - subroutine cime_run_rof_recv_post() - - !---------------------------------------------------------- - ! rof -> cpl - !---------------------------------------------------------- - if (iamin_CPLALLROFID) then - call component_exch(rof, flow='c2x', & - infodata=infodata, infodata_string='rof2cpl_run', & - mpicom_barrier=mpicom_CPLALLROFID, run_barriers=run_barriers, & - timer_barrier='CPL:R2C_BARRIER', timer_comp_exch='CPL:R2C', & - timer_map_exch='CPL:r2c_rofr2rofx', timer_infodata_exch='CPL:r2c_infoexch') - endif - - !---------------------------------------------------------- - ! rof post - !---------------------------------------------------------- - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPOST_BARRIER') - call t_drvstartf ('CPL:ROFPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, rof, flow='c2x', comment= 'recv rof', & - info_debug=info_debug, timer_diag='CPL:rofpost_diagav') - - if (trim(cpl_seq_option(1:5)) /= 'NUOPC') then - if (rof_c2_lnd) call prep_lnd_calc_r2x_lx(timer='CPL:rofpost_rof2lnd') - if (rof_c2_ice) call prep_ice_calc_r2x_ix(timer='CPL:rofpost_rof2ice') - if (rof_c2_ocn) call prep_ocn_calc_r2x_ox(timer='CPL:rofpost_rof2ocn') - end if - call t_drvstopf ('CPL:ROFPOST', cplrun=.true.) - endif - - end subroutine cime_run_rof_recv_post - -!---------------------------------------------------------------------------------- - - subroutine cime_run_ice_setup_send() - - ! Note that for atm->ice mapping below will leverage the assumption that the - ! ice and ocn are on the same grid and that mapping of atm to ocean is - ! done already for use by atmocn flux and ice model prep - - !---------------------------------------------------- - ! ice prep-merge - !---------------------------------------------------- - if (iamin_CPLID .and. ice_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ICEPREP_BARRIER') - - call t_drvstartf ('CPL:ICEPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (ocn_c2_ice) call prep_ice_calc_o2x_ix(timer='CPL:iceprep_ocn2ice') - if (trim(cpl_seq_option(1:5)) == 'NUOPC') then - if (rof_c2_ice) call prep_ice_calc_r2x_ix(timer='CPL:rofpost_rof2ice') - if (glc_c2_ice) call prep_ice_calc_g2x_ix(timer='CPL:glcpost_glc2ice') - end if - - if (atm_c2_ice) then - ! This is special to avoid remapping atm to ocn - ! Note it is constrained that different prep modules cannot use or call each other - a2x_ox => prep_ocn_get_a2x_ox() ! array - call prep_ice_calc_a2x_ix(a2x_ox, timer='CPL:iceprep_atm2ice') - endif - - call prep_ice_mrg(infodata, timer_mrg='CPL:iceprep_mrgx2i') - - call component_diag(infodata, ice, flow='x2c', comment= 'send ice', & - info_debug=info_debug, timer_diag='CPL:iceprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ICEPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - ! cpl -> ice - !---------------------------------------------------- - if (iamin_CPLALLICEID .and. ice_prognostic) then - call component_exch(ice, flow='x2c', & - infodata=infodata, infodata_string='cpl2ice_run', & - mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & - timer_barrier='CPL:C2I_BARRIER', timer_comp_exch='CPL:C2I', & - timer_map_exch='CPL:c2i_icex2icei', timer_infodata_exch='CPL:ice_infoexch') - endif - - end subroutine cime_run_ice_setup_send - -!---------------------------------------------------------------------------------- - - subroutine cime_run_ice_recv_post() - - !---------------------------------------------------------- - ! ice -> cpl - !---------------------------------------------------------- - if (iamin_CPLALLICEID) then - call component_exch(ice, flow='c2x', & - infodata=infodata, infodata_string='ice2cpl_run', & - mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & - timer_barrier='CPL:I2C_BARRIER', timer_comp_exch='CPL:I2C', & - timer_map_exch='CPL:i2c_icei2icex', timer_infodata_exch='CPL:i2c_infoexch') - endif - - !---------------------------------------------------------- - ! ice post - !---------------------------------------------------------- - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ICEPOST_BARRIER') - call t_drvstartf ('CPL:ICEPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, ice, flow='c2x', comment= 'recv ice', & - info_debug=info_debug, timer_diag='CPL:icepost_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ICEPOST',cplrun=.true.) - endif - - end subroutine cime_run_ice_recv_post - -!---------------------------------------------------------------------------------- - - subroutine cime_run_wav_setup_send() - - !---------------------------------------------------------- - ! wav prep-merge - !---------------------------------------------------------- - if (iamin_CPLID .and. wav_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:WAVPREP_BARRIER') - - call t_drvstartf ('CPL:WAVPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (atm_c2_wav) call prep_wav_calc_a2x_wx(timer='CPL:wavprep_atm2wav') - if (ocn_c2_wav) call prep_wav_calc_o2x_wx(timer='CPL:wavprep_ocn2wav') - if (ice_c2_wav) call prep_wav_calc_i2x_wx(timer='CPL:wavprep_ice2wav') - - call prep_wav_mrg(infodata, fractions_wx, timer_mrg='CPL:wavprep_mrgx2w') - - call component_diag(infodata, wav, flow='x2c', comment= 'send wav', & - info_debug=info_debug, timer_diag='CPL:wavprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:WAVPREP',cplrun=.true.) - endif - - !---------------------------------------------------------- - ! cpl -> wav - !---------------------------------------------------------- - if (iamin_CPLALLWAVID .and. wav_prognostic) then - call component_exch(wav, flow='x2c', & - infodata=infodata, infodata_string='cpl2wav_run', & - mpicom_barrier=mpicom_CPLALLWAVID, run_barriers=run_barriers, & - timer_barrier='CPL:C2W_BARRIER', timer_comp_exch='CPL:C2W', & - timer_map_exch='CPL:c2w_wavx2wavw', timer_infodata_exch='CPL:c2w_infoexch') - endif - - end subroutine cime_run_wav_setup_send - -!---------------------------------------------------------------------------------- - - subroutine cime_run_wav_recv_post() - - !---------------------------------------------------------- - ! wav -> cpl - !---------------------------------------------------------- - if (iamin_CPLALLWAVID) then - call component_exch(wav, flow='c2x', infodata=infodata, infodata_string='wav2cpl_run', & - mpicom_barrier=mpicom_CPLALLWAVID, run_barriers=run_barriers, & - timer_barrier='CPL:W2C_BARRIER', timer_comp_exch='CPL:W2C', & - timer_map_exch='CPL:w2c_wavw2wavx', timer_infodata_exch='CPL:w2c_infoexch') - endif - - !---------------------------------------------------------- - ! wav post - !---------------------------------------------------------- - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:WAVPOST_BARRIER') - call t_drvstartf ('CPL:WAVPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, wav, flow='c2x', comment= 'recv wav', & - info_debug=info_debug, timer_diag='CPL:wavpost_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:WAVPOST',cplrun=.true.) - endif - - end subroutine cime_run_wav_recv_post - -!---------------------------------------------------------------------------------- - - subroutine cime_run_update_fractions() - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:FRACSET_BARRIER') - call t_drvstartf ('CPL:FRACSET',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - call t_drvstartf ('CPL:fracset_fracset',barrier=mpicom_CPLID) - - do efi = 1,num_inst_frc - eii = mod((efi-1),num_inst_ice) + 1 - call seq_frac_set(infodata, ice(eii), fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) - enddo - call t_drvstopf ('CPL:fracset_fracset') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:FRACSET',cplrun=.true.) - endif - - end subroutine cime_run_update_fractions - -!---------------------------------------------------------------------------------- - - subroutine cime_run_calc_budgets1() - - !---------------------------------------------------------- - ! Budget with old fractions - !---------------------------------------------------------- - - ! WJS (2-17-11): I am just using the first instance for the budgets because we - ! don't expect budgets to be conserved for our case (I case). Also note that we - ! don't expect budgets to be conserved for the interactive ensemble use case either. - ! tcraig (aug 2012): put this after rof->cpl so the budget sees the new r2x_rx. - ! it will also use the current r2x_ox here which is the value from the last timestep - ! consistent with the ocean coupling - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET1_BARRIER') - call t_drvstartf ('CPL:BUDGET1',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - if (lnd_present) then - call seq_diag_lnd_mct(lnd(ens1), fractions_lx(ens1), infodata, do_l2x=.true., do_x2l=.true.) - endif - if (rof_present) then - call seq_diag_rof_mct(rof(ens1), fractions_rx(ens1), infodata) - endif - if (ice_present) then - call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_x2i=.true.) - endif - call t_drvstopf ('CPL:BUDGET1',cplrun=.true.,budget=.true.) - end if - end subroutine cime_run_calc_budgets1 - -!---------------------------------------------------------------------------------- - - subroutine cime_run_calc_budgets2() - - !---------------------------------------------------------- - ! Budget with new fractions - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET2_BARRIER') - - call t_drvstartf ('CPL:BUDGET2',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - if (atm_present) then - call seq_diag_atm_mct(atm(ens1), fractions_ax(ens1), infodata, do_a2x=.true., do_x2a=.true.) - endif - if (ice_present) then - call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_i2x=.true.) - endif - call t_drvstopf ('CPL:BUDGET2',cplrun=.true.,budget=.true.) - - call t_drvstartf ('CPL:BUDGET3',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - call seq_diag_accum_mct() - call t_drvstopf ('CPL:BUDGET3',cplrun=.true.,budget=.true.) - - call t_drvstartf ('CPL:BUDGETF',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - if (.not. dead_comps) then - call seq_diag_print_mct(EClock_d,stop_alarm,budget_inst, & - budget_daily, budget_month, budget_ann, budget_ltann, & - budget_ltend, infodata) - endif - call seq_diag_zero_mct(EClock=EClock_d) - - call t_drvstopf ('CPL:BUDGETF',cplrun=.true.,budget=.true.) - end if - end subroutine cime_run_calc_budgets2 - -!---------------------------------------------------------------------------------- - - subroutine cime_run_calc_budgets3() - - !---------------------------------------------------------- - ! ocn budget (rasm_option2) - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') - call t_drvstartf ('CPL:BUDGET0',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - xao_ox => prep_aoflux_get_xao_ox() ! array over all instances - call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & - do_o2x=.true., do_x2o=.true., do_xao=.true.) - call t_drvstopf ('CPL:BUDGET0',cplrun=.true.,budget=.true.) - end if - end subroutine cime_run_calc_budgets3 - -!---------------------------------------------------------------------------------- - - subroutine cime_run_write_history() - - !---------------------------------------------------------- - ! Write history file, only AVs on CPLID - !---------------------------------------------------------- - - if (iamin_CPLID) then - - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:HISTORY_BARRIER') - call t_drvstartf ('CPL:HISTORY',cplrun=.true.,barrier=mpicom_CPLID) - if ( history_alarm) then - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - if (iamroot_CPLID) then - write(logunit,104) ' Write history file at ',ymd,tod - call shr_sys_flush(logunit) - endif - - call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, iac, & - fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - endif - - if (do_histavg) then - call seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & - trim(cpl_inst_tag)) - endif - - call t_drvstopf ('CPL:HISTORY',cplrun=.true.) - - end if - -104 format( A, i10.8, i8) - end subroutine cime_run_write_history - -!---------------------------------------------------------------------------------- - - subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume) - - !---------------------------------------------------------- - ! Write driver restart file - !---------------------------------------------------------- - - logical , intent(in) :: drv_pause - logical , intent(in) :: write_restart - character(len=*), intent(inout) :: drv_resume ! Driver resets state from restart file - -103 format( 5A ) -104 format( A, i10.8, i8) - - if (iamin_CPLID) then - if ( (restart_alarm .or. drv_pause)) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:RESTART_BARRIER') - call t_drvstartf ('CPL:RESTART',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - if (iamroot_CPLID) then - write(logunit,104) ' Write restart file at ',ymd,tod - call shr_sys_flush(logunit) - endif - - call seq_rest_write(EClock_d, seq_SyncClock, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & - fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, fractions_zx, & - trim(cpl_inst_tag), drv_resume) - - if (iamroot_CPLID) then - write(logunit,103) ' Restart filename: ',trim(drv_resume) - call shr_sys_flush(logunit) - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:RESTART',cplrun=.true.) - else - drv_resume = '' - endif - end if - - end subroutine cime_run_write_restart - -!---------------------------------------------------------------------------------- - - subroutine cime_write_performance_checkpoint(output_ckpt, ckpt_filename, & - ckpt_mpicom) - - !---------------------------------------------------------- - ! Checkpoint performance data - !---------------------------------------------------------- - - logical, intent(in) :: output_ckpt - character(len=*), intent(in) :: ckpt_filename - integer, intent(in) :: ckpt_mpicom - -103 format( 5A ) -104 format( A, i10.8, i8) - - call t_adj_detailf(+1) - - call t_startf("sync1_tprf") - call mpi_barrier(ckpt_mpicom,ierr) - call t_stopf("sync1_tprf") - - if (output_ckpt) then - call t_prf(filename=trim(ckpt_filename), mpicom=ckpt_mpicom, & - num_outpe=0, output_thispe=output_ckpt) - else - call t_prf(filename=trim(ckpt_filename), mpicom=ckpt_mpicom, & - num_outpe=0) - endif - - call t_startf("sync2_tprf") - call mpi_barrier(ckpt_mpicom,ierr) - call t_stopf("sync2_tprf") - - call t_adj_detailf(-1) - - end subroutine cime_write_performance_checkpoint - end module cime_comp_mod