diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 8a768cfc..80d493ce 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -10,7 +10,7 @@ jobs: credentials: username: ${{ github.actor }} password: ${{ secrets.github_token }} - env: + env: CC: mpicc FC: mpif90 CPPFLAGS: '-I/usr/include -Duse_LARGEFILE -DMAXFIELDMETHODS_=500' @@ -19,5 +19,5 @@ jobs: steps: - name: Checkout code uses: actions/checkout@v2 - - name: Run build test + - name: Run build test run: t/null_model_build.sh diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index bd0f0f62..095a0333 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -1,4 +1,4 @@ -name: FMScoupler update doxygen site +name: FMScoupler update doxygen site on: [release, workflow_dispatch] diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml index c186dc1e..71f0bc90 100644 --- a/.github/workflows/lint.yml +++ b/.github/workflows/lint.yml @@ -9,4 +9,6 @@ jobs: - name: Checkout code uses: actions/checkout@v2 - name: Run linter - uses: NOAA-GFDL/simple_lint@v2 + uses: NOAA-GFDL/simple_lint@f5aa1fe976bd4c231db0536ba00cbfdc26708253 + with: + ftn_line_len: 121 diff --git a/CHANGELOG.md b/CHANGELOG.md index 16f9962d..59dd3e7e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,13 @@ sequential patch number (starting from `01`). - 2024.01-beta4 4dc9b0f2a85d34b0fdc8477625b91794a77ac747 - 2024.01-beta5 4dc9b0f2a85d34b0fdc8477625b91794a77ac747 +## [2023.04.01] - 2024-06-20 +### Fixed +- SIMPLE COUPLER: Fixed issue where the `sst_anom` value used was not the correct value read in from the namelist. (#122) + +### Tag Commit Hashes +- 2023.04 6b4f8b5207483eb7a7839a29909a415253a05db8 + ## [2023.04] - 2023-12-04 ### Added - Adds additional output arguments `thv_atm` amd `thv_surf` to the `surface_flux` interface, as well as calls to xgrid and send data in order to use a new atmosphere boundary layer scheme. @@ -87,13 +94,13 @@ sequential patch number (starting from `01`). ### Changed - Changes routine names used for constants in order to compile with recent constants changes to FMS ### Fixed -- FULL: Replaced a deprecated OpenMP routine causing warnings +- FULL: Replaced a deprecated OpenMP routine causing warnings - SIMPLE: Fixed a missing variable allocation that was causing failures with certain compilers ### Tag Commit Hashes 2022.02-alpha1 de3e3cbca349021a545a500f5ba1af6af22acfae 2022.02-alpha2 c23b6f3ff1f902adf1fa43f8a5c9d2307bd01106 -2022.02-beta1 2bb8f35e2f579e738b58c610c35ca9afd7e36358 +2022.02-beta1 2bb8f35e2f579e738b58c610c35ca9afd7e36358 ## [2022.01] - 2022-03-25 ### Added @@ -114,8 +121,8 @@ sequential patch number (starting from `01`). ### Added - FMS2_IO was implemented to the full coupler: - The coupler restart files are now read with fms2_io's ascii_read - - Ascii writes are now done with fortran's open, close, and write. They are wrapped in an if, so that only the root pe does the io, newunit ensures that the unit number is unique for each file. - - The variables named `unit` have been renamed to avoid fortran conflicts. + - Ascii writes are now done with fortran's open, close, and write. They are wrapped in an if, so that only the root pe does the io, newunit ensures that the unit number is unique for each file. + - The variables named `unit` have been renamed to avoid fortran conflicts. - The coupler type restarts are now written with fms2_io. - The grid file is now read with fms2_io in: full/flux_exchange.F90:check_atm_grid - FMS2_IO was implemented to the simple coupler: @@ -123,7 +130,7 @@ sequential patch number (starting from `01`). - Removed the native formatted restart file code - Fms2_io ascii_read is used to read to the coupler_restart - Fotran's `open`, `close`, and `write` are used to write the coupler_restart - - Removed the read_grid_data and get_grid_size subroutines from simple/ice_model.F90. These are never used. + - Removed the read_grid_data and get_grid_size subroutines from simple/ice_model.F90. These are never used. - Test cases added for varying the latitude of SST maximum in the simple coupler ice model. ### Changed - Changes all imports from FMS to use the global `FMS` module and the `FMSconstants` module @@ -148,7 +155,7 @@ sequential patch number (starting from `01`). were written by default. - FMS2_io does not do this. Users can specify real long_names and units by calling register_variable_attribute. ### Removed -- FMS_io was almost completely removed from FMScoupler and replaced with fms2_io. +- FMS_io was almost completely removed from FMScoupler and replaced with fms2_io. ### Tag Commit Hashes - 2021.02-alpha1 (c1c8044a6c3efb8ddbbd01a3769bbf2610b34937) - 2021.02-alpha2 (c1c8044a6c3efb8ddbbd01a3769bbf2610b34937) @@ -161,7 +168,7 @@ sequential patch number (starting from `01`). - SURFACE_FLUX: Adds a new functionality to enable using NCAR surface fluxes in experiments ### Fixed -- SIMPLE_COUPLER: Fixed issue with simpler coupler not calling data_override_init during initialization, will now call if the data_table file exists +- SIMPLE_COUPLER: Fixed issue with simpler coupler not calling data_override_init during initialization, will now call if the data_table file exists ## Tag Commit Hashes - 2021.01-beta1 (7e7212c6db62aa7916af0f6ada59c5a83355c1b8) diff --git a/SHiELD/coupler_main.F90 b/SHiELD/coupler_main.F90 index d29ff504..1b1a0474 100644 --- a/SHiELD/coupler_main.F90 +++ b/SHiELD/coupler_main.F90 @@ -70,15 +70,16 @@ program coupler_main ! ----- namelist ----- integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with - character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are - !! consistent with the time_manager module: 'gregorian', 'julian', - !! 'noleap', or 'thirty_day'. The value 'no_calendar' cannot be used - !! because the time_manager's date !! functions are used. + character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. + !! Valid values are consistent with the time_manager module: + !! 'gregorian', 'julian', 'noleap', or 'thirty_day'. The value + !! 'no_calendar' cannot be used + !! because the time_manager's date functions are used. !! All values must be lower case. - logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date should override - !! the date in the restart file `INPUT/coupler.res`. If the restart file does not - !! exist then force_date_from_namelist has no effect, the value of current_date - !! will be used. + logical :: force_date_from_namelist = .false. !< Flag that determines whether the namelist variable current_date + !! should override the date in the restart file `INPUT/coupler.res`. + !! If the restart file does not exist then force_date_from_namelist + !! has no effect, the value of current_date will be used. integer :: years=0 !< Number of years the current integration will be run integer :: months=0 !< Number of months the current integration will be run integer :: days=0 !< Number of days the current integration will be run @@ -322,7 +323,8 @@ subroutine coupler_init !----------------------------------------------------------------------- !----- write time stamps (for start time and end time) ------ - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) + open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') month = fms_time_manager_month_name(date(2)) if ( fms_mpp_pe() == fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) diff --git a/full/atm_land_ice_flux_exchange.F90 b/full/atm_land_ice_flux_exchange.F90 index 5cda7b4d..62081e36 100644 --- a/full/atm_land_ice_flux_exchange.F90 +++ b/full/atm_land_ice_flux_exchange.F90 @@ -146,14 +146,15 @@ module atm_land_ice_flux_exchange_mod real, allocatable, dimension(:,:) :: frac_precip !--- the following is from flux_exchange_nml - real :: z_ref_heat = 2. !< Reference height (meters) for temperature and relative humidity diagnostics (t_ref, rh_ref, del_h, del_q) + real :: z_ref_heat = 2. !< Reference height (meters) for temperature and relative humidity diagnostics + !! (t_ref, rh_ref, del_h, del_q) real :: z_ref_mom = 10. !< Reference height (meters) for mementum diagnostics (u_ref, v_ref, del_m) logical :: do_area_weighted_flux = .FALSE. logical :: do_forecast = .false. integer :: nblocks = 1 - logical :: partition_fprec_from_lprec = .FALSE. !< option for ATM override experiments where liquid+frozen precip are combined - !! This option will convert liquid precip to snow when t_ref is less than - !! tfreeze parameter + logical :: partition_fprec_from_lprec = .FALSE. !< option for ATM override experiments where liquid+frozen + !! precip are combined. This option will convert liquid precip to snow + !! when t_ref is less than tfreeze parameter logical :: scale_precip_2d = .false. integer :: my_nblocks = 1 @@ -290,9 +291,12 @@ subroutine atm_land_ice_flux_exchange_init(Time, Atm, Land, Ice, atmos_ice_bound type(atmos_data_type), intent(inout) :: Atm !< A derived data type to specify atmosphere boundary data type(land_data_type), intent(in) :: Land !< A derived data type to specify land boundary data type(ice_data_type), intent(inout) :: Ice !< A derived data type to specify ice boundary data - type(atmos_ice_boundary_type), intent(inout) :: atmos_ice_boundary !< A derived data type to specify properties and fluxes passed from atmosphere to ice - type(land_ice_atmos_boundary_type),intent(inout) :: land_ice_atmos_boundary !< A derived data type to specify properties and fluxes passed from exchange grid to - !! the atmosphere, land and ice + type(atmos_ice_boundary_type), intent(inout) :: atmos_ice_boundary !< A derived data type to specify properties + !! and fluxes passed from atmosphere to ice + type(land_ice_atmos_boundary_type),intent(inout) :: land_ice_atmos_boundary !< A derived data type to specify + !! properties and fluxes passed from + !! exchange grid to the atmosphere, land + !! and ice real, intent(in) :: Dt_atm_in !< Atmosphere time step in seconds real, intent(in) :: Dt_cpl_in !< Coupled time step in seconds real, intent(in) :: z_ref_heat_in, z_ref_mom_in @@ -658,8 +662,9 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar type(atmos_data_type), intent(inout) :: Atm !< A derived data type to specify atmosphere boundary data type(land_data_type), intent(inout) :: Land !< A derived data type to specify land boundary data type(ice_data_type), intent(inout) :: Ice !< A derived data type to specify ice boundary data - type(land_ice_atmos_boundary_type), intent(inout) :: Land_Ice_Atmos_Boundary !< A derived data type to specify properties and - !! fluxes passed from exchange grid to the atmosphere, + type(land_ice_atmos_boundary_type), intent(inout) :: Land_Ice_Atmos_Boundary !< A derived data type to specify + !! properties and fluxes passed from + !! exchange grid to the atmosphere, !! land and ice ! ---- local vars ---------------------------------------------------------- @@ -889,12 +894,16 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar atm%fields%bc(n)%field(m)%values, Time, override = atm%fields%bc(n)%field(m)%override) ex_gas_fields_atm%bc(n)%field(m)%override = atm%fields%bc(n)%field(m)%override ! 2017/08/08 jgj add co2_flux_pcair_atm diagnostic - if ( atm%fields%bc(n)%field(m)%override .and. fms_mpp_lowercase(trim(atm%fields%bc(n)%field(m)%name)) .eq. 'co2_flux_pcair_atm') then - if( id_co2_flux_pcair_atm > 0 ) used = fms_diag_send_data ( id_co2_flux_pcair_atm, atm%fields%bc(n)%field(m)%values, Time ) + if ( atm%fields%bc(n)%field(m)%override .and. & + fms_mpp_lowercase(trim(atm%fields%bc(n)%field(m)%name)) .eq. 'co2_flux_pcair_atm') then + if( id_co2_flux_pcair_atm > 0 ) & + used = fms_diag_send_data ( id_co2_flux_pcair_atm, atm%fields%bc(n)%field(m)%values, Time ) endif ! 2017/08/15 jgj add o2_flux_pcair_atm diagnostic - if ( atm%fields%bc(n)%field(m)%override .and. fms_mpp_lowercase(trim(atm%fields%bc(n)%field(m)%name)) .eq. 'o2_flux_pcair_atm') then - if( id_o2_flux_pcair_atm > 0 ) used = fms_diag_send_data ( id_o2_flux_pcair_atm, atm%fields%bc(n)%field(m)%values, Time ) + if ( atm%fields%bc(n)%field(m)%override .and. & + fms_mpp_lowercase(trim(atm%fields%bc(n)%field(m)%name)) .eq. 'o2_flux_pcair_atm') then + if( id_o2_flux_pcair_atm > 0 ) & + used = fms_diag_send_data ( id_o2_flux_pcair_atm, atm%fields%bc(n)%field(m)%values, Time ) endif enddo !} m enddo !} n @@ -1177,7 +1186,7 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar is=block_start(l) ie=block_end(l) call surface_flux (& - ex_t_atm(is:ie), ex_tr_atm(is:ie,isphum), ex_u_atm(is:ie), ex_v_atm(is:ie), ex_p_atm(is:ie), ex_z_atm(is:ie), & + ex_t_atm(is:ie), ex_tr_atm(is:ie,isphum), ex_u_atm(is:ie),ex_v_atm(is:ie),ex_p_atm(is:ie),ex_z_atm(is:ie),& ex_p_surf(is:ie),ex_t_surf(is:ie), ex_t_ca(is:ie), ex_tr_surf(is:ie,isphum), & ex_u_surf(is:ie), ex_v_surf(is:ie), & ex_rough_mom(is:ie), ex_rough_heat(is:ie), ex_rough_moist(is:ie), ex_rough_scale(is:ie), & @@ -1272,7 +1281,8 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar if (ex_gas_fluxes%bc(n)%atm_tr_index .gt. 0) then !{ m = tr_table_map(ex_gas_fluxes%bc(n)%atm_tr_index)%exch if (id_tr_mol_flux0(m) .gt. 0) then - call fms_xgrid_get_from_xgrid (diag_atm, 'ATM', ex_gas_fluxes%bc(n)%field(fms_coupler_ind_flux0)%values(:), xmap_sfc) + call fms_xgrid_get_from_xgrid (diag_atm, 'ATM', ex_gas_fluxes%bc(n)%field(fms_coupler_ind_flux0)%values(:),& + xmap_sfc) used = fms_diag_send_data ( id_tr_mol_flux0(m), diag_atm, Time ) end if end if @@ -1290,7 +1300,8 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar do n = 1, ex_gas_fluxes%num_bcs !{ if (ex_gas_fluxes%bc(n)%atm_tr_index .gt. 0) then !{ m = tr_table_map(ex_gas_fluxes%bc(n)%atm_tr_index)%exch - call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, ex_gas_fluxes%bc(n)%atm_tr_index, tr_name, units=tr_units) + call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, ex_gas_fluxes%bc(n)%atm_tr_index, tr_name, & + units=tr_units) do i = is,ie !{ if (ex_land(i)) cycle ! over land, don't do anything ! on ocean or ice cells, flux is explicit therefore we zero derivatives. @@ -1303,7 +1314,8 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar / (1.-ex_tr_atm(i,isphum)) else ! jgj: convert to kg co2/m2/sec for atm - ex_flux_tr(i,m) = ex_gas_fluxes%bc(n)%field(fms_coupler_ind_flux)%values(i) * ex_gas_fluxes%bc(n)%mol_wt * 1.0e-03 + ex_flux_tr(i,m) = ex_gas_fluxes%bc(n)%field(fms_coupler_ind_flux)%values(i) * & + ex_gas_fluxes%bc(n)%mol_wt * 1.0e-03 end if else ex_flux_tr(i,m) = 0.0 ! pure ice exchange cell @@ -1434,8 +1446,8 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar call fms_xgrid_get_from_xgrid (Land_Ice_Atmos_Boundary%b_star, 'ATM', ex_b_star , xmap_sfc, complete=.false.) call fms_xgrid_get_from_xgrid (Land_Ice_Atmos_Boundary%q_star, 'ATM', ex_q_star , xmap_sfc, complete=.true.) - call fms_xgrid_get_from_xgrid (Land_Ice_Atmos_Boundary%u_ref, 'ATM', ex_ref_u , xmap_sfc, complete=.false.) !bqx - call fms_xgrid_get_from_xgrid (Land_Ice_Atmos_Boundary%v_ref, 'ATM', ex_ref_v , xmap_sfc, complete=.true.) !bqx + call fms_xgrid_get_from_xgrid (Land_Ice_Atmos_Boundary%u_ref, 'ATM', ex_ref_u , xmap_sfc, complete=.false.) !bqx + call fms_xgrid_get_from_xgrid (Land_Ice_Atmos_Boundary%v_ref, 'ATM', ex_ref_v , xmap_sfc, complete=.true.) !bqx #ifndef use_AM3_physics call fms_xgrid_get_from_xgrid (Land_Ice_Atmos_Boundary%shflx, 'ATM', ex_flux_t , xmap_sfc) @@ -1573,7 +1585,8 @@ subroutine sfc_boundary_layer ( dt, Time, Atm, Land, Ice, Land_Ice_Atmos_Boundar do n = 1, Atm%fields%num_bcs !{ do m = 1, Atm%fields%bc(n)%num_fields !{ if ( Atm%fields%bc(n)%field(m)%id_diag > 0 ) then !{ - if (atm%fields%bc(n)%use_10m_wind_speed .and. m .eq. fms_coupler_ind_u10 .and. .not. Atm%fields%bc(n)%field(m)%override) then !{ + if (atm%fields%bc(n)%use_10m_wind_speed .and. m .eq. fms_coupler_ind_u10 .and. & + .not. Atm%fields%bc(n)%field(m)%override) then !{ call fms_xgrid_get_from_xgrid (Atm%fields%bc(n)%field(m)%values, 'ATM', & ex_gas_fields_atm%bc(n)%field(m)%values, xmap_sfc) endif !} @@ -1976,12 +1989,13 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun type(atmos_data_type), intent(inout) :: Atm !< A derived data type to specify atmosphere boundary data type(land_data_type), intent(in) :: Land !< A derived data type to specify land boundary data type(ice_data_type), intent(in) :: Ice !< A derived data type to specify ice boundary data - type(land_ice_atmos_boundary_type),intent(in) :: Atmos_boundary !< A derived data type to specify properties and fluxes - !! passed from exchange grid to the atmosphere, land and ice - type(atmos_land_boundary_type), intent(inout):: Land_boundary !< A derived data type to specify properties and fluxes - !! passed from atmosphere to land - type(atmos_ice_boundary_type), intent(inout):: Ice_boundary !< A derived data type to specify properties and fluxes passed - !! from atmosphere to ice + type(land_ice_atmos_boundary_type),intent(in) :: Atmos_boundary !< A derived data type to specify properties and + !!fluxes passed from exchange grid to the atmosphere + !! land and ice + type(atmos_land_boundary_type), intent(inout):: Land_boundary !< A derived data type to specify properties and + !! fluxes passed from atmosphere to land + type(atmos_ice_boundary_type), intent(inout):: Ice_boundary !< A derived data type to specify properties and + !! fluxes passed from atmosphere to ice real, dimension(n_xgrid_sfc) :: ex_flux_sw, ex_flux_lwd, & ex_flux_sw_dir, & @@ -2098,9 +2112,9 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun call fms_xgrid_put_to_xgrid (Atm%flux_sw_dif, 'ATM', ex_flux_sw_dif, xmap_sfc, complete=.false.) call fms_xgrid_put_to_xgrid (Atm%flux_sw_vis_dif, 'ATM', ex_flux_sw_vis_dif, xmap_sfc, complete=.false.) call fms_xgrid_put_to_xgrid (Atm%flux_sw_down_vis_dir, 'ATM', ex_flux_sw_down_vis_dir, xmap_sfc, complete=.false.) - call fms_xgrid_put_to_xgrid (Atm%flux_sw_down_total_dir, 'ATM', ex_flux_sw_down_total_dir, xmap_sfc, complete=.false.) - call fms_xgrid_put_to_xgrid (Atm%flux_sw_down_vis_dif, 'ATM', ex_flux_sw_down_vis_dif, xmap_sfc, complete=.false.) - call fms_xgrid_put_to_xgrid (Atm%flux_sw_down_total_dif, 'ATM', ex_flux_sw_down_total_dif, xmap_sfc, complete=.false.) + call fms_xgrid_put_to_xgrid (Atm%flux_sw_down_total_dir,'ATM', ex_flux_sw_down_total_dir, xmap_sfc,complete=.false.) + call fms_xgrid_put_to_xgrid (Atm%flux_sw_down_vis_dif,'ATM', ex_flux_sw_down_vis_dif, xmap_sfc,complete=.false.) + call fms_xgrid_put_to_xgrid (Atm%flux_sw_down_total_dif, 'ATM',ex_flux_sw_down_total_dif, xmap_sfc,complete=.false.) ! ccc = conservation_check(Atm%lprec, 'ATM', xmap_sfc) ! if (fms_mpp_pe()== fms_mpp_root_pe()) print *,'LPREC', ccc @@ -2123,8 +2137,10 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun ! on exchange grid instead of the stresses themselves so that only the ! implicit corrections are filtered through the atmospheric grid not the ! stresses themselves - call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%delta_u, 'ATM', ex_delta_u, xmap_sfc, remap_method=remap_method, complete=.false.) - call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%delta_v, 'ATM', ex_delta_v, xmap_sfc, remap_method=remap_method, complete=.true.) + call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%delta_u, 'ATM', ex_delta_u, xmap_sfc, remap_method=remap_method, & + complete=.false.) + call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%delta_v, 'ATM', ex_delta_v, xmap_sfc, remap_method=remap_method, & + complete=.true.) ! MOD update stresses using atmos delta's but derivatives on exchange grid !$OMP parallel do default(none) shared(my_nblocks,block_start,block_end,ex_flux_u,ex_delta_u, & @@ -2191,8 +2207,8 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun do tr = 1,n_exch_tr n = tr_table(tr)%atm - call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%delta_tr(:,:,n), 'ATM', ex_delta_tr(:,tr), xmap_sfc, complete=.false. ) - call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%dflux_tr(:,:,n), 'ATM', ex_dflux_tr(:,tr), xmap_sfc, complete=.false. ) + call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%delta_tr(:,:,n), 'ATM', ex_delta_tr(:,tr), xmap_sfc, complete=.false.) + call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%dflux_tr(:,:,n), 'ATM', ex_dflux_tr(:,tr), xmap_sfc, complete=.false.) enddo call fms_xgrid_put_to_xgrid (Atm%Surf_Diff%dtmass , 'ATM', ex_dtmass , xmap_sfc, complete=.false. ) @@ -2278,9 +2294,9 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun call fms_xgrid_get_from_xgrid_ug (Land_boundary%t_flux, 'LND', ex_flux_t, xmap_sfc) call fms_xgrid_get_from_xgrid_ug (Land_boundary%sw_flux, 'LND', ex_flux_sw, xmap_sfc) call fms_xgrid_get_from_xgrid_ug (Land_boundary%sw_flux_down_vis_dir, 'LND', ex_flux_sw_down_vis_dir, xmap_sfc) - call fms_xgrid_get_from_xgrid_ug (Land_boundary%sw_flux_down_total_dir, 'LND', ex_flux_sw_down_total_dir, xmap_sfc) + call fms_xgrid_get_from_xgrid_ug (Land_boundary%sw_flux_down_total_dir, 'LND', ex_flux_sw_down_total_dir, xmap_sfc) call fms_xgrid_get_from_xgrid_ug (Land_boundary%sw_flux_down_vis_dif, 'LND', ex_flux_sw_down_vis_dif, xmap_sfc) - call fms_xgrid_get_from_xgrid_ug (Land_boundary%sw_flux_down_total_dif, 'LND', ex_flux_sw_down_total_dif, xmap_sfc) + call fms_xgrid_get_from_xgrid_ug (Land_boundary%sw_flux_down_total_dif, 'LND', ex_flux_sw_down_total_dif, xmap_sfc) call fms_xgrid_get_from_xgrid_ug (Land_boundary%lw_flux, 'LND', ex_flux_lw, xmap_sfc) #ifdef SCM if (do_specified_land .and. do_specified_flux) then @@ -2478,19 +2494,22 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun call fms_xgrid_get_from_xgrid (Ice_boundary%q_flux, 'OCN', ex_flux_tr(:,isphum), xmap_sfc) call fms_xgrid_get_from_xgrid (Ice_boundary%sw_flux_vis_dir, 'OCN', ex_flux_sw_vis_dir, xmap_sfc) call fms_xgrid_get_from_xgrid (Ice_boundary%sw_flux_nir_dir, 'OCN', ex_flux_sw_dir,xmap_sfc) - Ice_boundary%sw_flux_nir_dir = Ice_boundary%sw_flux_nir_dir - Ice_boundary%sw_flux_vis_dir ! ice & ocean use these 4: dir/dif nir/vis - + ! ice & ocean use these 4: dir/dif nir/vis + Ice_boundary%sw_flux_nir_dir = Ice_boundary%sw_flux_nir_dir - Ice_boundary%sw_flux_vis_dir call fms_xgrid_get_from_xgrid (Ice_boundary%sw_flux_vis_dif, 'OCN', ex_flux_sw_vis_dif, xmap_sfc) call fms_xgrid_get_from_xgrid (Ice_boundary%sw_flux_nir_dif, 'OCN', ex_flux_sw_dif,xmap_sfc) - Ice_boundary%sw_flux_nir_dif = Ice_boundary%sw_flux_nir_dif - Ice_boundary%sw_flux_vis_dif ! ice & ocean use these 4: dir/dif nir/vis + ! ice & ocean use these 4: dir/dif nir/vis + Ice_boundary%sw_flux_nir_dif = Ice_boundary%sw_flux_nir_dif - Ice_boundary%sw_flux_vis_dif call fms_xgrid_get_from_xgrid (Ice_boundary%sw_down_vis_dir, 'OCN', ex_flux_sw_down_vis_dir, xmap_sfc) call fms_xgrid_get_from_xgrid (Ice_boundary%sw_down_nir_dir, 'OCN', ex_flux_sw_down_total_dir, xmap_sfc) - Ice_boundary%sw_down_nir_dir = Ice_boundary%sw_down_nir_dir - Ice_boundary%sw_down_vis_dir ! ice & ocean use these 4: dir/dif nir/vis + ! ice & ocean use these 4: dir/dif nir/vis + Ice_boundary%sw_down_nir_dir = Ice_boundary%sw_down_nir_dir - Ice_boundary%sw_down_vis_dir call fms_xgrid_get_from_xgrid (Ice_boundary%sw_down_vis_dif, 'OCN', ex_flux_sw_down_vis_dif, xmap_sfc) call fms_xgrid_get_from_xgrid (Ice_boundary%sw_down_nir_dif, 'OCN', ex_flux_sw_down_total_dif,xmap_sfc) - Ice_boundary%sw_down_nir_dif = Ice_boundary%sw_down_nir_dif - Ice_boundary%sw_down_vis_dif ! ice & ocean use these 4: dir/dif nir/vis + ! ice & ocean use these 4: dir/dif nir/vis + Ice_boundary%sw_down_nir_dif = Ice_boundary%sw_down_nir_dif - Ice_boundary%sw_down_vis_dif call fms_xgrid_get_from_xgrid (Ice_boundary%lw_flux, 'OCN', ex_flux_lw, xmap_sfc) call fms_xgrid_get_from_xgrid (Ice_boundary%dhdt, 'OCN', ex_dhdt_surf, xmap_sfc) @@ -2587,7 +2606,8 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun call fms_xgrid_stock_move_ug( & & FROM = fms_stock_constants_atm_stock(ISTOCK_HEAT), & & TO = fms_stock_constants_lnd_stock(ISTOCK_HEAT), & - & stock_ug_data3d = (-Land_boundary%t_flux + Land_boundary%lw_flux + Land_boundary%sw_flux - Land_boundary%fprec*HLF), & + & stock_ug_data3d = (-Land_boundary%t_flux + Land_boundary%lw_flux + Land_boundary%sw_flux - & + Land_boundary%fprec*HLF), & & grid_index=X1_GRID_LND, & & xmap=xmap_sfc, & & delta_t=Dt_atm, & @@ -2608,7 +2628,8 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun call fms_xgrid_stock_move( & & FROM = fms_stock_constants_atm_stock(ISTOCK_HEAT), & & TO = fms_stock_constants_lnd_stock(ISTOCK_HEAT), & - & stock_data3d = (-Land_boundary%t_flux + Land_boundary%lw_flux + Land_boundary%sw_flux - Land_boundary%fprec*HLF), & + & stock_data3d = (-Land_boundary%t_flux + Land_boundary%lw_flux + Land_boundary%sw_flux - & + Land_boundary%fprec*HLF), & & grid_index=X1_GRID_LND, & & xmap=xmap_sfc, & & delta_t=Dt_atm, & @@ -2631,7 +2652,8 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun call fms_xgrid_stock_move( & & FROM = fms_stock_constants_atm_stock(ISTOCK_HEAT), & & TO = fms_stock_constants_ice_stock(ISTOCK_HEAT), & - & stock_data3d = (-Ice_boundary%t_flux + Ice_boundary%lw_flux - Ice_boundary%fprec*HLF + Ice_boundary%sw_flux_vis_dir + & + & stock_data3d = (-Ice_boundary%t_flux + Ice_boundary%lw_flux - Ice_boundary%fprec*HLF + & + Ice_boundary%sw_flux_vis_dir + & Ice_boundary%sw_flux_vis_dif + Ice_boundary%sw_flux_nir_dir + Ice_boundary%sw_flux_nir_dif), & & grid_index=X1_GRID_ICE, & & xmap=xmap_sfc, & @@ -2718,8 +2740,10 @@ subroutine flux_up_to_atmos ( Time, Land, Ice, Land_Ice_Atmos_Boundary, Land_bou type(FmsTime_type), intent(in) :: Time !< Current time type(land_data_type), intent(inout) :: Land !< A derived data type to specify ice boundary data type(ice_data_type), intent(inout) :: Ice !< A derived data type to specify ice boundary data - type(land_ice_atmos_boundary_type), intent(inout) :: Land_Ice_Atmos_Boundary !< A derived data type to specify properties and fluxed - !! passed from exchange grid to the atmosphere, land and ice + type(land_ice_atmos_boundary_type), intent(inout) :: Land_Ice_Atmos_Boundary !< A derived data type to specify + !! properties and fluxes passed from + !! exchange grid to the atmosphere, + !! land and ice type(atmos_land_boundary_type), intent(inout) :: Land_boundary type(atmos_ice_boundary_type), intent(inout) :: Ice_boundary @@ -2746,7 +2770,8 @@ subroutine flux_up_to_atmos ( Time, Land, Ice, Land_Ice_Atmos_Boundary, Land_bou #ifndef _USE_LEGACY_LAND_ real, dimension(size(Land_boundary%lprec,1), size(Land_boundary%lprec,2)) :: data_lnd, diag_land #else - real, dimension(size(Land_boundary%lprec,1), size(Land_boundary%lprec,2), size(Land_boundary%lprec,3)) :: data_lnd, diag_land + real, dimension(size(Land_boundary%lprec,1), size(Land_boundary%lprec,2), size(Land_boundary%lprec,3)) :: data_lnd,& + diag_land #endif real, dimension(size(Ice_boundary%lprec,1), size(Ice_boundary%lprec,2), size(Ice_boundary%lprec,3)) :: data_ice real, dimension(size(Ice%albedo,1),size(Ice%albedo,2),size(Ice%albedo,3)) :: icegrid @@ -3050,7 +3075,8 @@ subroutine flux_up_to_atmos ( Time, Land, Ice, Land_Ice_Atmos_Boundary, Land_bou if (fms_mpp_lowercase(trim(tr_name))=='co2') then call send_tile_data (id_tr_mol_flux_land(tr), diag_land*1000./WTMCO2) elseif (fms_mpp_lowercase(trim(tr_units)).eq.'vmr') then - call fms_xgrid_get_from_xgrid_ug (diag_land, 'LND', ex_flux_tr(:,tr)*(1.-ex_tr_surf_new(:,isphum)), xmap_sfc) + call fms_xgrid_get_from_xgrid_ug (diag_land, 'LND', ex_flux_tr(:,tr)*(1.-ex_tr_surf_new(:,isphum)), & + xmap_sfc) call send_tile_data (id_tr_mol_flux_land(tr), diag_atm*1000./WTMAIR ) endif endif @@ -3245,8 +3271,8 @@ end subroutine flux_ex_arrays_dealloc subroutine flux_atmos_to_ocean(Time, Atm, Ice_boundary, Ice) type(FmsTime_type), intent(in) :: Time !< Current time type(atmos_data_type), intent(inout):: Atm !< A derived data type to specify atmosphere boundary data - type(atmos_ice_boundary_type), intent(inout):: Ice_boundary !< A derived data type to specify properties and fluxes passed - !! from atmosphere to ice + type(atmos_ice_boundary_type), intent(inout):: Ice_boundary !< A derived data type to specify properties and fluxes + !! passed from atmosphere to ice type(ice_data_type), intent(inout):: Ice integer :: n,m @@ -3282,7 +3308,8 @@ subroutine flux_atmos_to_ocean(Time, Atm, Ice_boundary, Ice) call fms_data_override('ICE', Ice_boundary%fluxes%bc(n)%field(m)%name, & Ice_boundary%fluxes%bc(n)%field(m)%values, Time) if ( Ice_boundary%fluxes%bc(n)%field(m)%id_diag > 0 ) then !{ - used = fms_diag_send_data(Ice_boundary%fluxes%bc(n)%field(m)%id_diag, Ice_boundary%fluxes%bc(n)%field(m)%values, Time ) + used = fms_diag_send_data(Ice_boundary%fluxes%bc(n)%field(m)%id_diag, & + Ice_boundary%fluxes%bc(n)%field(m)%values, Time ) endif !} enddo !} m endif @@ -3608,10 +3635,10 @@ subroutine diag_field_init ( Time, atmos_axes, land_axes, land_pe ) id_tr_flux_land(tr) = register_tiled_diag_field( 'flux_land', trim(name)//'_flux', Land_axes, Time, & 'flux of '//trim(longname), trim(units)//' kg air/(m2 s)', missing_value=-1.0 ) if ( fms_mpp_lowercase(trim(name))=='co2') then - id_tr_mol_flux_land(tr) = register_tiled_diag_field( 'flux_land', trim(name)//'_mol_flux', Land_axes, Time, & + id_tr_mol_flux_land(tr) = register_tiled_diag_field( 'flux_land', trim(name)//'_mol_flux', Land_axes,Time,& 'flux of '//trim(longname), 'mol CO2/(m2 s)', missing_value=-1.0 ) else - id_tr_mol_flux_land(tr) = register_tiled_diag_field( 'flux_land', trim(name)//'_mol_flux', Land_axes, Time, & + id_tr_mol_flux_land(tr) = register_tiled_diag_field( 'flux_land', trim(name)//'_mol_flux', Land_axes,Time,& 'flux of '//trim(longname), 'mol/(m2 s)', missing_value=-1.0 ) endif enddo @@ -3657,11 +3684,11 @@ subroutine diag_field_init ( Time, atmos_axes, land_axes, land_pe ) id_tr_flux_land(tr) = fms_diag_register_diag_field( 'flux_land', trim(name)//'_flux', Land_axes, Time, & 'flux of '//trim(longname), trim(units)//' kg air/(m2 s)', missing_value=-1.0 ) if ( fms_mpp_lowercase(trim(name))=='co2') then - id_tr_mol_flux_land(tr) = fms_diag_register_diag_field( 'flux_land', trim(name)//'_mol_flux', Land_axes, Time, & - 'flux of '//trim(longname), 'mol CO2/(m2 s)', missing_value=-1.0 ) + id_tr_mol_flux_land(tr) = fms_diag_register_diag_field( 'flux_land', trim(name)//'_mol_flux', Land_axes, & + Time, 'flux of '//trim(longname), 'mol CO2/(m2 s)', missing_value=-1.0 ) else - id_tr_mol_flux_land(tr) = fms_diag_register_diag_field( 'flux_land', trim(name)//'_mol_flux', Land_axes, Time, & - 'flux of '//trim(longname), 'mol/(m2 s)', missing_value=-1.0 ) + id_tr_mol_flux_land(tr) = fms_diag_register_diag_field( 'flux_land', trim(name)//'_mol_flux', Land_axes, & + Time, 'flux of '//trim(longname), 'mol/(m2 s)', missing_value=-1.0 ) endif enddo #endif diff --git a/full/atmos_ocean_dep_fluxes_calc.F90 b/full/atmos_ocean_dep_fluxes_calc.F90 index abf79e38..a9d0f35d 100644 --- a/full/atmos_ocean_dep_fluxes_calc.F90 +++ b/full/atmos_ocean_dep_fluxes_calc.F90 @@ -31,8 +31,10 @@ module atmos_ocean_dep_fluxes_calc_mod !> \brief atmos_ocean_dep_fluxes_calc ! !! \throw FATAL, "Number of gas fluxes not zero" - !! \throw FATAL, "atmos_ocean_dep_fluxes_calc: Bad parameter ([gas_fluxes%bc(n)%param(1)]) for air_sea_deposition for [gas_fluxes%bc(n)%name]" - !! \throw FATAL, "atmos_ocean_dep_fluxes_calc: Unknown implementation ([gas_fluxes%bc(n)%implementation] for [gas_fluxes%bc(n)%name]" + !! \throw FATAL, "atmos_ocean_dep_fluxes_calc: Bad parameter ([gas_fluxes%bc(n)%param(1)]) for air_sea_deposition for + !! [gas_fluxes%bc(n)%name]" + !! \throw FATAL, "atmos_ocean_dep_fluxes_calc: Unknown implementation ([gas_fluxes%bc(n)%implementation] for + !! [gas_fluxes%bc(n)%name]" subroutine atmos_ocean_dep_fluxes_calc(gas_fields_atm, gas_fields_ice, gas_fluxes, seawater) type(FmsCoupler1dBC_type), intent(in) :: gas_fields_atm !< Structure containing atmospheric surface !! variables that are used in the calculation diff --git a/full/atmos_ocean_fluxes_calc.F90 b/full/atmos_ocean_fluxes_calc.F90 index d62d404e..9da6da57 100644 --- a/full/atmos_ocean_fluxes_calc.F90 +++ b/full/atmos_ocean_fluxes_calc.F90 @@ -18,7 +18,7 @@ !* If not, see . !*********************************************************************** !> \file -!> \brief Calculates gas fluxes for atmosphere and ocean +!> \brief Calculates gas fluxes for atmosphere and ocean module atmos_ocean_fluxes_calc_mod use FMS @@ -161,7 +161,8 @@ subroutine atmos_ocean_fluxes_calc(gas_fields_atm, gas_fields_ice,& & calc_kw(tsurf(i),& & gas_fields_atm%bc(n)%field(fms_coupler_ind_psurf)%values(i),& & gas_fields_atm%bc(n)%field(fms_coupler_ind_u10)%values(i),& - & 101325./(rdgas*wtmair*1e-3*tsurf(i)*max(gas_fields_ice%bc(n)%field(fms_coupler_ind_alpha)%values(i),epsln)),& + & 101325./(rdgas*wtmair*1e-3*tsurf(i)* & + max(gas_fields_ice%bc(n)%field(fms_coupler_ind_alpha)%values(i),epsln)),& & gas_fluxes%bc(n)%param(2),& & gas_fluxes%bc(n)%param(1),& & gas_fields_ice%bc(n)%field(fms_coupler_ind_sc_no)%values(i)) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 4ae80dbd..bc0822a9 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -339,21 +339,22 @@ program coupler_main use iso_fortran_env implicit none - !> model defined types - type (atmos_data_type) :: Atm - type (land_data_type) :: Land - type (ice_data_type) :: Ice + !> model defined types. + !! Targets to pointers in coupler_components_obj + type (atmos_data_type), target :: Atm + type (land_data_type), target :: Land + type (ice_data_type), target :: Ice ! allow members of ocean type to be aliased (ap) type (ocean_public_type), target :: Ocean type (ocean_state_type), pointer :: Ocean_state => NULL() - type(atmos_land_boundary_type) :: Atmos_land_boundary - type(atmos_ice_boundary_type) :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary - type(land_ice_boundary_type) :: Land_ice_boundary - type(ice_ocean_boundary_type) :: Ice_ocean_boundary - type(ocean_ice_boundary_type) :: Ocean_ice_boundary - type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() + type(atmos_land_boundary_type), target :: Atmos_land_boundary + type(atmos_ice_boundary_type), target :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type), target :: Land_ice_atmos_boundary + type(land_ice_boundary_type), target :: Land_ice_boundary + type(ice_ocean_boundary_type), target :: Ice_ocean_boundary + type(ocean_ice_boundary_type), target :: Ocean_ice_boundary + type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() type(FmsTime_type) :: Time type(FmsTime_type) :: Time_step_atmos, Time_step_cpld @@ -362,18 +363,17 @@ program coupler_main integer :: num_atmos_calls, na integer :: num_cpld_calls, nc + integer :: current_timestep type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() - type(FmsTime_type) :: Time_restart, Time_start, Time_end - type(FmsTime_type) :: Time_restart_current - character(len=32) :: timestamp + type(FmsTime_type) :: Time_restart, Time_start, Time_end, Time_restart_current - type(coupler_clock_type) :: coupler_clocks + type(coupler_clock_type) :: coupler_clocks + type(coupler_components_type), target :: coupler_components_obj + type(coupler_chksum_type) :: coupler_chksum_obj - integer :: outunit - character(len=80) :: text integer, allocatable :: ensemble_pelist(:, :) integer, allocatable :: slow_ice_ocean_pelist(:) integer :: conc_nthreads = 1 @@ -415,7 +415,7 @@ program coupler_main call fms_mpp_init() - !these clocks are on the global pelist + !>these clocks are on the global pelist coupler_clocks%initialization = fms_mpp_clock_id( 'Initialization' ) call fms_mpp_clock_begin(coupler_clocks%initialization) @@ -426,42 +426,39 @@ program coupler_main call coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, & - conc_nthreads, coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & - num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) + conc_nthreads, coupler_clocks, coupler_components_obj, coupler_chksum_obj, & + Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, & + num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) - if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) + if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('coupler_init+', 0) call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization - - call fms_mpp_clock_begin(coupler_clocks%main) !begin main loop + call fms_mpp_clock_begin(coupler_clocks%main) !begin main loop !----------------------------------------------------------------------- -!------ ocean/slow-ice integration loop ------ +!> ocean/slow-ice integration loop if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & coupler_clocks, init_stocks=.True.) - do nc = 1, num_cpld_calls + !> ocean/slow-ice integration loop + coupled_timestep_loop : do nc = 1, num_cpld_calls if (do_chksum) then - call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice) - call coupler_atmos_ice_land_ocean_chksum('MAIN_LOOP-', nc, Atm, Land, Ice,& - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & - Ocean, Ice_ocean_boundary) + call coupler_chksum_obj%get_coupler_chksums('top_of_coupled_loop+', nc) + call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('MAIN_LOOP-', nc) end if - ! Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication - ! points when running concurrently. The calls are placed next to each other in - ! concurrent mode to avoid multiple synchronizations within the main loop. - ! With concurrent_ice, these only occur on the ocean PEs. + !> Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication + !! points when running concurrently. The calls are placed next to each other in + !! concurrent mode to avoid multiple synchronizations within the main loop. + !! With concurrent_ice, these only occur on the ocean PEs. if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then - - !Redistribute quantities from Ocean to Ocean_ice_boundary + !> Redistribute quantities from Ocean to Ocean_ice_boundary call coupler_flux_ocean_to_ice(Ocean, Ice, Ocean_ice_boundary, coupler_clocks, slow_ice_ocean_pelist) Time_flux_ocean_to_ice = Time - - ! Update Ice_ocean_boundary; the first iteration is supplied by restarts + !> Update Ice_ocean_boundary; the first iteration is supplied by restarts if(use_lag_fluxes) then call coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks) Time_flux_ice_to_ocean = Time @@ -469,67 +466,55 @@ program coupler_main end if if (do_chksum) then - call coupler_chksum('flux_ocn2ice+', nc, Atm, Land, Ice) - call coupler_atmos_ice_land_ocean_chksum('flux_ocn2ice+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & - Ocean, Ice_ocean_boundary) + call coupler_chksum_obj%get_coupler_chksums('flux_ocn2ice+', nc) + call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('flux_ocn2ice+', nc) end if ! needs to sit here rather than at the end of the coupler loop. if (check_stocks > 0) call coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clocks) if (do_ice .and. Ice%pe) then - if (Ice%slow_ice_pe) & - call coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Ocean_ice_boundary, coupler_clocks) + if (Ice%slow_ice_pe) call coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Ocean_ice_boundary,& + coupler_clocks, coupler_chksum_obj) ! This could be a point where the model is serialized if the fast and ! slow ice are on different PEs. call fms_mpp_set_current_pelist(Ice%pelist) ! is called if(.not.Ice%shared_slow_fast_PEs) call coupler_exchange_slow_to_fast_ice(Ice, coupler_clocks) - - ! This call occurs all ice PEs. + !> This call occurs all ice PEs. if (concurrent_ice) call coupler_exchange_fast_to_slow_ice(Ice, coupler_clocks) - - ! call fms_mpp_set_current_pelist(Ice%pelist) is called if(.not.Ice%shared_slow_fast_PEs) + !> call fms_mpp_set_current_pelist(Ice%pelist) is called if(.not.Ice%shared_slow_fast_PEs) if (Ice%fast_ice_pe) call coupler_set_ice_surface_fields(Ice, coupler_clocks) endif - if (Atm%pe) then + atm_pe_block : if (Atm%pe) then if (.NOT.(do_ice.and.Ice%pe) .OR. (ice_npes.NE.atmos_npes)) call fms_mpp_set_current_pelist(Atm%pelist) - if(do_chksum) call atmos_ice_land_chksum('set_ice_surface+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if(do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('set_ice_surface+', nc) + !> begin atm_clock_1 call fms_mpp_clock_begin(coupler_clocks%atm) call coupler_generate_sfc_xgrid(Land, Ice, coupler_clocks) call send_ice_mask_sic(Time) !----------------------------------------------------------------------- - ! ------ atmos/fast-land/fast-ice integration loop ------- + !> atmos/fast-land/fast-ice integration loop call fms_mpp_clock_begin(coupler_clocks%atmos_loop) - do na = 1, num_atmos_calls - if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + fast_integration_loop : do na = 1, num_atmos_calls Time_atmos = Time_atmos + Time_step_atmos + current_timestep = (nc-1)*num_atmos_calls+na + + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('top_of_atmos_loop-', current_timestep) + + if (do_atmos) call coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) + + if (do_flux) call coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & + Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) - if (do_atmos) then - call fms_mpp_clock_begin(coupler_clocks%atmos_tracer_driver_gather_data) - call atmos_tracer_driver_gather_data(Atm%fields, Atm%tr_bot) - call fms_mpp_clock_end(coupler_clocks%atmos_tracer_driver_gather_data) - endif - - if (do_flux) then - call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) - call sfc_boundary_layer( REAL(dt_atmos), Time_atmos, & - Atm, Land, Ice, Land_ice_atmos_boundary ) - if (do_chksum) call atmos_ice_land_chksum('sfc+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) - endif !$OMP PARALLEL & !$OMP& NUM_THREADS(conc_nthreads) & @@ -539,7 +524,7 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(coupler_clocks) +!$OMP& SHARED(coupler_clocks, current_timestep, coupler_chksum_obj) !$ if (omp_get_thread_num() == 0) then !$OMP PARALLEL & !$OMP& NUM_THREADS(1) & @@ -549,96 +534,47 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(coupler_clocks) +!$OMP& SHARED(coupler_clocks, current_timestep, coupler_chksum_obj) !$ call omp_set_num_threads(atmos_nthreads) !$ dsec=omp_get_wtime() if (do_concurrent_radiation) call fms_mpp_clock_begin(coupler_clocks%concurrent_atmos) - ! ---- atmosphere dynamics ---- - if (do_atmos) then - call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) - call update_atmos_model_dynamics( Atm ) - call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) - endif - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', (nc-1)*num_atmos_calls+na, & - Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') - - ! ---- SERIAL atmosphere radiation ---- - if (.not.do_concurrent_radiation) then - call fms_mpp_clock_begin(coupler_clocks%serial_radiation) - call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(coupler_clocks%serial_radiation) - endif - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)', (nc-1)*num_atmos_calls+na, & - Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update serial rad') - - ! ---- atmosphere down ---- - if (do_atmos) then - call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_down) - call update_atmos_model_down( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(coupler_clocks%update_atmos_model_down) - endif - if (do_chksum) call atmos_ice_land_chksum('update_atmos_down+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update down') - - call fms_mpp_clock_begin(coupler_clocks%flux_down_from_atmos) - call flux_down_from_atmos( Time_atmos, Atm, Land, Ice, & - Land_ice_atmos_boundary, & - Atmos_land_boundary, & - Atmos_ice_boundary ) - call fms_mpp_clock_end(coupler_clocks%flux_down_from_atmos) - if (do_chksum) call atmos_ice_land_chksum('flux_down_from_atmos+', (nc-1)*num_atmos_calls+na, Atm, Land, & - Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - - ! -------------------------------------------------------------- - ! ---- land model ---- - call fms_mpp_clock_begin(coupler_clocks%update_land_model_fast) - if (do_land .AND. land%pe) then - if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) - call update_land_model_fast( Atmos_land_boundary, Land ) - endif - if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(coupler_clocks%update_land_model_fast) - if (do_chksum) call atmos_ice_land_chksum('update_land_fast+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update land') - - ! ---- ice model ---- - call fms_mpp_clock_begin(coupler_clocks%update_ice_model_fast) - if (do_ice .AND. Ice%fast_ice_pe) then - if (ice_npes .NE. atmos_npes)call fms_mpp_set_current_pelist(Ice%fast_pelist) - call update_ice_model_fast( Atmos_ice_boundary, Ice ) - endif - if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(coupler_clocks%update_ice_model_fast) - if (do_chksum) call atmos_ice_land_chksum('update_ice_fast+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') - - ! -------------------------------------------------------------- - ! ---- atmosphere up ---- - call fms_mpp_clock_begin(coupler_clocks%flux_up_to_atmos) - call flux_up_to_atmos( Time_atmos, Land, Ice, Land_ice_atmos_boundary, & - Atmos_land_boundary, Atmos_ice_boundary ) - call fms_mpp_clock_end(coupler_clocks%flux_up_to_atmos) - if (do_chksum) call atmos_ice_land_chksum('flux_up2atmos+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - - call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_up) - if (do_atmos) & - call update_atmos_model_up( Land_ice_atmos_boundary, Atm) - call fms_mpp_clock_end(coupler_clocks%update_atmos_model_up) - if (do_chksum) call atmos_ice_land_chksum('update_atmos_up+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update up') - - call flux_atmos_to_ocean(Time_atmos, Atm, Atmos_ice_boundary, Ice) - - call flux_ex_arrays_dealloc + !> atmosphere dynamics + if (do_atmos) call coupler_update_atmos_model_dynamics(Atm, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + !> SERIAL atmosphere radiation + if (.not.do_concurrent_radiation) call coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, & + coupler_clocks, current_timestep, coupler_chksum_obj) + + !> atmosphere down + if (do_atmos) call coupler_update_atmos_model_down(Atm, Land_ice_atmos_boundary, & + current_timestep, coupler_chksum_obj, coupler_clocks) + + !> checksums are computed if do_chksum=.True. + call coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, & + Atmos_ice_boundary, Time_atmos, current_timestep, coupler_clocks, coupler_chksum_obj) + + !-------------------------------------------------------------- + + !> land model + if (do_land .AND. land%pe) call coupler_update_land_model_fast(Land, Atmos_land_boundary, Atm%pelist, & + current_timestep, coupler_chksum_obj, coupler_clocks) + + !> ice model + if (do_ice .AND. Ice%fast_ice_pe) call coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, Atm%pelist, & + current_timestep, coupler_chksum_obj, coupler_clocks) + + !-------------------------------------------------------------- + !> atmosphere up + call coupler_flux_up_to_atmos(Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary,& + Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) + + if (do_atmos) call coupler_update_atmos_model_up(Atm, Land_ice_atmos_boundary, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + call coupler_flux_atmos_to_ocean(Atm, Atmos_ice_boundary, Ice, Time_atmos) !-------------- if (do_concurrent_radiation) call fms_mpp_clock_end(coupler_clocks%concurrent_atmos) @@ -652,21 +588,13 @@ program coupler_main !$OMP& NUM_THREADS(1) & !$OMP& DEFAULT(NONE) & !$OMP& PRIVATE(dsec) & -!$OMP& SHARED(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Ocean_ice_boundary, Atmos_land_boundary) & +!$OMP& SHARED(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Ocean_ice_boundary,Atmos_land_boundary)& !$OMP& SHARED(do_chksum, do_debug, omp_sec, num_atmos_calls, na, radiation_nthreads) & !$OMP& SHARED(coupler_clocks) !$ call omp_set_num_threads(radiation_nthreads) !$ dsec=omp_get_wtime() - - call fms_mpp_clock_begin(coupler_clocks%concurrent_radiation) - call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(coupler_clocks%concurrent_radiation) + call coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, coupler_clocks) !$ omp_sec(2) = omp_sec(2) + (omp_get_wtime() - dsec) -!---CANNOT PUT AN MPP_CHKSUM HERE AS IT REQUIRES THE ABILITY TO HAVE TWO DIFFERENT OPENMP THREADS -!---INSIDE OF MPI AT THE SAME TIME WHICH IS NOT CURRENTLY ALLOWED -! if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(conc)', (nc-1)*num_atmos_calls+na, & -! Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update concurrent rad') !$OMP END PARALLEL endif !$ endif @@ -676,91 +604,61 @@ program coupler_main !$ if (do_concurrent_radiation) imb_sec(2) = imb_sec(2) + omp_get_wtime() !$ call omp_set_num_threads(atmos_nthreads+(conc_nthreads-1)*radiation_nthreads) - call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) - call update_atmos_model_state( Atm ) - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_state+', (nc-1)*num_atmos_calls+na, Atm, Land, & - Ice,Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update state') - call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) + call coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksum_obj, coupler_clocks ) - enddo ! end of na (fast loop) + enddo fast_integration_loop ! end of na (fast loop) call fms_mpp_clock_end(coupler_clocks%atmos_loop) + !> end of atmospheric time step loop - call fms_mpp_clock_begin(coupler_clocks%update_land_model_slow) - ! ------ end of atmospheric time step loop ----- - if (do_land .AND. Land%pe) then - if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) - call update_land_model_slow(Atmos_land_boundary,Land) - endif - if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) - !----------------------------------------------------------------------- - call fms_mpp_clock_end(coupler_clocks%update_land_model_slow) - if (do_chksum) call atmos_ice_land_chksum('update_land_slow+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - - ! - ! need flux call to put runoff and p_surf on ice grid - ! - call fms_mpp_clock_begin(coupler_clocks%flux_land_to_ice) - call flux_land_to_ice( Time, Land, Ice, Land_ice_boundary ) - call fms_mpp_clock_end(coupler_clocks%flux_land_to_ice) - if (do_chksum) call atmos_ice_land_chksum('fluxlnd2ice+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - - Atmos_ice_boundary%p = 0.0 ! call flux_atmos_to_ice_slow ? - Time = Time_atmos - call fms_mpp_clock_end(coupler_clocks%atm) - endif !Atm%pe block - - if(Atm%pe) then - call fms_mpp_clock_begin(coupler_clocks%atm) !Ice is still using ATM pelist and need to be included in ATM clock - !ATM clock is used for load-balancing the coupled models - endif - if (do_ice .and. Ice%pe) then + !> update_land_mode_slow occurs from LAND%PE + if (do_land) call coupler_update_land_model_slow(Land, Atmos_land_boundary, & + Atm%pelist, current_timestep, coupler_chksum_obj, coupler_clocks) - if (Ice%fast_ice_PE) then - if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Ice%fast_pelist) - call fms_mpp_clock_begin(coupler_clocks%update_ice_model_slow_fast) - ! These two calls occur on whichever PEs handle the fast ice processess. - call ice_model_fast_cleanup(Ice) + !> need flux call to put runoff and p_surf on ice grid + call coupler_flux_land_to_ice(Land, Ice, Land_ice_boundary, Time, current_timestep, & + coupler_chksum_obj, coupler_clocks) - call unpack_land_ice_boundary(Ice, Land_ice_boundary) - call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_fast) - endif + !> call flux_atmos_to_ice_slow ? + Atmos_ice_boundary%p = 0.0 - ! This could be a point where the model is serialized; This calls on all ice PEs - if (.not.concurrent_ice) call coupler_exchange_fast_to_slow_ice(Ice, coupler_clocks, & - set_ice_current_pelist=.True.) - - ! ------ slow-ice model ------ + Time = Time_atmos - ! This call occurs on whichever PEs handle the slow ice processess. - if (Ice%slow_ice_PE .and. .not.combined_ice_and_ocean) then - if (slow_ice_with_ocean) call fms_mpp_set_current_pelist(Ice%slow_pelist) - call fms_mpp_clock_begin(coupler_clocks%update_ice_model_slow_slow) - call update_ice_model_slow(Ice) + !> end atm_clock_1 + call fms_mpp_clock_end(coupler_clocks%atm) - call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean_stocks) - call flux_ice_to_ocean_stocks(Ice) - call fms_mpp_clock_end(coupler_clocks%flux_ice_to_ocean_stocks) - call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_slow) - endif + endif atm_pe_block - if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, Ice, Ocean_ice_boundary) - endif ! End of Ice%pe block + !> Ice is still using ATM pelist and need to be included in ATM clock + !> ATM clock is used for load-balancing the coupled models + start_atm_clock2: if(Atm%pe) then + call fms_mpp_clock_begin(coupler_clocks%atm) + end if start_atm_clock2 - if(Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call fms_mpp_clock_end(coupler_clocks%atm) - endif + if (do_ice .and. Ice%pe) then + if (Ice%fast_ice_PE) call coupler_unpack_land_ice_boundary(Ice, Land_ice_boundary, coupler_clocks) + !> This could be a point where the model is serialized; This calls on all ice PEs + if (.not.concurrent_ice) call coupler_exchange_fast_to_slow_ice(Ice, coupler_clocks, & + set_ice_current_pelist=.True.) + !> slow-ice model + !! This call occurs on whichever PEs handle the slow ice processess. + if (Ice%slow_ice_PE .and. .not.combined_ice_and_ocean) & + call coupler_update_ice_model_slow_and_stocks(Ice, coupler_clocks) + if (do_chksum) call coupler_chksum_obj%get_slow_ice_chksums('update_ice_slow+', nc) + endif ! End of Ice%pe block + + end_atm_clock2: if(Atm%pe) then + call fms_mpp_set_current_pelist(Atm%pelist) + call fms_mpp_clock_end(coupler_clocks%atm) + endif end_atm_clock2 ! Update Ice_ocean_boundary using the newly calculated fluxes. if ((concurrent_ice .or. .not.use_lag_fluxes) .and. .not.combined_ice_and_ocean) then !this could serialize unless slow_ice_with_ocean is true. if ((.not.do_ice) .or. (.not.slow_ice_with_ocean)) call fms_mpp_set_current_pelist() - call coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks, & - slow_ice_ocean_pelist=slow_ice_ocean_pelist, set_current_slow_ice_ocean_pelist=.True.) + if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) & + call coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks, & + slow_ice_ocean_pelist=slow_ice_ocean_pelist, set_current_slow_ice_ocean_pelist=.True.) Time_flux_ice_to_ocean = Time endif @@ -774,17 +672,14 @@ program coupler_main if (combined_ice_and_ocean) then call flux_ice_to_ocean_stocks(Ice) call update_slow_ice_and_ocean(ice_ocean_driver_CS, Ice, Ocean_state, Ocean, & - Ice_ocean_boundary, Time_ocean, Time_step_cpld ) + Ice_ocean_boundary, Time_ocean, Time_step_cpld ) else - if (do_chksum) call ocean_chksum('update_ocean_model-', nc, Ocean, Ice_ocean_boundary) - ! update_ocean_model since fluxes don't change here - - if (do_ocean) & - call update_ocean_model( Ice_ocean_boundary, Ocean_state, Ocean, & - Time_ocean, Time_step_cpld ) - endif + if (do_chksum) call coupler_chksum_obj%get_ocean_chksums('update_ocean_model-', nc) + ! update_ocean_model since fluxes don't change here + if (do_ocean) call coupler_update_ocean_model(Ocean, Ocean_state, Ice_ocean_boundary,& + Time_ocean, Time_step_cpld, nc, coupler_chksum_obj) + end if - if (do_chksum) call ocean_chksum('update_ocean_model+', nc, Ocean, Ice_ocean_boundary) ! Get stocks from "Ice_ocean_boundary" and add them to Ocean stocks. ! This call is just for record keeping of stocks transfer and ! does not modify either Ocean or Ice_ocean_boundary @@ -797,58 +692,30 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%ocean) endif - !--- write out intermediate restart file when needed. - if (Time >= Time_restart) then - Time_restart_current = Time - Time_restart = fms_time_manager_increment_date(Time, restart_interval(1), restart_interval(2), & - restart_interval(3), restart_interval(4), restart_interval(5), restart_interval(6) ) - timestamp = fms_time_manager_date_to_string(time_restart_current) - outunit= fms_mpp_stdout() - write(outunit,*) '=> NOTE from program coupler: intermediate restart file is written and ', & - trim(timestamp),' is appended as prefix to each restart file name' - if (Atm%pe) then - call atmos_model_restart(Atm, timestamp) - call land_model_restart(timestamp) - call ice_model_restart(Ice, timestamp) - endif - if (Ocean%is_ocean_pe) then - call ocean_model_restart(Ocean_state, timestamp) - endif - call coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & - Time, Time_restart_current, Time_start, Time_end, timestamp) - endif + !> write out intermediate restart file when needead. + if (Time >= Time_restart) & + call coupler_intermediate_restart(Atm, Ice, Ocean, Ocean_state, Ocn_bc_restart, Ice_bc_restart, & + Time, Time_restart, Time_restart_current, Time_start) + + call coupler_summarize_timestep(nc, num_cpld_calls, coupler_chksum_obj, Atm%pe, omp_sec, imb_sec) - !-------------- - if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc, Atm, Land, Ice) - write( text,'(a,i6)' )'Main loop at coupling timestep=', nc - call fms_memutils_print_memuse_stats(text) - outunit= fms_mpp_stdout() - if (fms_mpp_pe() == fms_mpp_root_pe() .and. Atm%pe .and. do_concurrent_radiation) then - write(outunit,102) 'At coupling step ', nc,' of ',num_cpld_calls, & - ' Atm & Rad (imbalance): ',omp_sec(1),' (',imb_sec(1),') ',omp_sec(2),' (',imb_sec(2),')' - endif omp_sec(:)=0. imb_sec(:)=0. - call flush(outunit) - enddo -102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) + enddo coupled_timestep_loop + !----------------------------------------------------------------------- if( check_stocks >=0 ) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & coupler_clocks, finish_stocks=.True.) - !----------------------------------------------------------------------- + call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%main) - call fms_mpp_clock_begin(coupler_clocks%termination) - if (do_chksum) call coupler_chksum('coupler_end-', nc, Atm, Land, Ice) call coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & - Time, Time_start, Time_end, Time_restart_current) - - call fms_mpp_clock_end(coupler_clocks%termination) + nc, Time, Time_start, Time_end, Time_restart_current, coupler_chksum_obj, coupler_clocks) - call fms_memutils_print_memuse_stats( 'Memory HiWaterMark', always=.TRUE. ) + call fms_memutils_print_memuse_stats( 'Memory HiWaterMark', always=.True. ) call fms_end !----------------------------------------------------------------------- diff --git a/full/earth_system_model.pdf b/full/earth_system_model.pdf index 3aa2e3e2..562b712d 100644 Binary files a/full/earth_system_model.pdf and b/full/earth_system_model.pdf differ diff --git a/full/flux_exchange.F90 b/full/flux_exchange.F90 index e7f07b59..d3d9ea72 100644 --- a/full/flux_exchange.F90 +++ b/full/flux_exchange.F90 @@ -349,17 +349,17 @@ !! ~~~~~~~~~~{.f90} !! type (surf_diff_type) :: Atm%Surf_Diff !! -!! real, dimension(:,:) :: Atm%Surf_Diff%dtmass & ! dt/mass where dt = atmospheric time step ((i+1) = (i-1) for leapfrog) (s) +!! real, dimension(:,:) :: Atm%Surf_Diff%dtmass & !dt/mass where dt=atmospheric time step ((i+1)=(i-1) for leapfrog)(s) !! ! mass = mass per unit area of lowest atmosphehic layer (Kg/m2)) !! Atm%Surf_Diff%delta_t & ! increment ((i+1) = (i-1) for leapfrog) in temperature of !! ! lowest atmospheric layer (K) !! Atm%Surf_Diff%delta_q & ! increment ((i+1) = (i-1) for leapfrog) in specific humidity of !! ! lowest atmospheric layer (nondimensional -- Kg/Kg) -!! Atm%Surf_Diff%dflux_t & ! derivative of implicit part of downward temperature flux at top of lowest -!! ! atmospheric layer with respect to temperature +!! Atm%Surf_Diff%dflux_t & ! derivative of implicit part of downward temperature flux at top of +!! ! lowestatmospheric layer with respect to temperature !! ! of lowest atmospheric layer (Kg/(m2 s)) -!! Atm%Surf_Diff%dflux_q ! derivative of implicit part of downward moisture flux at top of lowest -!! ! atmospheric layer with respect to specific humidity of +!! Atm%Surf_Diff%dflux_q ! derivative of implicit part of downward moisture flux at top of +!! ! lowest atmospheric layer with respect to specific humidity of !! ! of lowest atmospheric layer (Kg/(m2 s)) !! ~~~~~~~~~~ !! @@ -551,7 +551,8 @@ module flux_exchange_mod real, parameter :: d622 = rdgas/rvgas real, parameter :: d378 = 1.0-d622 - real :: z_ref_heat = 2. !< Reference height (meters) for temperature and relative humidity diagnostics (t_ref, rh_ref, del_h, del_q) + real :: z_ref_heat = 2. !< Reference height (meters) for temperature and relative humidity diagnostics + !! (t_ref, rh_ref, del_h, del_q) real :: z_ref_mom = 10. !< Reference height (meters) for mementum diagnostics (u_ref, v_ref, del_m) logical :: do_area_weighted_flux = .FALSE. logical :: debug_stocks = .FALSE. @@ -560,8 +561,8 @@ module flux_exchange_mod logical :: do_forecast = .false. integer :: nblocks = 1 - logical :: partition_fprec_from_lprec = .FALSE. !< option for ATM override experiments where liquid+frozen precip are combined - !! This option will convert liquid precip to snow when t_ref is less than + logical :: partition_fprec_from_lprec = .FALSE. !< option for ATM override experiments where liquid+frozen precip are + !! combined. This option will convert liquid precip to snow when t_ref is less than !! tfreeze parameter real, parameter :: tfreeze = 273.15 logical :: scale_precip_2d = .false. @@ -661,12 +662,17 @@ subroutine flux_exchange_init ( Time, Atm, Land, Ice, Ocean, Ocean_state,& ! COMPLETELY allocated here and in subroutines called from here; ! NO pointer components should have been allocated before entry if the ! derived type has intent(OUT) otherwise they may be lost. - type(atmos_ice_boundary_type), intent(inout) :: atmos_ice_boundary !< A derived data type to specify properties and fluxes passed from atmosphere to ice - type(land_ice_atmos_boundary_type),intent(inout) :: land_ice_atmos_boundary !< A derived data type to specify properties and fluxes passed from exchange grid to - !! the atmosphere, land and ice - type(land_ice_boundary_type), intent(inout) :: land_ice_boundary !< A derived data type to specify properties and fluxes passed from land to ice - type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< A derived data type to specify properties and fluxes passed from ice to ocean - type(ocean_ice_boundary_type), intent(inout) :: ocean_ice_boundary !< A derived data type to specify properties and fluxes passed from ocean to ice + type(atmos_ice_boundary_type), intent(inout) :: atmos_ice_boundary !< A derived data type to specify properties + !! and fluxes passed from atmosphere to ice + type(land_ice_atmos_boundary_type),intent(inout) :: land_ice_atmos_boundary !< A derived data type to specify + !! properties and fluxes passed from exchange grid to + !! the atmosphere, land and ice + type(land_ice_boundary_type), intent(inout) :: land_ice_boundary !< A derived data type to specify properties + !! and fluxes passed from land to ice + type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< A derived data type to specify properties + !! and fluxes passed from ice to ocean + type(ocean_ice_boundary_type), intent(inout) :: ocean_ice_boundary !< A derived data type to specify properties + !! and fluxes passed from ocean to ice logical, intent(in) :: do_ocean integer, dimension(:), intent(in) :: slow_ice_ocean_pelist integer, optional, intent(in) :: dt_atmos !< Atmosphere time step in seconds @@ -745,7 +751,7 @@ subroutine flux_exchange_init ( Time, Atm, Land, Ice, Ocean, Ocean_state,& call fms_mpp_set_current_pelist() call ice_ocean_flux_exchange_init(Time, Ice, Ocean, Ocean_state,ice_ocean_boundary, ocean_ice_boundary, & - Dt_cpl, debug_stocks, do_area_weighted_flux, ex_gas_fields_ice, ex_gas_fluxes, do_ocean, slow_ice_ocean_pelist ) + Dt_cpl, debug_stocks, do_area_weighted_flux, ex_gas_fields_ice, ex_gas_fluxes, do_ocean, slow_ice_ocean_pelist) !---- done ---- do_init = .false. @@ -1023,7 +1029,8 @@ subroutine check_atm_grid(Atm, grid_file) end do deallocate(tmpx, tmpy) else - call fms_mpp_error(FATAL, 'atm_land_ice_flux_exchange_mod: both AREA_ATMxOCN and ocn_mosaic_file does not exist in '//trim(grid_file)) + call fms_mpp_error(FATAL, & + 'atm_land_ice_flux_exchange_mod: both AREA_ATMxOCN and ocn_mosaic_file does not exist in '//trim(grid_file)) end if call fms2_io_close_file(grid_file_obj) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index b5837e72..4f8d294d 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -96,20 +96,10 @@ module full_coupler_mod public :: land_ice_boundary_type, ice_ocean_boundary_type, ocean_ice_boundary_type, ice_ocean_driver_type public :: fmsconstants_init - public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up - public :: update_atmos_model_radiation, update_atmos_model_state - public :: update_land_model_fast, update_land_model_slow - public :: update_ice_model_fast, set_ice_surface_fields - public :: ice_model_fast_cleanup, unpack_land_ice_boundary - public :: update_ice_model_slow - public :: update_ocean_model, update_slow_ice_and_ocean - public :: sfc_boundary_layer, send_ice_mask_sic - public :: flux_down_from_atmos, flux_up_to_atmos - public :: flux_land_to_ice - public :: flux_ice_to_ocean_finish - public :: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks - public :: flux_atmos_to_ocean, flux_ex_arrays_dealloc - public :: atmos_tracer_driver_gather_data + + public :: update_slow_ice_and_ocean + public :: send_ice_mask_sic + public :: flux_ice_to_ocean_finish, flux_ice_to_ocean_stocks, flux_ocean_from_ice_stocks public :: atmos_model_restart, land_model_restart, ice_model_restart, ocean_model_restart @@ -120,20 +110,27 @@ module full_coupler_mod public :: atm_ice_bnd_type_chksum, lnd_ice_bnd_type_chksum public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum - public :: coupler_init, coupler_end, coupler_restart - public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum - - public :: coupler_atmos_ice_land_ocean_chksum + public :: coupler_init, coupler_end, coupler_restart, coupler_intermediate_restart + public :: coupler_summarize_timestep public :: coupler_flux_init_finish_stocks, coupler_flux_check_stocks - public :: coupler_flux_ocean_to_ice, coupler_flux_ice_to_ocean - - public :: coupler_unpack_ocean_ice_boundary, coupler_exchange_slow_to_fast_ice, & - coupler_exchange_fast_to_slow_ice, coupler_set_ice_surface_fields + public :: coupler_flux_ocean_to_ice + public :: coupler_unpack_ocean_ice_boundary, coupler_exchange_slow_to_fast_ice + public :: coupler_exchange_fast_to_slow_ice, coupler_set_ice_surface_fields public :: coupler_generate_sfc_xgrid + public :: coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer + public :: coupler_update_atmos_model_dynamics, coupler_update_atmos_model_down + public :: coupler_update_atmos_model_radiation, coupler_flux_down_from_atmos + public :: coupler_update_land_model_fast, coupler_update_ice_model_fast + public :: coupler_flux_up_to_atmos, coupler_update_atmos_model_up + public :: coupler_flux_atmos_to_ocean, coupler_update_atmos_model_state + + public :: coupler_update_land_model_slow, coupler_flux_land_to_ice + public :: coupler_unpack_land_ice_boundary, coupler_flux_ice_to_ocean + public :: coupler_update_ice_model_slow_and_stocks, coupler_update_ocean_model - public :: coupler_clock_type + public :: coupler_clock_type, coupler_components_type, coupler_chksum_type #include @@ -246,14 +243,13 @@ module full_coupler_mod integer :: atmos_tracer_driver_gather_data integer :: sfc_boundary_layer integer :: update_atmos_model_dynamics - integer :: serial_radiation integer :: update_atmos_model_down integer :: flux_down_from_atmos integer :: update_land_model_fast integer :: update_ice_model_fast integer :: flux_up_to_atmos integer :: update_atmos_model_up - integer :: concurrent_radiation + integer :: radiation integer :: concurrent_atmos integer :: update_atmos_model_state integer :: update_land_model_slow @@ -277,6 +273,39 @@ module full_coupler_mod integer :: flux_exchange_init end type coupler_clock_type + type coupler_components_type + private + type(atmos_data_type), pointer :: Atm !< pointer to Atm + type(land_data_type), pointer :: Land !< pointer to Land + type(ice_data_type), pointer :: Ice !< pointer to Ice + type(ocean_public_type), pointer :: Ocean !< pointer to Ocean + type(land_ice_atmos_boundary_type), pointer :: Land_ice_atmos_boundary !< pointer to Land_ice_atmos_boundary + type(atmos_land_boundary_type), pointer :: Atmos_land_boundary !< pointer to Atmos_land_boundary + type(atmos_ice_boundary_type), pointer :: Atmos_ice_boundary !< pointer to Atmos_ice_boundary + type(land_ice_boundary_type), pointer :: Land_ice_boundary !< pointer to Land_ice_boundary + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary !< pointer to Ice_ocean_boundary + type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary !< pointer to Ocean_ice_boundary + contains + procedure, public :: initialize_coupler_components_obj + procedure, public :: get_component !< subroutine to retrieve the requested component of an object of this type + end type coupler_components_type + + !> The purpose of objects of coupler_chksum_type is to simplify the list + !! of arguments required for chksum related subroutines in full_coupler_mod. + !! The members of this type point to the model components + type coupler_chksum_type + private + type(coupler_components_type), pointer :: components + contains + procedure, public :: initialize_coupler_chksum_obj !< associates the pointers above to model components + procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type + procedure, public :: get_atmos_ice_land_ocean_chksums !< subroutine to compute chksums for atmos - ocean + procedure, public :: get_atmos_ice_land_chksums !< subroutine to compute chksums for atmos_ice_land + procedure, public :: get_slow_ice_chksums !< subroutine to compute chskums for slow_ice + procedure, public :: get_ocean_chksums !< subroutine to compute chksums for ocean + procedure, public :: get_coupler_chksums !< subroutine to compute chksums for select fields + end type coupler_chksum_type + character(len=80) :: text character(len=48), parameter :: mod_name = 'coupler_main_mod' @@ -293,8 +322,8 @@ module full_coupler_mod subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & - coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & - num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) + coupler_clocks, coupler_components_obj, coupler_chksum_obj, Time_step_cpld, Time_step_atmos, Time_atmos, & + Time_ocean, num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) implicit none @@ -316,7 +345,9 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer, allocatable, dimension(:,:), intent(inout) :: ensemble_pelist integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist - type(coupler_clock_type) :: coupler_clocks + type(coupler_clock_type), intent(inout) :: coupler_clocks + type(coupler_components_type), intent(inout) :: coupler_components_obj + type(coupler_chksum_type), intent(inout) :: coupler_chksum_obj type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart, Time_restart_current @@ -1042,7 +1073,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & num_ice_bc_restart, Ice%slow_domain_NH, to_read=.true., ocean_restart=.false., directory="INPUT/") - ! Restore the fields from the restart files + ! Restore the fields from the restart files do l = 1, num_ice_bc_restart if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_read_restart(Ice_bc_restart(l)) enddo @@ -1052,7 +1083,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, test_by_field=.true.) do l = 1, num_ice_bc_restart - if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_close_file(Ice_bc_restart(l)) + if(fms2_io_check_if_open(Ice_bc_restart(l))) call fms2_io_close_file(Ice_bc_restart(l)) enddo endif !< ( Ice%slow_ice_pe ) @@ -1091,12 +1122,19 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, CALL fms_diag_grid_end() !----------------------------------------------------------------------- + + !> Initialize coupler_components_obj memebers to point to model components + call coupler_components_obj%initialize_coupler_components_obj(Atm, Land, Ice, Ocean, Land_ice_atmos_boundary,& + Atmos_land_boundary, Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) + + !> Initialize coupler_chksum_obj + call coupler_chksum_obj%initialize_coupler_chksum_obj(coupler_components_obj) + if ( do_endpoint_chksum ) then - call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('coupler_init+', 0) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) + call coupler_chksum_obj%get_slow_ice_chksums('coupler_init+', 0) end if end if @@ -1108,45 +1146,140 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, write(errunit,*) 'Exiting coupler_init at '& //trim(walldate)//' '//trim(walltime) endif + end subroutine coupler_init !####################################################################### - subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& - Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & - Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current) + !> This subroutine associates the pointer in an object of coupler_components_type to the model components + subroutine initialize_coupler_components_obj(this, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, & + Atmos_land_boundary, Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) implicit none + class(coupler_components_type), intent(inout) :: this !< self + type(atmos_data_type), target, intent(in) :: Atm !< Atm + type(land_data_type), target, intent(in) :: Land !< Land + type(ice_data_type), target, intent(in) :: Ice !< Ice + type(ocean_public_type), target, intent(in) :: Ocean !< Ocean + type(land_ice_atmos_boundary_type), target, intent(in) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(atmos_land_boundary_type), target, intent(in) :: Atmos_land_boundary !< Atmos_land_boundary + type(atmos_ice_boundary_type), target, intent(in) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(land_ice_boundary_type), target, intent(in) :: Land_ice_boundary !< Land_ice_boundary + type(ice_ocean_boundary_type), target, intent(in) :: Ice_ocean_boundary !< Ice_ocean_boundary + type(ocean_ice_boundary_type), target, intent(in) :: Ocean_ice_boundary !< Ocean_ice_boundary + + this%Atm => Atm + this%Land => Land + this%Ice => Ice + this%Ocean => Ocean + this%Land_ice_atmos_boundary => Land_ice_atmos_boundary + this%Atmos_land_boundary => Atmos_land_boundary + this%Atmos_ice_boundary => Atmos_ice_boundary + this%Land_ice_boundary => Land_ice_boundary + this%Ice_ocean_boundary => Ice_ocean_boundary + this%Ocean_ice_boundary => Ocean_ice_boundary + + end subroutine initialize_coupler_components_obj + + !> Function get_component returns the requested component in the coupler_components_type object + !! Users are required to provide the component to be retrieved as an input argument. For example, + !! coupler_components_obj%get_component(Atm) will return Atm = coupler_components_obj%Atm + subroutine get_component(this, retrieve_component ) - type(atmos_data_type), intent(inout) :: Atm - type(land_data_type), intent(inout) :: Land - type(ice_data_type), intent(inout) :: Ice - type(ocean_public_type), intent(inout) :: Ocean - type(ocean_state_type), pointer, intent(inout) :: Ocean_state - type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary - type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary - type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary - type(ocean_ice_boundary_type), intent(inout) :: Ocean_ice_boundary - type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ocn_bc_restart - type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart - - type(FmsTime_type), intent(in) :: Time, Time_start, Time_end, Time_restart_current - integer :: num_ice_bc_restart, num_ocn_bc_restart + implicit none + class(coupler_components_type), intent(in) :: this !< the coupler_components_type object + class(*), intent(out) :: retrieve_component !< requested component to be retrieve. + !! retrieve_component can be of type atmos_data_type, land_data_type, ice_data_type, + !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, + !! atmos_ice_boundary_type, land_ice_boundary_type, ice_ocean_boundary_type, + !! ocean_ice_boundary_type + + select type(retrieve_component) + type is(atmos_data_type) ; retrieve_component = this%Atm + type is(land_data_type) ; retrieve_component = this%Land + type is(ice_data_type) ; retrieve_component = this%Ice + type is(ocean_public_type) ; retrieve_component = this%Ocean + type is(land_ice_atmos_boundary_type) ; retrieve_component = this%Land_ice_atmos_boundary + type is(atmos_land_boundary_type) ; retrieve_component = this%Atmos_land_boundary + type is(atmos_ice_boundary_type) ; retrieve_component = this%Atmos_ice_boundary + type is(land_ice_boundary_type) ; retrieve_component = this%Land_ice_boundary + type is(ice_ocean_boundary_type) ; retrieve_component = this%Ice_ocean_boundary + type is(ocean_ice_boundary_type) ; retrieve_component = this%Ocean_ice_boundary + class default + call fms_mpp_error(FATAL, "failure retrieving component in coupler_components_type object, & + cannot recognize the type of requested component") + end select + + end subroutine get_component + + !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models + subroutine initialize_coupler_chksum_obj(this, components_obj) + + implicit none + class(coupler_chksum_type), intent(inout) :: this + type(coupler_components_type), intent(in), target :: components_obj + + this%components => components_obj + + end subroutine initialize_coupler_chksum_obj + + !> This subroutine retrieves coupler_chksum_obj%components_obj + subroutine get_components_obj(this, components_obj) + + implicit none + + class(coupler_chksum_type), intent(in) :: this !< coupler_chksum_type + type(coupler_components_type), intent(out) :: components_obj !< coupler_components_type to be returned + + components_obj = this%components + + end subroutine get_components_obj + + !> This subroutine finalizes the run including a final call to get_coupler_chksums if do_chksum = .True. + !! Coupler_restart is called for the final time. + subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& + Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & + Ice_bc_restart, current_timestep, Time_current, Time_start, Time_end, Time_restart_current,& + coupler_chksum_obj, coupler_clocks) + implicit none + + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_data_type), intent(inout) :: Land !< Land + type(ice_data_type), intent(inout) :: Ice !< Ice + type(ocean_public_type), intent(inout) :: Ocean !< Ocean + type(ocean_state_type), pointer, intent(inout) :: Ocean_state !< Ocean_state + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary ! \brief Writing restart file that contains running time and restart file writing time. subroutine coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & - Time_run, Time_res, Time_start, Time_end, time_stamp) + Time_current, Time_restart_current, Time_start, time_stamp) implicit none - type(atmos_data_type), intent(inout) :: Atm - type(ice_data_type), intent(inout) :: Ice - type(ocean_public_type), intent(inout) :: Ocean - - type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ocn_bc_restart - type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(ice_data_type), intent(inout) :: Ice !< Ice + type(ocean_public_type), intent(inout) :: Ocean !< Ocean - type(FmsTime_type), intent(in) :: Time_run, Time_res, Time_start, Time_end - character(len=*), intent(in), optional :: time_stamp + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ocn_bc_restart !< required for restarts + type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart !< required for restarts + type(FmsTime_type), intent(in) :: Time_current !< current model runtime (Time) + type(FmsTime_type), intent(in) :: Time_restart_current !< current restart time + type(FmsTime_type), intent(in) :: Time_start !< model start time + character(len=*), intent(in), optional :: time_stamp !< time_stamp for restart character(len=128) :: file_run, file_res @@ -1241,24 +1376,21 @@ subroutine coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & endif !----- compute current date ------ - call fms_time_manager_get_date (Time_run, date(1), date(2), date(3), & - date(4), date(5), date(6)) + call fms_time_manager_get_date (Time_current, date(1), date(2), date(3), date(4), date(5), date(6)) if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then open(newunit = restart_unit, file=file_run, status='replace', form='formatted') - write(restart_unit, '(i6,8x,a)' )calendar_type, & + write(restart_unit, '(i6,8x,a)' ) calendar_type, & '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - write(restart_unit, '(6i6,8x,a)' )date_init, & - 'Model start time: year, month, day, hour, minute, second' - write(restart_unit, '(6i6,8x,a)' )date, & - 'Current model time: year, month, day, hour, minute, second' + write(restart_unit, '(6i6,8x,a)' )date_init, 'Model start time: year, month, day, hour, minute, second' + write(restart_unit, '(6i6,8x,a)' )date, 'Current model time: year, month, day, hour, minute, second' close(restart_unit) endif - if (Time_res > Time_start) then + if (Time_restart_current > Time_start) then if ( fms_mpp_pe().EQ.fms_mpp_root_pe()) then open(newunit = restart_unit, file=file_res, status='replace', form='formatted') - call fms_time_manager_get_date(Time_res ,yr,mon,day,hr,min,sec) + call fms_time_manager_get_date(Time_restart_current, yr,mon,day,hr,min,sec) write(restart_unit, '(6i6,8x,a)' )yr,mon,day,hr,min,sec, & 'Current intermediate restart time: year, month, day, hour, minute, second' close(restart_unit) @@ -1285,13 +1417,13 @@ subroutine coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & if (associated(Ice_bc_restart)) deallocate(Ice_bc_restart) call fms_coupler_type_register_restarts(Ice%ocean_fluxes, Ice_bc_restart, & - num_ice_bc_restart, Ice%slow_domain_NH, to_read=.false., ocean_restart=.false., directory="RESTART/") + num_ice_bc_restart, Ice%slow_domain_NH, to_read=.false., ocean_restart=.false., directory="RESTART/") do n = 1, num_ice_bc_restart - if (fms2_io_check_if_open(Ice_bc_restart(n))) then - call fms2_io_write_restart(Ice_bc_restart(n)) - call add_domain_dimension_data(Ice_bc_restart(n)) - call fms2_io_close_file(Ice_bc_restart(n)) - endif + if (fms2_io_check_if_open(Ice_bc_restart(n))) then + call fms2_io_write_restart(Ice_bc_restart(n)) + call add_domain_dimension_data(Ice_bc_restart(n)) + call fms2_io_close_file(Ice_bc_restart(n)) + endif enddo endif !< (Atm%pe) @@ -1300,30 +1432,26 @@ end subroutine coupler_restart !-------------------------------------------------------------------------- !> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(id, timestep, Atm, Land, Ice) + subroutine get_coupler_chksums(this, id, timestep) implicit none - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep + class(coupler_chksum_type), intent(in) :: this !< self + character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout + integer , intent(in) :: timestep !< timestep type :: tracer_ind_type integer :: atm, ice, lnd ! indices of the tracer in the respective models end type tracer_ind_type - integer :: n_atm_tr, n_lnd_tr, n_exch_tr - integer :: n_atm_tr_tot, n_lnd_tr_tot - integer :: i, tr, n, m, outunit + + integer :: n_atm_tr, n_lnd_tr, n_exch_tr + integer :: n_atm_tr_tot, n_lnd_tr_tot + integer :: i, tr, n, m, outunit type(tracer_ind_type), allocatable :: tr_table(:) character(32) :: tr_name - call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, & - num_prog=n_atm_tr) - call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, & - num_prog=n_lnd_tr) + call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, num_prog=n_atm_tr) + call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, num_prog=n_lnd_tr) ! Assemble the table of tracer number translation by matching names of ! prognostic tracers in the atmosphere and surface models; skip all atmos. @@ -1342,56 +1470,55 @@ subroutine coupler_chksum(id, timestep, Atm, Land, Ice) 100 FORMAT("CHECKSUM::",A32," = ",Z20) 101 FORMAT("CHECKSUM::",A16,a,'%',a," = ",Z20) - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) + if (this%components%Atm%pe) then + call fms_mpp_set_current_pelist(this%components%Atm%pelist) outunit = fms_mpp_stdout() write(outunit,*) 'BEGIN CHECKSUM(Atm):: ', id, timestep - write(outunit,100) 'atm%t_bot', fms_mpp_chksum(atm%t_bot) - write(outunit,100) 'atm%z_bot', fms_mpp_chksum(atm%z_bot) - write(outunit,100) 'atm%p_bot', fms_mpp_chksum(atm%p_bot) - write(outunit,100) 'atm%u_bot', fms_mpp_chksum(atm%u_bot) - write(outunit,100) 'atm%v_bot', fms_mpp_chksum(atm%v_bot) - write(outunit,100) 'atm%p_surf', fms_mpp_chksum(atm%p_surf) - write(outunit,100) 'atm%gust', fms_mpp_chksum(atm%gust) + write(outunit,100) 'atm%t_bot', fms_mpp_chksum(this%components%Atm%t_bot) + write(outunit,100) 'atm%z_bot', fms_mpp_chksum(this%components%Atm%z_bot) + write(outunit,100) 'atm%p_bot', fms_mpp_chksum(this%components%Atm%p_bot) + write(outunit,100) 'atm%u_bot', fms_mpp_chksum(this%components%Atm%u_bot) + write(outunit,100) 'atm%v_bot', fms_mpp_chksum(this%components%Atm%v_bot) + write(outunit,100) 'atm%p_surf', fms_mpp_chksum(this%components%Atm%p_surf) + write(outunit,100) 'atm%gust', fms_mpp_chksum(this%components%Atm%gust) do tr = 1,n_exch_tr n = tr_table(tr)%atm if (n /= NO_TRACER) then call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) - write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(Atm%tr_bot(:,:,n)) - endif - enddo + write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(this%components%Atm%tr_bot(:,:,n)) + endif + enddo - write(outunit,100) 'land%t_surf', fms_mpp_chksum(land%t_surf) - write(outunit,100) 'land%t_ca', fms_mpp_chksum(land%t_ca) - write(outunit,100) 'land%rough_mom', fms_mpp_chksum(land%rough_mom) - write(outunit,100) 'land%rough_heat', fms_mpp_chksum(land%rough_heat) - write(outunit,100) 'land%rough_scale', fms_mpp_chksum(land%rough_scale) + write(outunit,100) 'land%t_surf', fms_mpp_chksum(this%components%Land%t_surf) + write(outunit,100) 'land%t_ca', fms_mpp_chksum(this%components%Land%t_ca) + write(outunit,100) 'land%rough_mom', fms_mpp_chksum(this%components%Land%rough_mom) + write(outunit,100) 'land%rough_heat', fms_mpp_chksum(this%components%Land%rough_heat) + write(outunit,100) 'land%rough_scale', fms_mpp_chksum(this%components%Land%rough_scale) do tr = 1,n_exch_tr n = tr_table(tr)%lnd if (n /= NO_TRACER) then call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) #ifndef _USE_LEGACY_LAND_ - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,n)) + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(this%components%Land%tr(:,:,n)) #else - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,:,n)) + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(this%components%Land%tr(:,:,:,n)) #endif endif enddo - write(outunit,100) 'ice%t_surf', fms_mpp_chksum(ice%t_surf) - write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(ice%rough_mom) - write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(ice%rough_heat) - write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(ice%rough_moist) + write(outunit,100) 'ice%t_surf', fms_mpp_chksum(this%components%Ice%t_surf) + write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(this%components%Ice%rough_mom) + write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(this%components%Ice%rough_heat) + write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(this%components%Ice%rough_moist) write(outunit,*) 'STOP CHECKSUM(Atm):: ', id, timestep !endif - !if (Ocean%is_ocean_pe) then - !call mpp_set_current_pelist(Ocean%pelist) + !if (Ocean%is_ocean_pe) call mpp_set_current_pelist(Ocean%pelist) write(outunit,*) 'BEGIN CHECKSUM(Ice):: ', id, timestep - call fms_coupler_type_write_chksums(Ice%ocean_fields, outunit, 'ice%') + call fms_coupler_type_write_chksums(this%components%Ice%ocean_fields, outunit, 'ice%') write(outunit,*) 'STOP CHECKSUM(Ice):: ', id, timestep endif @@ -1400,13 +1527,34 @@ subroutine coupler_chksum(id, timestep, Atm, Land, Ice) call fms_mpp_set_current_pelist() - end subroutine coupler_chksum + end subroutine get_coupler_chksums !####################################################################### +!> \brief This subroutine calls coupler_chksum as well as atmos_ice_land_chksum and ocean_chksum + subroutine get_atmos_ice_land_ocean_chksums(this, id, timestep) + + implicit none + + class(coupler_chksum_type), intent(in) :: this !< self + character(len=*), intent(in) :: id !< ID labelling the set of checksums + integer , intent(in) :: timestep !< timestep + + if (this%components%Atm%pe) then + call fms_mpp_set_current_pelist(this%components%Atm%pelist) + call this%get_atmos_ice_land_chksums(trim(id), timestep) + endif + if (this%components%Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(this%components%Ocean%pelist) + call this%get_ocean_chksums(trim(id), timestep) + endif + + call fms_mpp_set_current_pelist() + + end subroutine get_atmos_ice_land_ocean_chksums + !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. -!! !! For coupled models typically these types are not defined on all processors. !! It is assumed that the appropriate pelist has been set before entering this routine. !! This can be achieved in the following way. @@ -1422,40 +1570,32 @@ end subroutine coupler_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine atmos_ice_land_chksum(id, timestep, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, & - Atmos_land_boundary) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type (atmos_data_type), intent(in) :: Atm - type (land_data_type), intent(in) :: Land - type (ice_data_type), intent(in) :: Ice - type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary - type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary - - call atmos_data_type_chksum( id, timestep, Atm) - call lnd_ice_atm_bnd_type_chksum(id, timestep, Land_ice_atmos_boundary) - - if (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - call ice_data_type_chksum( id, timestep, Ice) - call atm_ice_bnd_type_chksum(id, timestep, Atmos_ice_boundary) + subroutine get_atmos_ice_land_chksums(this, id, timestep) + + class(coupler_chksum_type), intent(in) :: this !< self + character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout + integer , intent(in) :: timestep !< timestep + + call atmos_data_type_chksum( id, timestep, this%components%Atm) + call lnd_ice_atm_bnd_type_chksum(id, timestep, this%components%Land_ice_atmos_boundary) + + if (this%components%Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(this%components%Ice%fast_pelist) + call ice_data_type_chksum( id, timestep, this%components%Ice) + call atm_ice_bnd_type_chksum(id, timestep, this%components%Atmos_ice_boundary) endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - call land_data_type_chksum( id, timestep, Land) - call atm_lnd_bnd_type_chksum(id, timestep, Atmos_land_boundary) + if (this%components%Land%pe) then + call fms_mpp_set_current_pelist(this%components%Land%pelist) + call land_data_type_chksum( id, timestep, this%components%Land) + call atm_lnd_bnd_type_chksum(id, timestep, this%components%Atmos_land_boundary) endif - call fms_mpp_set_current_pelist(Atm%pelist) + call fms_mpp_set_current_pelist(this%components%Atm%pelist) - end subroutine atmos_ice_land_chksum + end subroutine get_atmos_ice_land_chksums !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. -!! !! For coupled models typically these types are not defined on all processors. !! It is assumed that the appropriate pelist has been set before entering this routine. !! This can be achieved in the following way. @@ -1471,22 +1611,20 @@ end subroutine atmos_ice_land_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine slow_ice_chksum(id, timestep, Ice, Ocean_ice_boundary) + subroutine get_slow_ice_chksums(this, id, timestep) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ice_data_type), intent(in) :: Ice - type(ocean_ice_boundary_type), intent(in) :: Ocean_ice_boundary + class(coupler_chksum_type), intent(in) :: this !< self + character(len=*), intent(in) :: id ! \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. -!! !! For coupled models typically these types are not defined on all processors. !! It is assumed that the appropriate pelist has been set before entering this routine. !! This can be achieved in the following way. @@ -1502,17 +1640,16 @@ end subroutine slow_ice_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) + subroutine get_ocean_chksums(this, id, timestep) - character(len=*), intent(in) :: id !< ID labelling the set of CHECKSUMS - integer , intent(in) :: timestep !< Timestep - type (ocean_public_type), intent(in) :: Ocean !< Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary ! \brief This subroutine sets the ID for clocks used in coupler_main subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist,& @@ -1575,7 +1712,7 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') if (.not. do_concurrent_radiation) & - coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + coupler_clocks%radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) @@ -1583,7 +1720,7 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) if (do_concurrent_radiation) then - coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + coupler_clocks%radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) endif coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') @@ -1617,41 +1754,9 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble end subroutine coupler_set_clock_ids -!> \brief This subroutine calls coupler_chksum as well as atmos_ice_land_chksum and ocean_chksum - subroutine coupler_atmos_ice_land_ocean_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boundary,& - Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary, Ocean_ice_boundary) - - implicit none - - character(len=*), intent(in) :: id !< ID labelling the set of checksums - integer , intent(in) :: timestep !< timestep - type(atmos_data_type), intent(in) :: Atm !< Atm - type(land_data_type), intent(in) :: Land !< Land - type(ice_data_type), intent(in) :: Ice !< Ice - type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary !< Atmos_ice_boundary - type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary !< Atmos_land_boundary - type(ocean_public_type), intent(in) :: Ocean !< Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary !< Ice_ocean_boundary - type(ocean_ice_boundary_type), intent(in), optional :: Ocean_ice_boundary !< Ocean_ice_boundary - - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum(trim(id), timestep, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum(trim(id), timestep, Ocean, Ice_ocean_boundary) - endif - - call fms_mpp_set_current_pelist() - - end subroutine coupler_atmos_ice_land_ocean_chksum - !> \brief This subroutine calls flux_init_stocks or does the final call to flux_check_stocks subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & - coupler_clocks, init_stocks, finish_stocks) + coupler_clocks, init_stocks, finish_stocks) implicit none @@ -1740,15 +1845,15 @@ end subroutine coupler_flux_ocean_to_ice !> \brief This subroutine calls flux_ocean_to_ice !! Clocks are set before and after call flux_ice_to_ocean. Current pelist is set when optional !! arguments are present and set_current_slow_ice_ocean_pelist=.True. - subroutine coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks,& + subroutine coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks, & slow_ice_ocean_pelist, set_current_slow_ice_ocean_pelist) implicit none type(ice_data_type), intent(inout) :: Ice !< Ice type(ocean_public_type), intent(inout) :: Ocean !< Ocean - type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary !< Ice_ocean_boundary - type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary !< Ice_ocean_boundary + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks integer, dimension(:), optional, intent(in) :: slow_ice_ocean_pelist !< slow_ice_ocean_pelist !> if true, will call mpp_set_current_pelist(slow_ice_ocean_pelist) logical, optional, intent(in) :: set_current_slow_ice_ocean_pelist @@ -1764,11 +1869,7 @@ subroutine coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clo ! Update Ice_ocean_boundary; the first iteration is supplied by restarts - if(set_current_slow_ice_ocean_pelist_in) then - if(.not.present(slow_ice_ocean_pelist)) call fms_mpp_error(FATAL, 'coupler_flux_ice_to_ocean tried& - &to set_current_pelist(slow_ice_ocean_pelist) but slow_ice_ocean_pelist is unknown') - call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) - end if + if(set_current_slow_ice_ocean_pelist_in) call fms_mpp_set_current_pelist(slow_ice_ocean_pelist) call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean) call flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary) @@ -1778,7 +1879,8 @@ end subroutine coupler_flux_ice_to_ocean !> \brief This subroutine calls flux_ocean_to_ice_finish and unpack_ocean_ice_boundary. !! Clocks and pelists are set before/after the calls. Checksum is computed if do_chksum=.True. - subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Ocean_ice_boundary, coupler_clocks) + subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Ocean_ice_boundary, coupler_clocks, & + coupler_chksum_obj) implicit none @@ -1787,6 +1889,7 @@ subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Oc type(ice_data_type), intent(inout) :: Ice !< Ice type(ocean_ice_boundary_type), intent(inout) :: Ocean_ice_boundary !< Ocean_ice_boundary type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj call fms_mpp_set_current_pelist(Ice%slow_pelist) call fms_mpp_clock_begin(coupler_clocks%set_ice_surface_slow) @@ -1794,7 +1897,7 @@ subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Oc ! This may do data override or diagnostics on Ice_ocean_boundary. call flux_ocean_to_ice_finish( Time_flux_ocean_to_ice, Ice, Ocean_Ice_Boundary ) call unpack_ocean_ice_boundary( Ocean_ice_boundary, Ice ) - if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, Ice, Ocean_ice_boundary) + if (do_chksum) call coupler_chksum_obj%get_slow_ice_chksums('update_ice_slow+', nc) call fms_mpp_clock_end(coupler_clocks%set_ice_surface_slow) @@ -1866,4 +1969,450 @@ subroutine coupler_generate_sfc_xgrid(Land, Ice, coupler_clocks) end subroutine coupler_generate_sfc_xgrid + !> \brief This subroutine calls atmo_tracer_driver_gather_data. + !! Clocks are set before and after the call. + subroutine coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) + + implicit none + + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + call fms_mpp_clock_begin(coupler_clocks%atmos_tracer_driver_gather_data) + call atmos_tracer_driver_gather_data(Atm%fields, Atm%tr_bot) + call fms_mpp_clock_end(coupler_clocks%atmos_tracer_driver_gather_data) + + end subroutine coupler_atmos_tracer_driver_gather_data + + !> \brief This subroutine calls coupler_sfc_boundary_layer. Chksums are computed + !! if do_chksum = .True. Clocks are set for runtime statistics. + subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & + Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_data_type), intent(inout) :: Land !< Land + type(ice_data_type), intent(inout) :: Ice !< Ice + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(FmsTime_type), intent(in) :: Time_atmos !< Atmos time + integer, intent(in) :: current_timestep !< (nc-1)*num_atmos_cal + na + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) + + call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) + if(do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('sfc+', current_timestep) + + call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) + + end subroutine coupler_sfc_boundary_layer + + !> This subroutine calls update_atmos_model_dynamics. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + integer, intent(in) :: current_timestep !< Current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj pointing to component types + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) + call update_atmos_model_dynamics(Atm) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) + + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_model_dynamics', current_timestep) + if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') + + end subroutine coupler_update_atmos_model_dynamics + + !> This subroutine calls update_atmos_model_radiation. Clocks are set for runtime statistics. + !! Chksums are computed if do_chksum is .True. and do_concurrent_radiation is .False.. Memory + !! usage is computed if do_debug is .True. + subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, coupler_clocks, & + current_timestep, coupler_chksum_obj) + + implicit none + + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + integer, optional, intent(in) :: current_timestep !< Current timestep + type(coupler_chksum_type), optional, intent(in) :: coupler_chksum_obj !< points to component types + + character(128) :: memuse_stats_id = 'update serial rad' !< used to label mem usage + + call fms_mpp_clock_begin(coupler_clocks%radiation) + call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) + call fms_mpp_clock_end(coupler_clocks%radiation) + + if(do_chksum) then + !> cannot put mpp_chksum for concurrent_radiation as it requires the ability to have two different OpenMP threads + !! inside of MPI at the same time which is not currently allowed + if(.not.do_concurrent_radiation) & + call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_model_radiation(ser)',current_timestep) + end if + + if (do_debug) then + if(do_concurrent_radiation) memuse_stats_id = 'update concurrent rad' + call fms_memutils_print_memuse_stats(trim(memuse_stats_id)) + end if + + end subroutine coupler_update_atmos_model_radiation + + !> This subroutine calls update_atmos_model_down. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_atmos_model_down(Atm, Land_ice_atmos_boundary, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary ! This subroutine calls flux_down_from_atmos. Clocks are set for runtime statistics. Chksums + !! are computed if do_chksum = .True. + subroutine coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, & + Atmos_ice_boundary, Time_atmos, current_timestep, coupler_clocks, coupler_chksum_obj) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_data_type), intent(inout) :: Land !< Land + type(ice_data_type), intent(inout) :: Ice !< Ice + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(FmsTime_type), intent(in) :: Time_atmos ! This subroutine calls update_land_model_fast. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_land_model_fast(Land, Atmos_land_boundary, atm_pelist, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + type(land_data_type), intent(inout) :: Land !< Land + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + integer, dimension(:), intent(in) :: atm_pelist !< Atm%pelist to reset the pelist to Atm%pelist + integer, intent(in) :: current_timestep !< current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< points to component types + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_land_model_fast) !< current pelist=Atm%pelist + if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) + + call update_land_model_fast( Atmos_land_boundary, Land ) + + if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(atm_pelist) + call fms_mpp_clock_end(coupler_clocks%update_land_model_fast) + + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_land_fast+', current_timestep) + if (do_debug) call fms_memutils_print_memuse_stats( 'update land') + + end subroutine coupler_update_land_model_fast + + !> This subroutine calls update_ice_model_fast. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, atm_pelist, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + type(ice_data_type), intent(inout) :: Ice !< Ice + type(Atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + integer, dimension(:), intent(in) :: atm_pelist !< Atm%pelist to reset the pelist to Atm%pelist + integer, intent(in) :: current_timestep !< current_timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< points to component types + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_fast) !< current pelist = Atm%pelist + if (ice_npes .NE. atmos_npes)call fms_mpp_set_current_pelist(Ice%fast_pelist) + + call update_ice_model_fast( Atmos_ice_boundary, Ice ) + + if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(atm_pelist) + call fms_mpp_clock_end(coupler_clocks%update_ice_model_fast) + + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_ice_fast+', current_timestep) + if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') + + end subroutine coupler_update_ice_model_fast + + !> This subroutine calls flux_up_to_atmos. Clocks are set for runtime statistics. Chksums + !! are computed if do_chksum is .True. + subroutine coupler_flux_up_to_atmos(Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary,& + Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + type(land_data_type), intent(inout) :: Land !< Land + type(ice_data_type), intent(inout) :: Ice !< Ice + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(FmsTime_type), intent(in) :: Time_atmos !< Time_atmos, time in seconds + integer, intent(in) :: current_timestep !< current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< points to component types + type(coupler_clock_type), intent(in) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%flux_up_to_atmos) + call flux_up_to_atmos(Time_atmos, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) + call fms_mpp_clock_end(coupler_clocks%flux_up_to_atmos) + + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('flux_up2atmos+', current_timestep) + + end subroutine coupler_flux_up_to_atmos + + !> This subroutine calls update_atmos_model_up. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_atmos_model_up(Atm, Land_ice_atmos_boundary, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + integer, intent(in) :: current_timestep !< current_timestep + type(coupler_chksum_type),intent(in) :: coupler_chksum_obj !< points to component types + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_up) + call update_atmos_model_up(Land_ice_atmos_boundary, Atm) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_up) + + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_up+', current_timestep) + if (do_debug) call fms_memutils_print_memuse_stats( 'update up') + + end subroutine coupler_update_atmos_model_up + + !> This subroutine calls flux_atmos_to_ocean and calls flux_ex_arrays_dealloc + subroutine coupler_flux_atmos_to_ocean(Atm, Atmos_ice_boundary, Ice, Time_atmos) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(ice_data_type), intent(inout) :: Ice !< Ice + type(FmsTime_type), intent(in) :: Time_atmos !< Time in seconds + + call flux_atmos_to_ocean(Time_atmos, Atm, Atmos_ice_boundary, Ice) + call flux_ex_arrays_dealloc + + end subroutine coupler_flux_atmos_to_ocean + + !> This subroutine calls update_atmos_model_state. Chksums are mem usage are computed + !! if do_chksum and do_debug are .True. respectively + subroutine coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + integer, intent(in) :: current_timestep !< current_timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< used to compute chksums + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) + call update_atmos_model_state( Atm ) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) + + if (do_chksum) & + call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_model_state+', current_timestep) + if (do_debug) call fms_memutils_print_memuse_stats( 'update state') + + end subroutine coupler_update_atmos_model_state + + !> In this subroutine, update_land model_slow is called by the Land%pes. The atm_pelist are + !! only required to set the clocks. Chksums are computed if do_chksum = .True. + subroutine coupler_update_land_model_slow(Land, Atmos_land_boundary, atm_pelist, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + type(land_data_type), intent(inout) :: Land !< Land + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + integer, dimension(:), intent(in) :: atm_pelist !< atm_pelist used for clocks + integer, intent(in) :: current_timestep !< current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj for chksum computation + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_land_model_slow) + + if (Land%pe) then + if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) + call update_land_model_slow(Atmos_land_boundary,Land) + endif + + if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(atm_pelist) + call fms_mpp_clock_end(coupler_clocks%update_land_model_slow) + + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_land_slow+', current_timestep) + + end subroutine coupler_update_land_model_slow + + !> This subroutine calls flux_land_to_ice. Chksums are computed if do_chksum = .True. + subroutine coupler_flux_land_to_ice(Land, Ice, Land_ice_boundary, Time, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + type(land_data_type), intent(inout) :: Land !< Land + type(ice_data_type), intent(inout) :: Ice !< Ice + type(land_ice_boundary_type), intent(inout) :: Land_ice_boundary !< Land_ice_boundary + type(FmsTime_type), intent(in) :: Time !< Time (in seconds) + integer, intent(in) :: current_timestep !< current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj to compute chksums + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%flux_land_to_ice) + call flux_land_to_ice( Time, Land, Ice, Land_ice_boundary ) + call fms_mpp_clock_end(coupler_clocks%flux_land_to_ice) + + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('fluxlnd2ice+', current_timestep) + + end subroutine coupler_flux_land_to_ice + + !> This subroutine calls ice_model_fast_cleanup and unpack_land_ice_boundary + subroutine coupler_unpack_land_ice_boundary(Ice, Land_ice_boundary, coupler_clocks) + + implicit none + type(ice_data_type), intent(inout) :: Ice !< Ice + type(land_ice_boundary_type), intent(inout) :: Land_ice_boundary !< Land_ice_boundary + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Ice%fast_pelist) + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_slow_fast) + + !> These two calls occur on whichever PEs handle the fast ice processess. + call ice_model_fast_cleanup(Ice) + call unpack_land_ice_boundary(Ice, Land_ice_boundary) + + call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_fast) + + end subroutine coupler_unpack_land_ice_boundary + + !> This subroutine calls update_ice_model_slow and flux_ice_to_ocean_stocks + subroutine coupler_update_ice_model_slow_and_stocks(Ice, coupler_clocks) + + implicit none + type(ice_data_type), intent(inout) :: Ice !< Ice + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + if (slow_ice_with_ocean) call fms_mpp_set_current_pelist(Ice%slow_pelist) + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_slow_slow) + + call update_ice_model_slow(Ice) + + call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean_stocks) + call flux_ice_to_ocean_stocks(Ice) + call fms_mpp_clock_end(coupler_clocks%flux_ice_to_ocean_stocks) + + call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_slow) + + end subroutine coupler_update_ice_model_slow_and_stocks + + !> This subroutine calls update_ocean_model. Chksums are computed if do_chksum = .True. + subroutine coupler_update_ocean_model(Ocean, Ocean_state, Ice_ocean_boundary, & + Time_ocean, Time_step_cpld, current_timestep, coupler_chksum_obj) + + implicit none + type(ocean_public_type), intent(inout) :: Ocean !< Ocean + type(ocean_state_type), pointer, intent(inout) :: Ocean_state !< Ocean_state + type(Ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary !< Ice_ocean_boundary + type(FmsTime_type), intent(inout) :: Time_ocean !< Time_ocean + type(FmsTime_type), intent(in) :: Time_step_cpld !< total number of timesteps + integer, intent(in) :: current_timestep !< current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< used for checksum computation + + call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean, Time_ocean, Time_step_cpld) + if (do_chksum) call coupler_chksum_obj%get_ocean_chksums('update_ocean_model+', current_timestep) + + end subroutine coupler_update_ocean_model + + !> Thie subroutine calls component restarts and coupler_restart where the intermediate restart files + !! is produced in the latter calls. Time_restart is the next timestep where the intermediate restart + !! file will be written out. Time_restart_current records the current restart time. + subroutine coupler_intermediate_restart(Atm, Ice, Ocean, Ocean_state, Ocn_bc_restart, Ice_bc_restart,& + Time_current, Time_restart, Time_restart_current, Time_start) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(ice_data_type), intent(inout) :: Ice !< Ice + type(ocean_public_type), intent(inout) :: Ocean !< Ocean + type(ocean_state_type), pointer, intent(inout) :: Ocean_state !< Ocean_state + type(FmsNetcdfDomainFile_t), pointer, intent(inout) :: Ocn_bc_restart(:) !< used for coupler type restarts + type(FmsNetcdfDomainFile_t), pointer, intent(inout) :: Ice_bc_restart(:) !< used for coupler type restarts + type(FmsTime_type), intent(in) :: Time_current, Time_start !< current Timestep and model start time + !> Restart files will be written when Time=>Time_restart. Time_restart is incremented by restart_interval + !! Time_restart_current records the current timestep the restart file is being written. + !! Time_restart_current does not necessary = Time_restart. + type(FmsTime_type), intent(inout) :: Time_restart, Time_restart_current + character(len=32) :: timestamp !< Time in string + integer :: outunit !< stdout + + Time_restart_current = Time_current + + timestamp = fms_time_manager_date_to_string(Time_restart_current) + outunit= fms_mpp_stdout() + write(outunit,*) '=> NOTE from program coupler: intermediate restart file is written and ', & + trim(timestamp),' is appended as prefix to each restart file name' + if (Atm%pe) then + call atmos_model_restart(Atm, timestamp) + call land_model_restart(timestamp) + call ice_model_restart(Ice, timestamp) + endif + if (Ocean%is_ocean_pe) call ocean_model_restart(Ocean_state, timestamp) + + call coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & + Time_current, Time_restart_current, Time_start, timestamp) + + Time_restart = fms_time_manager_increment_date(Time_current, restart_interval(1), restart_interval(2), & + restart_interval(3), restart_interval(4), restart_interval(5), restart_interval(6) ) + + end subroutine coupler_intermediate_restart + + !> This subroutine mainly prints out the current timestep in the stdout. + !! Chksum is computed if do_chksum = .True. + subroutine coupler_summarize_timestep(current_timestep, num_cpld_calls, coupler_chksum_obj, & + is_atmos_pe, omp_sec, imb_sec) + + implicit none + integer, intent(in) :: current_timestep !< current_timestep, nc + integer, intent(in) :: num_cpld_calls !< total number of outerloop timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj + logical, intent(in) :: is_atmos_pe !< Atm%pe + real, dimension(:), intent(inout) :: omp_sec, imb_sec !< from omp computation + + integer :: outunit !< stdout + character(len=80) :: text !< text to be written out to stdout + + if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('MAIN_LOOP+', current_timestep) + write( text,'(a,i6)' )'Main loop at coupling timestep=', current_timestep + call fms_memutils_print_memuse_stats(text) + outunit= fms_mpp_stdout() + + if (fms_mpp_pe() == fms_mpp_root_pe() .and. is_atmos_pe .and. do_concurrent_radiation) & + write(outunit,102) 'At coupling step ', current_timestep,' of ',num_cpld_calls, ' Atm & Rad (imbalance): ', & + omp_sec(1),' (',imb_sec(1),') ',omp_sec(2),' (',imb_sec(2),')' + + call flush(outunit) + +102 format(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) + + end subroutine coupler_summarize_timestep + end module full_coupler_mod diff --git a/full/ice_ocean_flux_exchange.F90 b/full/ice_ocean_flux_exchange.F90 index 2e437bdd..4131c3ba 100644 --- a/full/ice_ocean_flux_exchange.F90 +++ b/full/ice_ocean_flux_exchange.F90 @@ -63,8 +63,10 @@ subroutine ice_ocean_flux_exchange_init(Time, Ice, Ocean, Ocean_state, ice_ocean type(ice_data_type), intent(inout) :: Ice !< A derived data type to specify ice boundary data type(ocean_public_type), intent(inout) :: Ocean !< A derived data type to specify ocean boundary data type(ocean_state_type), pointer :: Ocean_state - type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< A derived data type to specify properties and fluxes passed from ice to ocean - type(ocean_ice_boundary_type), intent(inout) :: ocean_ice_boundary !< A derived data type to specify properties and fluxes passed from ocean to ice + type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< A derived data type to specify properties and + !! fluxes passed from ice to ocean + type(ocean_ice_boundary_type), intent(inout) :: ocean_ice_boundary !< A derived data type to specify properties and + !! fluxes passed from ocean to ice real, intent(in) :: Dt_cpl_in logical, intent(in) :: debug_stocks_in logical, intent(in) :: do_area_weighted_flux_in @@ -228,8 +230,8 @@ subroutine flux_ice_to_ocean ( Ice, Ocean, Ice_Ocean_Boundary ) type(ice_data_type), intent(in) :: Ice !< A derived data type to specify ice boundary data type(ocean_public_type), intent(in) :: Ocean !< A derived data type to specify ocean boundary data - type(ice_ocean_boundary_type), intent(inout) :: Ice_Ocean_Boundary !< A derived data type to specify properties and fluxes - !! passed from ice to ocean + type(ice_ocean_boundary_type), intent(inout) :: Ice_Ocean_Boundary !< A derived data type to specify properties and + !! fluxes passed from ice to ocean integer :: m integer :: n @@ -322,8 +324,8 @@ end subroutine flux_ice_to_ocean subroutine flux_ice_to_ocean_finish ( Time, Ice_Ocean_Boundary ) type(FmsTime_type), intent(in) :: Time !< Current time - type(ice_ocean_boundary_type), intent(inout) :: Ice_Ocean_Boundary !< A derived data type to specify properties and fluxes - !! passed from ice to ocean + type(ice_ocean_boundary_type), intent(inout) :: Ice_Ocean_Boundary !< A derived data type to specify properties and + !! fluxes passed from ice to ocean call fms_data_override('OCN', 'u_flux', Ice_Ocean_Boundary%u_flux , Time ) call fms_data_override('OCN', 'v_flux', Ice_Ocean_Boundary%v_flux , Time ) @@ -379,8 +381,8 @@ subroutine flux_ocean_to_ice ( Ocean, Ice, Ocean_Ice_Boundary ) type(ocean_public_type), intent(in) :: Ocean !< A derived data type to specify ocean boundary data type(ice_data_type), intent(in) :: Ice !< A derived data type to specify ice boundary data - type(ocean_ice_boundary_type), intent(inout) :: Ocean_Ice_Boundary !< A derived data type to specify properties and fluxes - !! passed from ocean to ice + type(ocean_ice_boundary_type), intent(inout) :: Ocean_Ice_Boundary !< A derived data type to specify properties and + !! fluxes passed from ocean to ice real, allocatable, dimension(:,:) :: tmp integer :: m integer :: n @@ -421,7 +423,8 @@ subroutine flux_ocean_to_ice ( Ocean, Ice, Ocean_Ice_Boundary ) call fms_mpp_domains_redistribute(Ocean%Domain, Ocean%s_surf, Ice%slow_Domain_NH, Ocean_Ice_Boundary%s) if( ASSOCIATED(Ocean_Ice_Boundary%sea_level) ) & - call fms_mpp_domains_redistribute(Ocean%Domain, Ocean%sea_lev, Ice%slow_Domain_NH, Ocean_Ice_Boundary%sea_level) + call fms_mpp_domains_redistribute(Ocean%Domain, Ocean%sea_lev, Ice%slow_Domain_NH, & + Ocean_Ice_Boundary%sea_level) if( ASSOCIATED(Ocean_Ice_Boundary%frazil) ) then if(do_area_weighted_flux) then @@ -434,7 +437,7 @@ subroutine flux_ocean_to_ice ( Ocean, Ice, Ocean_Ice_Boundary ) call divide_by_area(data=Ocean_Ice_Boundary%frazil, area=Ice%area) if (Ocean%is_ocean_pe) deallocate(tmp) else - call fms_mpp_domains_redistribute(Ocean%Domain, Ocean%frazil, Ice%slow_Domain_NH, Ocean_Ice_Boundary%frazil) + call fms_mpp_domains_redistribute(Ocean%Domain,Ocean%frazil, Ice%slow_Domain_NH, Ocean_Ice_Boundary%frazil) endif endif @@ -457,8 +460,8 @@ subroutine flux_ocean_to_ice_finish( Time, Ice, Ocean_Ice_Boundary ) type(FmsTime_type), intent(in) :: Time !< Current time type(ice_data_type), intent(in) :: Ice !< A derived data type to specify ice boundary data - type(ocean_ice_boundary_type), intent(inout) :: Ocean_Ice_Boundary !< A derived data type to specify properties and fluxes - !! passed from ocean to ice + type(ocean_ice_boundary_type), intent(inout) :: Ocean_Ice_Boundary !< A derived data type to specify properties and + !! fluxes passed from ocean to ice real :: from_dq call fms_data_override('ICE', 'u', Ocean_Ice_Boundary%u, Time) @@ -474,8 +477,10 @@ subroutine flux_ocean_to_ice_finish( Time, Ice, Ocean_Ice_Boundary ) ! frazil (already in J/m^2 so no need to multiply by Dt_cpl) from_dq = SUM( Ice%area * Ocean_Ice_Boundary%frazil ) - fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) = fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) - from_dq - fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) = fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) + from_dq + fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) = & + fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) - from_dq + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) = & + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) + from_dq end subroutine flux_ocean_to_ice_finish @@ -495,33 +500,43 @@ subroutine flux_ice_to_ocean_stocks(Ice) ! precip - evap from_dq = Dt_cpl * SUM( Ice%area * (Ice%lprec+Ice%fprec-Ice%flux_q) ) - fms_stock_constants_ice_stock(ISTOCK_WATER)%dq(ISTOCK_BOTTOM) = fms_stock_constants_ice_stock(ISTOCK_WATER)%dq(ISTOCK_BOTTOM) - from_dq - fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq(ISTOCK_TOP ) = fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq(ISTOCK_TOP ) + from_dq + fms_stock_constants_ice_stock(ISTOCK_WATER)%dq(ISTOCK_BOTTOM) = & + fms_stock_constants_ice_stock(ISTOCK_WATER)%dq(ISTOCK_BOTTOM) - from_dq + fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq(ISTOCK_TOP ) = & + fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq(ISTOCK_TOP ) + from_dq ! river from_dq = Dt_cpl * SUM( Ice%area * (Ice%runoff + Ice%calving) ) - fms_stock_constants_ice_stock(ISTOCK_WATER)%dq(ISTOCK_BOTTOM) = fms_stock_constants_ice_stock(ISTOCK_WATER)%dq(ISTOCK_BOTTOM) - from_dq - fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq(ISTOCK_SIDE ) = fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq(ISTOCK_SIDE ) + from_dq + fms_stock_constants_ice_stock(ISTOCK_WATER)%dq(ISTOCK_BOTTOM) = & + fms_stock_constants_ice_stock(ISTOCK_WATER)%dq(ISTOCK_BOTTOM) - from_dq + fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq(ISTOCK_SIDE ) = & + fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq(ISTOCK_SIDE ) + from_dq ! sensible heat + shortwave + longwave + latent heat from_dq = Dt_cpl * SUM( Ice%area * ( & & Ice%flux_sw_vis_dir+Ice%flux_sw_vis_dif & & + Ice%flux_sw_nir_dir+Ice%flux_sw_nir_dif + Ice%flux_lw & & - (Ice%fprec + Ice%calving)*HLF - Ice%flux_t - Ice%flux_q*HLV) ) - fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) = fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) - from_dq - fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) = fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) + from_dq + fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) = & + fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) - from_dq + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) = & + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) + from_dq ! heat carried by river + pme (assuming reference temperature of 0 degC and river/pme temp = surface temp) ! Note: it does not matter what the ref temperature is but it must be consistent with that in OCN and ICE from_dq = Dt_cpl * SUM( Ice%area * ( & & (Ice%lprec+Ice%fprec-Ice%flux_q + Ice%runoff+Ice%calving)*CP_OCEAN*Ice%SST_C(:,:)) ) - fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) = fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) - from_dq - fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) = fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) + from_dq + fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) = & + fms_stock_constants_ice_stock(ISTOCK_HEAT)%dq(ISTOCK_BOTTOM) - from_dq + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) = & + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq(ISTOCK_SIDE ) + from_dq !SALT flux from_dq = Dt_cpl* SUM( Ice%area * ( -Ice%flux_salt )) - fms_stock_constants_ice_stock(ISTOCK_SALT)%dq(ISTOCK_BOTTOM) = fms_stock_constants_ice_stock(ISTOCK_SALT)%dq(ISTOCK_BOTTOM) - from_dq - fms_stock_constants_ocn_stock(ISTOCK_SALT)%dq(ISTOCK_TOP ) = fms_stock_constants_ocn_stock(ISTOCK_SALT)%dq(ISTOCK_TOP ) + from_dq + fms_stock_constants_ice_stock(ISTOCK_SALT)%dq(ISTOCK_BOTTOM) = & + fms_stock_constants_ice_stock(ISTOCK_SALT)%dq(ISTOCK_BOTTOM) - from_dq + fms_stock_constants_ocn_stock(ISTOCK_SALT)%dq(ISTOCK_TOP ) = & + fms_stock_constants_ocn_stock(ISTOCK_SALT)%dq(ISTOCK_TOP ) + from_dq end subroutine flux_ice_to_ocean_stocks @@ -530,10 +545,10 @@ end subroutine flux_ice_to_ocean_stocks !> \brief Updates Ocean stocks due to input that the Ocean model gets. !! !! This subroutine updates the stocks of Ocean by the amount of input that the Ocean gets from Ice component. - !! Unlike subroutine flux_ice_to_ocean_stocks() that uses Ice%fluxes to update the stocks due to the amount of output from Ice - !! this subroutine uses Ice_Ocean_boundary%fluxes to calculate the amount of input to the Ocean. These fluxes are the ones - !! that Ocean model uses internally to calculate its budgets. Hence there should be no difference between this input and what - !! Ocean model internal diagnostics uses. + !! Unlike subroutine flux_ice_to_ocean_stocks() that uses Ice%fluxes to update the stocks due to the amount of output + !! from Ice,this subroutine uses Ice_Ocean_boundary%fluxes to calculate the amount of input to the Ocean. These fluxes + !! are the ones that Ocean model uses internally to calculate its budgets. Hence there should be no difference between + !! this input and what Ocean model internal diagnostics uses. !! This bypasses the possible mismatch in cell areas between Ice and Ocean in diagnosing the stocks of Ocean !! and should report a conserving Ocean component regardless of the glitches in fluxes. !! @@ -562,11 +577,13 @@ subroutine flux_ocean_from_ice_stocks(ocean_state,Ocean,Ice_Ocean_boundary) ! fluxes from ice -> ocean, integrate over surface and in time ! precip - evap - from_dq = SUM( ocean_cell_area * wet * (Ice_Ocean_Boundary%lprec+Ice_Ocean_Boundary%fprec-Ice_Ocean_Boundary%q_flux) ) - fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq_IN(ISTOCK_TOP ) = fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq_IN(ISTOCK_TOP ) + from_dq * Dt_cpl + from_dq = SUM(ocean_cell_area * wet * (Ice_Ocean_Boundary%lprec+Ice_Ocean_Boundary%fprec-Ice_Ocean_Boundary%q_flux)) + fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq_IN(ISTOCK_TOP ) = & + fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq_IN(ISTOCK_TOP ) + from_dq * Dt_cpl from_dq = SUM( ocean_cell_area * wet * (Ice_Ocean_Boundary%runoff+Ice_Ocean_Boundary%calving) ) - fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq_IN(ISTOCK_SIDE ) = fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq_IN(ISTOCK_SIDE ) + from_dq * Dt_cpl + fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq_IN(ISTOCK_SIDE ) = & + fms_stock_constants_ocn_stock(ISTOCK_WATER)%dq_IN(ISTOCK_SIDE ) + from_dq * Dt_cpl ! sensible heat + shortwave + longwave + latent heat @@ -576,7 +593,8 @@ subroutine flux_ocean_from_ice_stocks(ocean_state,Ocean,Ice_Ocean_boundary) - (Ice_Ocean_Boundary%fprec + Ice_Ocean_Boundary%calving)*HLF & - Ice_Ocean_Boundary%t_flux - Ice_Ocean_Boundary%q_flux*HLV )) - fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) = fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) + from_dq * Dt_cpl + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) = & + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) + from_dq * Dt_cpl ! heat carried by river + pme (assuming reference temperature of 0 degC and river/pme temp = surface temp) ! Note: it does not matter what the ref temperature is but it must be consistent with that in OCN and ICE @@ -586,21 +604,25 @@ subroutine flux_ocean_from_ice_stocks(ocean_state,Ocean,Ice_Ocean_boundary) +Ice_Ocean_Boundary%calving * t_calving & +Ice_Ocean_Boundary%runoff * t_runoff )) - fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) = fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) + from_dq * Dt_cpl + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) = & + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) + from_dq * Dt_cpl ! Bottom heat flux from_dq = - SUM( ocean_cell_area * wet * btfHeat) - fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN( ISTOCK_BOTTOM ) = fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_BOTTOM ) + from_dq * Dt_cpl + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN( ISTOCK_BOTTOM ) = & + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_BOTTOM ) + from_dq * Dt_cpl ! Frazil heat from_dq = SUM( ocean_cell_area *wet * Ocean%frazil ) - fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) = fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) + from_dq + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) = & + fms_stock_constants_ocn_stock(ISTOCK_HEAT)%dq_IN(ISTOCK_SIDE ) + from_dq !SALT flux from_dq = SUM( ocean_cell_area * wet * ( -Ice_Ocean_Boundary%salt_flux)) - fms_stock_constants_ocn_stock(ISTOCK_SALT)%dq_IN(ISTOCK_TOP ) = fms_stock_constants_ocn_stock(ISTOCK_SALT)%dq_IN(ISTOCK_TOP ) + from_dq * Dt_cpl + fms_stock_constants_ocn_stock(ISTOCK_SALT)%dq_IN(ISTOCK_TOP ) = & + fms_stock_constants_ocn_stock(ISTOCK_SALT)%dq_IN(ISTOCK_TOP ) + from_dq * Dt_cpl end subroutine flux_ocean_from_ice_stocks diff --git a/full/land_ice_flux_exchange.F90 b/full/land_ice_flux_exchange.F90 index 7a6e6312..6240a4ad 100644 --- a/full/land_ice_flux_exchange.F90 +++ b/full/land_ice_flux_exchange.F90 @@ -105,8 +105,8 @@ subroutine flux_land_to_ice( Time, Land, Ice, Land_Ice_Boundary ) type(land_data_type), intent(in) :: Land !< A derived data type to specify land boundary data type(ice_data_type), intent(in) :: Ice !< A derived data type to specify ice boundary data !real, dimension(:,:), intent(out) :: runoff_ice, calving_ice - type(land_ice_boundary_type), intent(inout):: Land_Ice_Boundary !< A derived data type to specify properties and fluxes passed - !! from land to ice + type(land_ice_boundary_type), intent(inout):: Land_Ice_Boundary !< A derived data type to specify properties and + !! fluxes passed from land to ice integer :: ier real, dimension(n_xgrid_runoff) :: ex_runoff, ex_calving, ex_runoff_hflx, ex_calving_hflx @@ -140,7 +140,8 @@ subroutine flux_land_to_ice( Time, Land, Ice, Land_Ice_Boundary ) ! compute stock increment ice_buf(:,:,1) = Land_Ice_Boundary%runoff + Land_Ice_Boundary%calving - call fms_xgrid_stock_move(from=fms_stock_constants_lnd_stock(ISTOCK_WATER), to=fms_stock_constants_ice_stock(ISTOCK_WATER), & + call fms_xgrid_stock_move(from=fms_stock_constants_lnd_stock(ISTOCK_WATER), & + & to=fms_stock_constants_ice_stock(ISTOCK_WATER), & & grid_index=X2_GRID_ICE, & & stock_data3d=ice_buf, & & xmap=xmap_runoff, & diff --git a/shared/surface_flux.F90 b/shared/surface_flux.F90 index 8b37a396..b0f4fd7e 100644 --- a/shared/surface_flux.F90 +++ b/shared/surface_flux.F90 @@ -17,7 +17,7 @@ !* License along with FMS Coupler. !* If not, see . !*********************************************************************** -!> \file +!> \file !> \brief Handles calculation of fluxes on the exchange grids, see module page for more information !> \page surface_flux_config Surface Flux Configuration @@ -117,6 +117,10 @@ module surface_flux_mod use FMS use FMSconstants, only: cp_air, hlv, stefan, rdgas, rvgas, grav, vonkarm +use ocean_rough_mod, only: cal_z0_hwrf17, cal_zt_hwrf17, read_ocean_rough_scheme +use constants_mod, only: vonkarm +use fms_mod, only: mpp_pe, mpp_root_pe, stdout + implicit none private @@ -150,35 +154,41 @@ module surface_flux_mod real :: d608 = d378/d622 ! d608 set to zero at initialization if the use of ! virtual temperatures is turned off in namelist - +character(len=32) :: rough_scheme_ocean !< ocean roughness length scheme to be read from ocean_rough_nml ! ---- namelist with default values ------------------------------------------ -logical :: no_neg_q = .false. !< If a_atm_in (specific humidity) is negative (because of numerical truncation), - !! then override with 0.0 -logical :: use_virtual_temp = .true. !< If .TRUE., use virtual potential temp to calculate the stability of the surface - !! layer. If .FALSE., use potential temp. -logical :: alt_gustiness = .false. !< An alternaive formulation for gustiness calculation. A minimum bound on the wind - !! speed used influx calculations, with the bound equal to gust_const -logical :: old_dtaudv = .false. !< The derivative of surface wind stress with respect to the zonal wind and meridional - !! wind are approximated by the same tendency -logical :: use_mixing_ratio = .false. !< An option to provide capability to run the Manabe Climate form of the surface flux - !! (coded for legacy purposes). +logical :: no_neg_q = .false. !< If a_atm_in (specific humidity) is negative + !! (because of numerical truncation), then override with 0.0 +logical :: use_virtual_temp = .true. !< If .TRUE., use virtual potential temp to calculate the stability of the + !! surface layer. If .FALSE., use potential temp. +logical :: alt_gustiness = .false. !< An alternaive formulation for gustiness calculation. A minimum bound on + !! the wind speed used influx calculations,with the bound equal to gust_const +logical :: old_dtaudv = .false. !< The derivative of surface wind stress with respect to the zonal wind and + !! meridional wind are approximated by the same tendency +logical :: use_mixing_ratio = .false. !< An option to provide capability to run the Manabe Climate form of the + !! surface flux (coded for legacy purposes). real :: gust_const = 1.0 !< Constant for alternative gustiness calculation real :: gust_min = 0.0 !< Minimum gustiness used when alt_gustiness is .FALSE. -logical :: ncar_ocean_flux = .false. !< Use NCAR climate model turbulent flux calculation described by Large and Yeager, - !! NCAR Technical Document, 2004 -logical :: ncar_ocean_flux_orig = .false. !< Use NCAR climate model turbulent flux calculation described by Large and Yeager, - !! NCAR Technical Document, 2004, using the original GFDL implementation, which - !! contains a bug in the specification of the exchange coefficient for the sensible - !! heat. This option is available for legacy purposes, and is not recommended for - !! new experiments. -logical :: ncar_ocean_flux_multilevel = .false. !< Use NCAR climate model turbulent flux calculation described by Large and Yeager, allows for different reference height for wind, temp and spec. hum. +logical :: ncar_ocean_flux = .false. !< Use NCAR climate model turbulent flux calculation described by Large and + !! Yeager, NCAR Technical Document, 2004 +logical :: ncar_ocean_flux_orig = .false. !< Use NCAR climate model turbulent flux calculation described by Large and + !! Yeager, NCAR Technical Document, 2004, using the original GFDL + !! implementation, which contains a bug in the specification of the exchange + !! coefficient for the sensible heat. This option is available for legacy + !! purposes, and is not recommended for new experiments. +logical :: ncar_ocean_flux_multilevel = .false. !< Use NCAR climate model turbulent flux calculation described by Large + !! and Yeager, allows for different reference height for wind, temp and spec. hum. +logical :: do_iter_monin_obukhov = .false. !< If .TRUE, call monin obukhov funtcions a couple of times to update + !! rough_mom, rough_heat, rough_moist, cd, ch, b_star, u_star +logical :: use_u10_neutral = .false. !< If .TRUE., use 10m neutral wind rather than the standard 10m wind + !! to obtain rough_mom, rough_heat, rough_moist real :: bulk_zu = 10. !< Reference height for wind speed (meters) real :: bulk_zt = 10. !< Reference height for atm temperature (meters) real :: bulk_zq = 10. !< Reference height for atm humidity (meters) logical :: raoult_sat_vap = .false. !< Reduce saturation vapor pressure to account for seawater logical :: do_simple = .false. - +integer :: niter_monin_obukhov = 5 !< iteration times to call iter_monin_obukhov_ocean. + !! Typically 3-5 times should converge namelist /surface_flux_nml/ no_neg_q, & use_virtual_temp, & @@ -194,9 +204,10 @@ module surface_flux_mod bulk_zt, & bulk_zq, & raoult_sat_vap, & - do_simple - - + do_simple, & + do_iter_monin_obukhov, & + use_u10_neutral, & + niter_monin_obukhov contains @@ -216,7 +227,8 @@ subroutine surface_flux_1d ( & dt, land, seawater, avail ) ! ---- arguments ----------------------------------------------------------- logical, intent(in), dimension(:) :: land, & !< Indicates where land exists (.TRUE. if exchange cell is on land - seawater, & !< Indicates where liquid ocean water exists (.TRUE. if exchange cell is on liquid ocean water) + seawater, & !< Indicates where liquid ocean water exists + !! (.TRUE. if exchange cell is on liquid ocean water) avail !< .TRUE. where the exchange cell is active real, intent(in), dimension(:) :: t_atm, & !< Air temp lowest atmospheric level. q_atm_in, & !< Mixing ratio at lowest atmospheric level (kg/kg). @@ -229,9 +241,6 @@ subroutine surface_flux_1d ( & t_surf, & !< Temp at the Earth's surface u_surf, & !< Zonal wind velocity at the Earth's surface v_surf, & !< Meridional wind velocity at the Earth's surface - rough_mom, & !< Momentum roughness length - rough_heat, & !< Heat roughness length - rough_moist, & !< Moisture roughness length rough_scale, & !< Scale factor used to topographic roughness calculation gust !< Gustiness factor real, intent(out), dimension(:) :: flux_t, & !< Sensible heat flux @@ -245,8 +254,10 @@ subroutine surface_flux_1d ( & drdt_surf, & !< Radiative energy flux temperature sensitivity dhdt_atm, & !< Derivative of sensible heat flux over temp at the lowest atmos level dedq_atm, & !< Derivative of water vapor flux over temp at the lowest atmos level - dtaudu_atm, & !< Derivative of zonal wind stress with respect to the lowest level zonal wind speed of the atmos - dtaudv_atm, & !< Derivative of meridional wind stress with respect to the lowest level meridional wind speed of the atmos + dtaudu_atm, & !< Derivative of zonal wind stress with respect to the lowest level + !! zonal wind speed of the atmos + dtaudv_atm, & !< Derivative of meridional wind stress with respect to the lowest + !! level meridional wind speed of the atmos w_atm, & !< Absolute wind at the lowest atmospheric level u_star, & !< Turbulent velocity scale b_star, & !< Turbulent buoyant scale @@ -256,7 +267,10 @@ subroutine surface_flux_1d ( & cd_m, & !< Momentum exchange coefficient cd_t, & ! Heat exchange coefficient cd_q !< Moisture exchange coefficient - real, intent(inout), dimension(:) :: q_surf !< Mixing ratio at the Earth's surface (kg/kg) + real, intent(inout), dimension(:) :: q_surf, & !< Mixing ratio at the Earth's surface (kg/kg) + rough_mom, & !< Momentum roughness length + rough_heat,& !< Heat roughness length + rough_moist !< Moisture roughness length real, intent(in) :: dt !< Time step (it is not used presently) ! ---- local constants ----------------------------------------------------- @@ -369,10 +383,21 @@ subroutine surface_flux_1d ( & endif ! monin-obukhov similarity theory - call fms_monin_obukhov_mo_drag (thv_atm, thv_surf, z_atm, & - rough_mom, rough_heat, rough_moist, w_atm, & + call fms_monin_obukhov_mo_drag (thv_atm, thv_surf, z_atm, & + rough_mom, rough_heat, rough_moist, w_atm, & cd_m, cd_t, cd_q, u_star, b_star, avail ) + ! - iterate monin-obukhov over ocean with updated roughness length + ! - the following fields, cd_m, cd_g, cd_q, u_star, b_star will be overrideen + ! - only effective when the rough_scheme_ocean is hwrf17 + if (do_iter_monin_obukhov) then + call iter_monin_obukhov_ocean ( & + z_atm, u_atm, v_atm, w_atm, thv_atm, q_atm, & + u_surf, v_surf, thv_surf, q_surf0, & + rough_mom, rough_heat, rough_moist, & + cd_m, cd_t, cd_q, u_star, b_star, avail, seawater ) + endif + ! override with ocean fluxes from NCAR calculation if ((ncar_ocean_flux .or. ncar_ocean_flux_orig) .and. (.not.ncar_ocean_flux_multilevel)) then call ncar_ocean_fluxes (w_atm, th_atm, t_surf0, q_atm, q_surf0, z_atm, & @@ -391,7 +416,9 @@ subroutine surface_flux_1d ( & where (avail) ! scale momentum drag coefficient on orographic roughness - cd_m = cd_m*(log(z_atm/rough_mom+1)/log(z_atm/rough_scale+1))**2 + where (.not. seawater) + cd_m = cd_m*(log(z_atm/rough_mom+1)/log(z_atm/rough_scale+1))**2 + endwhere ! surface layer drag coefficients drag_t = cd_t * w_atm drag_q = cd_q * w_atm @@ -489,7 +516,8 @@ subroutine surface_flux_0d ( & ! ---- arguments ----------------------------------------------------------- logical, intent(in) :: land_0, & !< Indicates where land exists (.TRUE. if exchange cell is on land - seawater_0, & !< Indicates where liquid ocean water exists (.TRUE. if exchange cell is on liquid ocean water) + seawater_0, & !< Indicates where liquid ocean water exists + !! (.TRUE. if exchange cell is on liquid ocean water) avail_0 !< .TRUE. where the exchange cell is active real, intent(in) :: t_atm_0, & !< Air temp lowest atmospheric level. q_atm_0, & !< Mixing ratio at lowest atmospheric level (kg/kg). @@ -518,8 +546,10 @@ subroutine surface_flux_0d ( & drdt_surf_0, & !< Radiative energy flux temperature sensitivity dhdt_atm_0, & !< Derivative of sensible heat flux over temp at the lowest atmos level dedq_atm_0, & !< Derivative of water vapor flux over temp at the lowest atmos level - dtaudu_atm_0, & !< Derivative of zonal wind stress with respect to the lowest level zonal wind speed of the atmos - dtaudv_atm_0, & !< Derivative of meridional wind stress with respect to the lowest level meridional wind speed of the atmos + dtaudu_atm_0, & !< Derivative of zonal wind stress with respect to the lowest level zonal wind + !! speed of the atmos + dtaudv_atm_0, & !< Derivative of meridional wind stress with respect to the lowest level + !! meridional wind speed of the atmos w_atm_0, & !< Absolute wind at the lowest atmospheric level u_star_0, & !< Turbulent velocity scale b_star_0, & !< Turbulent buoyant scale @@ -529,7 +559,7 @@ subroutine surface_flux_0d ( & cd_m_0, & !< Momentum exchange coefficient cd_t_0, & ! Heat exchange coefficient cd_q_0 !< Moisture exchange coefficient - real, intent(inout) :: q_surf_0 !< Mixing ratio at the Earth's surface (kg/kg) + real, intent(inout) :: q_surf_0 !< Mixing ratio at the Earth's surface (kg/kg) real, intent(in) :: dt !< Time step (it is not used presently) ! ---- local vars ---------------------------------------------------------- @@ -626,7 +656,8 @@ subroutine surface_flux_2d ( & ! ---- arguments ----------------------------------------------------------- logical, intent(in), dimension(:,:) :: land, & !< Indicates where land exists (.TRUE. if exchange cell is on land - seawater, & !< Indicates where liquid ocean water exists (.TRUE. if exchange cell is on liquid ocean water) + seawater, & !< Indicates where liquid ocean water exists + !! (.TRUE. if exchange cell is on liquid ocean water) avail !< .TRUE. where the exchange cell is active real, intent(in), dimension(:,:) :: t_atm, & !< Air temp lowest atmospheric level. q_atm_in, & !< Mixing ratio at lowest atmospheric level (kg/kg). @@ -639,9 +670,6 @@ subroutine surface_flux_2d ( & t_surf, & !< Temp at the Earth's surface u_surf, & !< Zonal wind velocity at the Earth's surface v_surf, & !< Meridional wind velocity at the Earth's surface - rough_mom, & !< Momentum roughness length - rough_heat, & !< Heat roughness length - rough_moist, & !< Moisture roughness length rough_scale, & !< Scale factor used to topographic roughness calculation gust !< Gustiness factor real, intent(out), dimension(:,:) :: flux_t, & !< Sensible heat flux @@ -653,10 +681,13 @@ subroutine surface_flux_2d ( & dedt_surf, & !< Moisture flux temperature sensitivity dedq_surf, & !< Moisture flux humidity sensitivity drdt_surf, & !< Radiative energy flux temperature sensitivity - dhdt_atm, & !< Derivative of sensible heat flux over temp at the lowest atmos level + dhdt_atm, & !< Derivative of sensible heat flux over temp at the lowest + !! atmos level dedq_atm, & !< Derivative of water vapor flux over temp at the lowest atmos level - dtaudu_atm, & !< Derivative of zonal wind stress with respect to the lowest level zonal wind speed of the atmos - dtaudv_atm, & !< Derivative of meridional wind stress with respect to the lowest level meridional wind speed of the atmos + dtaudu_atm, & !< Derivative of zonal wind stress with respect to the lowest level + !! zonal wind speed of the atmos + dtaudv_atm, & !< Derivative of meridional wind stress with respect to the lowest + !! level meridional wind speed of the atmos w_atm, & !< Absolute wind at the lowest atmospheric level u_star, & !< Turbulent velocity scale b_star, & !< Turbulent buoyant scale @@ -666,7 +697,10 @@ subroutine surface_flux_2d ( & cd_m, & !< Momentum exchange coefficient cd_t, & ! Heat exchange coefficient cd_q !< Moisture exchange coefficient - real, intent(inout), dimension(:,:) :: q_surf !< Mixing ratio at the Earth's surface (kg/kg) + real, intent(inout), dimension(:,:) :: q_surf, & !< Mixing ratio at the Earth's surface (kg/kg) + rough_mom, & !< Momentum roughness length + rough_heat,& !< Heat roughness length + rough_moist !< Moisture roughness length real, intent(in) :: dt !< Time step (it is not used presently) ! ---- local vars ----------------------------------------------------------- @@ -694,12 +728,26 @@ end subroutine surface_flux_2d subroutine surface_flux_init ! ---- local vars ---------------------------------------------------------- - integer :: unit, ierr, io + integer :: unit, ierr, io, outunit + + outunit = stdout() ! read namelist read (fms_mpp_input_nml_file, surface_flux_nml, iostat=io) ierr = check_nml_error(io,'surface_flux_nml') + ! read rough_scheme_ocean from ocean_rough namelist + ! Note that we should not use the variable 'rough_scheme' directly from ocean_rough, + ! because the intialization of ocean_rough is later than the surface_flux_init. + if (do_iter_monin_obukhov) then + call read_ocean_rough_scheme(rough_scheme_ocean) + if (mpp_pe() == mpp_root_pe() ) then + write (outunit,*) 'ocean roughness scheme: ', rough_scheme_ocean + write (outunit,*) 'Warning: if ocean roughness scheme is not hwrf17, & + iter_monin_obukhov_ocean is not effective' + endif + endif + ! write version number call fms_write_version_number(version, tagname) @@ -891,7 +939,7 @@ subroutine ncar_ocean_fluxes_multilevel (u_del, t, ts, q, qs, zu, zt, zq, avail, do i=1,size(u_del(:)) if (avail(i)) then - u = max(u_del(i), 0.5) ! 0.5 m/s floor on wind (undocumented NCAR) + u = max(u_del(i), 0.5) ! 0.5 m/s floor on wind (undocumented NCAR) u10 = u ! first guess 10m wind t10 = t(i) ! first guess: T(z=10) = T(zt) q10 = q(i) ! first guess: Q(z=10) = Q(zq) @@ -902,7 +950,7 @@ subroutine ncar_ocean_fluxes_multilevel (u_del, t, ts, q, qs, zu, zt, zq, avail, stab = 0.5 + sign(0.5,t10-ts(i)) ch_n10 = (18.0*stab+32.7*(1-stab))*cd_n10_rt/1e3 ! L-Y eqn. 6c - cd(i) = cd_n10 ! first guess for exchange coeff's at z + cd(i) = cd_n10 ! first guess for exchange coeff's at z ch(i) = ch_n10 ce(i) = ce_n10 do kiter=1,n_itts ! loop twice @@ -995,4 +1043,89 @@ subroutine ncar_ocean_fluxes_multilevel (u_del, t, ts, q, qs, zu, zt, zq, avail, end subroutine ncar_ocean_fluxes_multilevel +!> \brief Update air-sea flux variables to be consistent with the concurrent atmospheric states +!! \note Right now, it is only effective when ocean_rough = 'hwrf17', but this +!! can be expanded if necessarily to incorporate other roughness schemies +!! contact: Kun.Gao@noaa.gov; Baoqiang.Xiang@noaa.gov +subroutine iter_monin_obukhov_ocean ( & + z_atm, u_atm, v_atm, w_atm, thv_atm, q_atm, & + u_surf, v_surf, thv_surf, q_surf0, & + rough_mom, rough_heat, rough_moist, & + cd_m, cd_t, cd_q, u_star, b_star, avail, seawater) + + real , intent(in), dimension(:) :: & + z_atm, & !< Height at the lowest atmospheric level + u_atm, & !< Zonal wind velocity at the lowest atmospheric level + v_atm, & !< Meridional wind velocity at the lowest atmospheric level + w_atm, & !< Absolute wind at the lowest atmospheric level + thv_atm, & !< Surface air theta_v + q_atm, & !< Mixing ratio at lowest atmospheric level (kg/kg) + u_surf, & !< Zonal wind velocity at the Earth's surface + v_surf, & !< Meridional wind velocity at the Earth's surface + thv_surf, & !< Surface theta_v + q_surf0 !< Surface air humidity + + real , intent(inout), dimension(:) :: & + rough_mom, & !< Momentum roughness length + rough_heat, & !< Heat roughness length + rough_moist,& !< Moisture roughness length + cd_m, & !< Momentum exchange coefficient + cd_t, & !< Heat exchange coefficient + cd_q, & !< Moisture exchange coefficient + u_star, & !< Turbulent velocity scale + b_star !< Turbulent buoyant scale + logical, intent(in), dimension(:) :: & + avail, & !< .TRUE. where the exchange cell is active + seawater !< Indicates where liquid ocean water exists (.TRUE. if exchange cell is on liquid ocean water) + + ! ---- local vars ----------------------------------------------------------- + real, dimension(size(z_atm(:))) :: & + flux_q, q_star, & + ref_u, ref_v, u10, del_m, del_h, del_q, & + rough_mom1, rough_heat1, rough_moist1 + integer i, j + + do i = 1, niter_monin_obukhov + do j = 1, size(avail) + if (avail(j) .and. seawater(j)) then + + ! get q_star (not important but required by mo_profile) + flux_q(j) = cd_q(j) * w_atm(j) * (q_surf0(j) - q_atm(j)) + q_star(j) = flux_q(j) / u_star(j) + + ! get del_m for diagnosing u10 + ! this step can be skipped if using neutral wind to calculate z0/zt + call fms_monin_obukhov_mo_profile ( 10., 2., z_atm(j), & + rough_mom(j), rough_heat(j), rough_moist(j), & + u_star(j), b_star(j), q_star(j), & + del_m(j), del_h(j), del_q(j) ) + + ! get 10m wind and then use it to get z0/zt + if (use_u10_neutral) then + u10(j) = u_star(j)/vonkarm*log(10./rough_mom(j)) + else + u10(j) = 0. + ref_u(j) = u_surf(j) + (u_atm(j)-u_surf(j)) * del_m(j) + ref_v(j) = v_surf(j) + (v_atm(j)-v_surf(j)) * del_m(j) + u10(j) = sqrt(ref_u(j)**2 + ref_v(j)**2) + endif + + ! can expand below for other z0/zt options + if (rough_scheme_ocean == 'hwrf17') then + call cal_z0_hwrf17(u10(j), rough_mom1(j)) + call cal_zt_hwrf17(u10(j), rough_heat1(j)) + rough_mom(j) = rough_mom1(j) + rough_heat(j) = rough_heat1(j) + rough_moist(j) = rough_heat(j) + endif + ! + call fms_monin_obukhov_mo_drag (thv_atm(j), thv_surf(j), z_atm(j), & + rough_mom(j), rough_heat(j), rough_moist(j), w_atm(j), & + cd_m(j), cd_t(j), cd_q(j), u_star(j), b_star(j) ) + endif + enddo + enddo + +end subroutine iter_monin_obukhov_ocean + end module surface_flux_mod diff --git a/simple/coupler_main.F90 b/simple/coupler_main.F90 index ea9e2376..ec33878e 100644 --- a/simple/coupler_main.F90 +++ b/simple/coupler_main.F90 @@ -113,12 +113,14 @@ program coupler_main !----------------------------------------------------------------------- - integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts with. (See - !! force_date_from_namelist.) - character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. Valid values are - !! consistent with the time_manager module: 'gregorian', 'julian', 'noleap', or 'thirty_day'. - !! The value 'no_calendar' cannot be used because the time_manager's date - !! functions are used. All values must be lower case. + integer, dimension(6) :: current_date = (/ 0, 0, 0, 0, 0, 0 /) !< The date that the current integration starts + !! with. (See force_date_from_namelist.) + character(len=17) :: calendar = ' ' !< The calendar type used by the current integration. + !! Valid values are consistent with the time_manager module: + !! 'gregorian', 'julian', 'noleap', or 'thirty_day'. + !! The value 'no_calendar' cannot be used because the + !! time_manager's date functions are used. + !! All values must be lower case. logical :: force_date_from_namelist = .false. !> override restart values for date integer :: months=0 !< Number of months the current integration will be run integer :: days=0 !< Number of days the current integration will be run @@ -386,7 +388,8 @@ subroutine coupler_init !----------------------------------------------------------------------- !----- write time stamps (for start time and end time) ------ - if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') + if ( fms_mpp_pe().EQ.fms_mpp_root_pe() ) & + open(newunit = time_stamp_unit, file='time_stamp.out', status='replace', form='formatted') month = fms_time_manager_month_name(date(2)) if ( fms_mpp_pe() == fms_mpp_root_pe() ) write (time_stamp_unit,20) date, month(1:3) @@ -513,7 +516,7 @@ subroutine coupler_end call atmos_model_end (Atm) call land_model_end (Atmos_land_boundary, Land) call ice_model_end (Ice) - + call fms_diag_end (Time_atmos) #ifdef use_deprecated_io call fms_io_exit diff --git a/simple/flux_exchange.F90 b/simple/flux_exchange.F90 index 1b5815b7..97083b64 100644 --- a/simple/flux_exchange.F90 +++ b/simple/flux_exchange.F90 @@ -617,10 +617,14 @@ subroutine flux_up_to_atmos (Time, Land, Ice, Boundary ) Boundary%dt_tr(:,:,isphum) = f_q_delt_n + dt_t_surf*e_q_n endwhere -!print *, 'PE,dt_t(L)(mn,mx)=',fms_mpp_pe(),minval(Boundary%dt_t,mask=Land%mask(:,:,1)),maxval(Boundary%dt_t,mask=Land%mask(:,:,1)) -!print *, 'PE,dt_q(L)(mn,mx)=',fms_mpp_pe(),minval(Boundary%dt_q,mask=Land%mask(:,:,1)),maxval(Boundary%dt_q,mask=Land%mask(:,:,1)) -!print *, 'PE,dt_t(I)(mn,mx)=',fms_mpp_pe(),minval(Boundary%dt_t,mask=Ice%mask),maxval(Boundary%dt_t,mask=Ice%mask) -!print *, 'PE,dt_q(I)(mn,mx)=',fms_mpp_pe(),minval(Boundary%dt_q,mask=Ice%mask),maxval(Boundary%dt_q,mask=Ice%mask) +#ifdef DEBUG_COUPLER_FLUX_TO_ATMOS +print *, 'PE,dt_t(L)(mn,mx)=',fms_mpp_pe(),minval(Boundary%dt_t,mask=Land%mask(:,:,1)), & + maxval(Boundary%dt_t,mask=Land%mask(:,:,1)) +print *, 'PE,dt_q(L)(mn,mx)=',fms_mpp_pe(),minval(Boundary%dt_q,mask=Land%mask(:,:,1)), & + maxval(Boundary%dt_q,mask=Land%mask(:,:,1)) +print *, 'PE,dt_t(I)(mn,mx)=',fms_mpp_pe(),minval(Boundary%dt_t,mask=Ice%mask),maxval(Boundary%dt_t,mask=Ice%mask) +print *, 'PE,dt_q(I)(mn,mx)=',fms_mpp_pe(),minval(Boundary%dt_q,mask=Ice%mask),maxval(Boundary%dt_q,mask=Ice%mask) +#endif !======================================================================= !-------------------- diagnostics section ------------------------------ @@ -1195,7 +1199,7 @@ subroutine surface_flux_2d ( & t_atm, q_atm_in, u_atm, v_atm, & p_atm, z_atm, t_ca, & p_surf, t_surf, u_surf, v_surf, & - rough_mom, rough_heat, rough_moist, rough_scale, gust + rough_scale, gust real, intent(out), dimension(:,:) :: & flux_t, flux_q, flux_r, flux_u, flux_v, & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & @@ -1203,7 +1207,8 @@ subroutine surface_flux_2d ( & w_atm, u_star, b_star, q_star, & thv_atm, thv_surf, & cd_m, cd_t, cd_q - real, intent(inout), dimension(:,:) :: q_surf + real, intent(inout), dimension(:,:) :: q_surf, rough_mom, & + rough_heat, rough_moist real, intent(in) :: dt ! ---- local vars ----------------------------------------------------------- diff --git a/simple/ice_model.F90 b/simple/ice_model.F90 index 8777adc0..5d31f3cb 100644 --- a/simple/ice_model.F90 +++ b/simple/ice_model.F90 @@ -57,39 +57,39 @@ module ice_model_mod logical :: use_climo_sst = .false. logical :: use_annual_sst = .false. character(len=64) :: ice_method = 'prognostic' ! none, uniform, or prognostic -character(len=64) :: sst_method = 'specified' ! specified, uniform, or mixed_layer - ! Additional sst specifications: 'aqua_planet_#' test cases are derived - ! from the 2000 paper by Neale and Hoskins, 'A standard test for AGCMs including - ! their physical parameterizations: I. The proposal, Atmospheric Science Letters'. - ! The 'aqua_planet_1' testcase corresponds to the 'Control' SST test case and - ! provides the pattern which is shifted for the subsequent cases. - ! The test cases Control, and aqua_planet_5N-aqua_planet_60N were documented and used - ! in Burnett et al., 2021, GRL, https://doi.org/10.1029/2020GL091980 - ! aqua_planet_1 = Control profile - ! aqua_planet_2 = Peaked - ! aqua_planet_3 = Flat - ! aqua_planet_4 = Qobs - ! aqua_planet_5 = Control shifted by 5N - ! aqua_planet_6 = 1KEQ - ! aqua_planet_7 = 3KEQ - ! aqua_planet_8 = 3KW1 - ! aqua_planet_10N = Control shifted by 10N - ! aqua_planet_15N = Control shifted by 15N - ! aqua_planet_20N = Control shifted by 20N - ! aqua_planet_25N = Control shifted by 25N - ! aqua_planet_30N = Control shifted by 20N - ! aqua_planet_35N = Control shifted by 35N - ! aqua_planet_40N = Control shifted by 30N - ! aqua_planet_45N = Control shifted by 45N - ! aqua_planet_50N = Control shifted by 50N - ! aqua_planet_55N = Control shifted by 55N - ! aqua_planet_60N = Control shifted by 60N - ! aqua_planet_65N = Control shifted by 65N - ! aqua_planet_70N = Control shifted by 70N - ! aqua_planet_75N = Control shifted by 75N - ! aqua_planet_80N = Control shifted by 80N - ! aqua_planet_85N = Control shifted by 85N - ! aqua_planet_90N = Control shifted by 90N +character(len=64) :: sst_method = 'specified' !> specified, uniform, or mixed_layer + !! Additional sst specifications: 'aqua_planet_#' test cases are derived + !! from the 2000 paper by Neale and Hoskins, 'A standard test for AGCMs including + !! their physical parameterizations: I. The proposal, Atmospheric Science Letters'. + !! The 'aqua_planet_1' testcase corresponds to the 'Control' SST test case and + !! provides the pattern which is shifted for the subsequent cases. + !! The test cases Control, and aqua_planet_5N-aqua_planet_60N were documented and used + !! in Burnett et al., 2021, GRL, https://doi.org/10.1029/2020GL091980 + !! aqua_planet_1 = Control profile + !! aqua_planet_2 = Peaked + !! aqua_planet_3 = Flat + !! aqua_planet_4 = Qobs + !! aqua_planet_5 = Control shifted by 5N + !! aqua_planet_6 = 1KEQ + !! aqua_planet_7 = 3KEQ + !! aqua_planet_8 = 3KW1 + !! aqua_planet_10N = Control shifted by 10N + !! aqua_planet_15N = Control shifted by 15N + !! aqua_planet_20N = Control shifted by 20N + !! aqua_planet_25N = Control shifted by 25N + !! aqua_planet_30N = Control shifted by 20N + !! aqua_planet_35N = Control shifted by 35N + !! aqua_planet_40N = Control shifted by 30N + !! aqua_planet_45N = Control shifted by 45N + !! aqua_planet_50N = Control shifted by 50N + !! aqua_planet_55N = Control shifted by 55N + !! aqua_planet_60N = Control shifted by 60N + !! aqua_planet_65N = Control shifted by 65N + !! aqua_planet_70N = Control shifted by 70N + !! aqua_planet_75N = Control shifted by 75N + !! aqua_planet_80N = Control shifted by 80N + !! aqua_planet_85N = Control shifted by 85N + !! aqua_planet_90N = Control shifted by 90N real :: temp_ice = 270. ! used when ice_method = 'uniform' real :: temp_sst = 280. ! used when sst_method = 'uniform' real :: sst_anom = 0. ! sst perturbation used for sensitivity experiments @@ -1104,13 +1104,14 @@ subroutine ice_model_init ( Ice, Time_Init, Time, & endif endif -print *, 'pe,count(ice,all,ocean)=',fms_mpp_pe(),count(Ice%ice_mask),count(Ice%mask),count(Ice%mask .and. .not.Ice%ice_mask) +print *, 'pe,count(ice,all,ocean)=',fms_mpp_pe(),count(Ice%ice_mask),count(Ice%mask), & + count(Ice%mask .and. .not.Ice%ice_mask) ! add on non-zero sea surface temperature perturbation (namelist option) ! this perturbation may be useful in accessing model sensitivities if ( abs(sst_anom) > 0.0001 ) then - Ice%t_surf(:,:) = Ice%t_surf(:,:) + fms_amip_interp_sst_anom + Ice%t_surf(:,:) = Ice%t_surf(:,:) + sst_anom endif !---------------------------------------------------------- diff --git a/t/null_model_build.sh b/t/null_model_build.sh index a19d95ec..328f84da 100755 --- a/t/null_model_build.sh +++ b/t/null_model_build.sh @@ -66,28 +66,28 @@ coupler_simple_test.x: coupler_simple/libcoupler_simple.a atmos/libatmos_null.a \$(LD) \$^ \$(LDFLAGS) -o \$@ \$(STATIC_LIBS) fms/libfms.a: FORCE -\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=fms \$(@F) +\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=fms \$(@F) ocean/libocean_null.a: fms/libfms.a FORCE -\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=ocean \$(@F) +\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=ocean \$(@F) atmos/libatmos_null.a: fms/libfms.a FORCE -\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=atmos \$(@F) +\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=atmos \$(@F) ice_param/libice_param.a: fms/libfms.a FORCE -\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=ice_param \$(@F) +\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=ice_param \$(@F) ice/libice_null.a: ocean/libocean_null.a ice_param/libice_param.a fms/libfms.a FORCE -\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=ice \$(@F) +\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=ice \$(@F) land/libland_null.a: fms/libfms.a FORCE -\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=land \$(@F) +\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=land \$(@F) coupler_full/libcoupler_full.a: atmos/libatmos_null.a ice/libice_null.a ice_param/libice_param.a ocean/libocean_null.a land/libland_null.a fms/libfms.a FORCE -\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=coupler_full \$(@F) +\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=coupler_full \$(@F) coupler_simple/libcoupler_simple.a: atmos/libatmos_null.a ice/libice_null.a ice_param/libice_param.a ocean/libocean_null.a land/libland_null.a fms/libfms.a FORCE -\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=coupler_simple \$(@F) +\$(MAKE) SRCROOT=\$(SRCROOT) BUILDROOT=\$(BUILDROOT) MK_TEMPLATE=\$(MK_TEMPLATE) --directory=coupler_simple \$(@F) FORCE: