From 584eab22057c63a6617ce304531a2b483c13799f Mon Sep 17 00:00:00 2001 From: David Bailey Date: Thu, 28 May 2020 10:04:05 -0600 Subject: [PATCH 1/4] Start of fswthru by components --- cicecore/cicedynB/general/ice_flux.F90 | 18 +- cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 | 94 ++ cicecore/drivers/mct/cesm2/CICE_InitMod.F90 | 355 +++++ cicecore/drivers/mct/cesm2/CICE_RunMod.F90 | 535 ++++++++ cicecore/drivers/mct/cesm2/ice_comp_mct.F90 | 1196 +++++++++++++++++ cicecore/drivers/mct/cesm2/ice_constants.F90 | 234 ++++ .../drivers/mct/cesm2/ice_cpl_indices.F90 | 256 ++++ .../drivers/mct/cesm2/ice_import_export.F90 | 767 +++++++++++ .../drivers/mct/cesm2/ice_prescribed_mod.F90 | 561 ++++++++ cicecore/drivers/mct/cesm2/ice_scam.F90 | 15 + 10 files changed, 4030 insertions(+), 1 deletion(-) create mode 100644 cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 create mode 100644 cicecore/drivers/mct/cesm2/CICE_InitMod.F90 create mode 100644 cicecore/drivers/mct/cesm2/CICE_RunMod.F90 create mode 100644 cicecore/drivers/mct/cesm2/ice_comp_mct.F90 create mode 100644 cicecore/drivers/mct/cesm2/ice_constants.F90 create mode 100644 cicecore/drivers/mct/cesm2/ice_cpl_indices.F90 create mode 100644 cicecore/drivers/mct/cesm2/ice_import_export.F90 create mode 100644 cicecore/drivers/mct/cesm2/ice_prescribed_mod.F90 create mode 100644 cicecore/drivers/mct/cesm2/ice_scam.F90 diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 607b763eb..1b15d2dfb 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -217,7 +217,11 @@ module ice_flux fresh , & ! fresh water flux to ocean (kg/m^2/s) fsalt , & ! salt flux to ocean (kg/m^2/s) fhocn , & ! net heat flux to ocean (W/m^2) - fswthru ! shortwave penetrating to ocean (W/m^2) + fswthru , & ! shortwave penetrating to ocean (W/m^2) + fswthruvdr , & ! vis dir shortwave penetrating to ocean (W/m^2) + fswthruvdf , & ! vis dif shortwave penetrating to ocean (W/m^2) + fswthruidr , & ! nir dir shortwave penetrating to ocean (W/m^2) + fswthruidf ! nir dif shortwave penetrating to ocean (W/m^2) ! internal @@ -438,6 +442,10 @@ subroutine alloc_flux fsalt (nx_block,ny_block,max_blocks), & ! salt flux to ocean (kg/m^2/s) fhocn (nx_block,ny_block,max_blocks), & ! net heat flux to ocean (W/m^2) fswthru (nx_block,ny_block,max_blocks), & ! shortwave penetrating to ocean (W/m^2) + fswthruvdr (nx_block,ny_block,max_blocks), & ! vis dir shortwave penetrating to ocean (W/m^2) + fswthruvdf (nx_block,ny_block,max_blocks), & ! vis dif shortwave penetrating to ocean (W/m^2) + fswthruidr (nx_block,ny_block,max_blocks), & ! nir dir shortwave penetrating to ocean (W/m^2) + fswthruidf (nx_block,ny_block,max_blocks), & ! nir dif shortwave penetrating to ocean (W/m^2) scale_factor (nx_block,ny_block,max_blocks), & ! scaling factor for shortwave components strairx_ocn(nx_block,ny_block,max_blocks), & ! stress on ocean by air, x-direction strairy_ocn(nx_block,ny_block,max_blocks), & ! stress on ocean by air, y-direction @@ -684,6 +692,10 @@ subroutine init_coupler_flux fpond (:,:,:) = c0 fhocn (:,:,:) = c0 fswthru (:,:,:) = c0 + fswthruvdr (:,:,:) = c0 + fswthruvdf (:,:,:) = c0 + fswthruidr (:,:,:) = c0 + fswthruidf (:,:,:) = c0 fresh_da(:,:,:) = c0 ! data assimilation fsalt_da(:,:,:) = c0 flux_bio (:,:,:,:) = c0 ! bgc @@ -783,6 +795,10 @@ subroutine init_flux_ocn fpond (:,:,:) = c0 fhocn (:,:,:) = c0 fswthru (:,:,:) = c0 + fswthruvdr (:,:,:) = c0 + fswthruvdf (:,:,:) = c0 + fswthruidr (:,:,:) = c0 + fswthruidf (:,:,:) = c0 faero_ocn (:,:,:,:) = c0 fiso_ocn (:,:,:,:) = c0 diff --git a/cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 b/cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 new file mode 100644 index 000000000..a3b4e6084 --- /dev/null +++ b/cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 @@ -0,0 +1,94 @@ +! SVN:$Id: CICE_FinalMod.F90 744 2013-09-27 22:53:24Z eclare $ +!======================================================================= +! +! This module contains routines for the final exit of the CICE model, +! including final output and clean exit from any message passing +! environments and frameworks. +! +! authors: Philip W. Jones, LANL +! 2006: Converted to free source form (F90) by Elizabeth Hunke +! 2008: E. Hunke moved ESMF code to its own driver + + module CICE_FinalMod + + use ice_kinds_mod + + implicit none + private + public :: CICE_Finalize + +!======================================================================= + + contains + +!======================================================================= +! +! This routine shuts down CICE by exiting all relevent environments. + + subroutine CICE_Finalize + + use ice_exit, only: end_run + use ice_fileunits, only: nu_diag, release_all_fileunits + use ice_restart_shared, only: runid + use ice_timers, only: ice_timer_stop, ice_timer_print_all, timer_total + + !------------------------------------------------------------------- + ! stop timers and print timer info + !------------------------------------------------------------------- + +! call ice_timer_stop(timer_total) ! stop timing entire run + call ice_timer_print_all(stats=.false.) ! print timing information + +!echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output + call release_all_fileunits + + !------------------------------------------------------------------- + ! write 'finished' file if needed + !------------------------------------------------------------------- + + if (runid == 'bering') call writeout_finished_file() + + !------------------------------------------------------------------- + ! quit MPI + !------------------------------------------------------------------- + +#ifdef CESMCOUPLED +#define coupled +#endif + +#ifndef coupled + call end_run ! quit MPI +#endif + + end subroutine CICE_Finalize + +!======================================================================= +! +! Write a file indicating that this run finished cleanly. This is +! needed only for runs on machine 'bering' (set using runid = 'bering'). +! +! author: Adrian Turner, LANL + + subroutine writeout_finished_file() + + use ice_restart_shared, only: restart_dir + use ice_communicate, only: my_task, master_task + + character(len=char_len_long) :: filename + + if (my_task == master_task) then + + filename = trim(restart_dir)//"finished" + open(11,file=filename) + write(11,*) "finished" + close(11) + + endif + + end subroutine writeout_finished_file + +!======================================================================= + + end module CICE_FinalMod + +!======================================================================= diff --git a/cicecore/drivers/mct/cesm2/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm2/CICE_InitMod.F90 new file mode 100644 index 000000000..e48ff6b6f --- /dev/null +++ b/cicecore/drivers/mct/cesm2/CICE_InitMod.F90 @@ -0,0 +1,355 @@ +! SVN:$Id: CICE_InitMod.F90 746 2013-09-28 22:47:56Z eclare $ +!======================================================================= +! +! This module contains the CICE initialization routine that sets model +! parameters and initializes the grid and CICE state variables. +! +! authors Elizabeth C. Hunke, LANL +! William H. Lipscomb, LANL +! Philip W. Jones, LANL +! +! 2006: Converted to free form source (F90) by Elizabeth Hunke +! 2008: E. Hunke moved ESMF code to its own driver + + module CICE_InitMod + + use ice_kinds_mod + + implicit none + private + public :: CICE_Initialize, cice_init + +!======================================================================= + + contains + +!======================================================================= + +! Initialize the basic state, grid and all necessary parameters for +! running the CICE model. Return the initial state in routine +! export state. +! Note: This initialization driver is designed for standalone and +! CCSM-coupled applications. For other +! applications (e.g., standalone CAM), this driver would be +! replaced by a different driver that calls subroutine cice_init, +! where most of the work is done. + + subroutine CICE_Initialize + + !-------------------------------------------------------------------- + ! model initialization + !-------------------------------------------------------------------- + + call cice_init + + end subroutine CICE_Initialize + +!======================================================================= +! +! Initialize CICE model. + + subroutine cice_init(mpicom_ice) + + use ice_aerosol, only: faero_default + use ice_algae, only: get_forcing_bgc + use ice_calendar, only: dt, dt_dyn, write_ic, & + init_calendar, calendar, time + use ice_communicate, only: init_communicate + use ice_diagnostics, only: init_diags + use ice_domain, only: init_domain_blocks + use ice_dyn_eap, only: init_eap + use ice_dyn_shared, only: kdyn, init_evp + use ice_fileunits, only: init_fileunits + use ice_flux, only: init_coupler_flux, init_history_therm, & + init_history_dyn, init_flux_atm, init_flux_ocn + use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & + get_forcing_atmo, get_forcing_ocn + use ice_grid, only: init_grid1, init_grid2 + use ice_history, only: init_hist, accum_hist + use ice_restart_shared, only: restart, runid, runtype + use ice_init, only: input_data, init_state + use ice_itd, only: init_itd + use ice_kinds_mod + use ice_restoring, only: ice_HaloRestore_init + use ice_shortwave, only: init_shortwave + use ice_state, only: tr_aero + use ice_therm_vertical, only: init_thermo_vertical + use ice_timers, only: timer_total, init_ice_timers, ice_timer_start, ice_timer_stop + use ice_transport_driver, only: init_transport + use ice_zbgc, only: init_zbgc + use ice_zbgc_shared, only: skl_bgc +#ifdef popcice + use drv_forcing, only: sst_sss +#endif + +! !INPUT/OUTPUT PARAMETERS: + integer (kind=int_kind), optional, intent(in) :: & + mpicom_ice ! communicator for sequential ccsm + + call init_communicate(mpicom_ice) ! initial setup for message passing + call init_fileunits ! unit numbers + call input_data ! namelist variables + if (trim(runid) == 'bering') call check_finished_file + call init_zbgc ! vertical biogeochemistry namelist + + call init_domain_blocks ! set up block decomposition + call init_grid1 ! domain distribution + call init_ice_timers ! initialize all timers + call ice_timer_start(timer_total) ! start timing entire run + call init_grid2 ! grid variables + + call init_calendar ! initialize some calendar stuff + call init_hist (dt) ! initialize output history file + + if (kdyn == 2) then + call init_eap (dt_dyn) ! define eap dynamics parameters, variables + else ! for both kdyn = 0 or 1 + call init_evp (dt_dyn) ! define evp dynamics parameters, variables + endif + + call init_coupler_flux ! initialize fluxes exchanged with coupler +#ifdef popcice + call sst_sss ! POP data for CICE initialization +#endif + call init_thermo_vertical ! initialize vertical thermodynamics + call init_itd ! initialize ice thickness distribution + call calendar(time) ! determine the initial date + + call init_forcing_ocn(dt) ! initialize sss and sst from data + call init_state ! initialize the ice state + call init_transport ! initialize horizontal transport + call ice_HaloRestore_init ! restored boundary conditions + + call init_restart ! initialize restart variables + + call init_diags ! initialize diagnostic output points + call init_history_therm ! initialize thermo history variables + call init_history_dyn ! initialize dynamic history variables + + ! Initialize shortwave components using swdn from previous timestep + ! if restarting. These components will be scaled to current forcing + ! in prep_radiation. + if (trim(runtype) == 'continue' .or. restart) & + call init_shortwave ! initialize radiative transfer + + !-------------------------------------------------------------------- + ! coupler communication or forcing data initialization + !-------------------------------------------------------------------- + + call init_forcing_atmo ! initialize atmospheric forcing (standalone) + +#ifdef CESMCOUPLED +#define coupled +#endif + +#ifndef coupled + call get_forcing_atmo ! atmospheric forcing from data + call get_forcing_ocn(dt) ! ocean forcing from data +! if (tr_aero) call faero_data ! aerosols + if (tr_aero) call faero_default ! aerosols + if (skl_bgc) call get_forcing_bgc +#endif + + if (runtype == 'initial' .and. .not. restart) & + call init_shortwave ! initialize radiative transfer using current swdn + + call init_flux_atm ! initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + +! if (write_ic) call accum_hist(dt) ! write initial conditions + + call ice_timer_stop(timer_total) ! stop timing entire run + + end subroutine cice_init + +!======================================================================= + + subroutine init_restart + + use ice_aerosol, only: init_aerosol + use ice_age, only: init_age, restart_age, read_restart_age + use ice_blocks, only: nx_block, ny_block + use ice_brine, only: init_hbrine + use ice_calendar, only: time, calendar + use ice_domain, only: nblocks + use ice_domain_size, only: ncat, max_ntrcr + use ice_dyn_eap, only: read_restart_eap + use ice_dyn_shared, only: kdyn + use ice_firstyear, only: init_fy, restart_FY, read_restart_FY + use ice_flux, only: sss + use ice_grid, only: tmask + use ice_init, only: ice_ic + use ice_itd, only: aggregate + use ice_lvl, only: init_lvl, restart_lvl, read_restart_lvl + use ice_meltpond_cesm, only: init_meltponds_cesm, & + restart_pond_cesm, read_restart_pond_cesm + use ice_meltpond_lvl, only: init_meltponds_lvl, & + restart_pond_lvl, read_restart_pond_lvl, dhsn + use ice_meltpond_topo, only: init_meltponds_topo, & + restart_pond_topo, read_restart_pond_topo + use ice_restart_shared, only: runtype, restart + use ice_restart_driver, only: restartfile, restartfile_v4 + use ice_state ! almost everything + use ice_zbgc, only: init_bgc + use ice_zbgc_shared, only: skl_bgc + + integer(kind=int_kind) :: iblk, ltmp + + if (trim(runtype) == 'continue') then + ! start from core restart file + call restartfile() ! given by pointer in ice_in + call calendar(time) ! update time parameters + if (kdyn == 2) call read_restart_eap ! EAP + else if (restart) then ! ice_ic = core restart file + ltmp = len_trim(ice_ic) + if (ice_ic(ltmp-2:ltmp) == '.nc') then + call restartfile (ice_ic) ! or 'default' or 'none' + else + call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file + !!! uncomment if EAP restart data exists + ! if (kdyn == 2) call read_restart_eap + endif + endif + + ! tracers + ! ice age tracer + if (tr_iage) then + if (trim(runtype) == 'continue') & + restart_age = .true. + if (restart_age) then + call read_restart_age + else + do iblk = 1, nblocks + call init_age(nx_block, ny_block, ncat, trcrn(:,:,nt_iage,:,iblk)) + enddo ! iblk + endif + endif + ! first-year area tracer + if (tr_FY) then + if (trim(runtype) == 'continue') restart_FY = .true. + if (restart_FY) then + call read_restart_FY + else + do iblk = 1, nblocks + call init_FY(nx_block, ny_block, ncat, trcrn(:,:,nt_FY,:,iblk)) + enddo ! iblk + endif + endif + ! level ice tracer + if (tr_lvl) then + if (trim(runtype) == 'continue') restart_lvl = .true. + if (restart_lvl) then + call read_restart_lvl + else + do iblk = 1, nblocks + call init_lvl(nx_block, ny_block, ncat, & + trcrn(:,:,nt_alvl,:,iblk), trcrn(:,:,nt_vlvl,:,iblk)) + enddo ! iblk + endif + endif + ! CESM melt ponds + if (tr_pond_cesm) then + if (trim(runtype) == 'continue') & + restart_pond_cesm = .true. + if (restart_pond_cesm) then + call read_restart_pond_cesm + else + do iblk = 1, nblocks + call init_meltponds_cesm(nx_block, ny_block, ncat, & + trcrn(:,:,nt_apnd,:,iblk), trcrn(:,:,nt_hpnd,:,iblk)) + enddo ! iblk + endif + endif + ! level-ice melt ponds + if (tr_pond_lvl) then + if (trim(runtype) == 'continue') & + restart_pond_lvl = .true. + if (restart_pond_lvl) then + call read_restart_pond_lvl + else + do iblk = 1, nblocks + call init_meltponds_lvl(nx_block, ny_block, ncat, & + trcrn(:,:,nt_apnd,:,iblk), trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk), dhsn(:,:,:,iblk)) + enddo ! iblk + endif + endif + ! topographic melt ponds + if (tr_pond_topo) then + if (trim(runtype) == 'continue') & + restart_pond_topo = .true. + if (restart_pond_topo) then + call read_restart_pond_topo + else + do iblk = 1, nblocks + call init_meltponds_topo(nx_block, ny_block, ncat, & + trcrn(:,:,nt_apnd,:,iblk), trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk)) + enddo ! iblk + endif ! .not restart_pond + endif + if (tr_aero) call init_aerosol ! ice aerosol + if (tr_brine) call init_hbrine ! brine height tracer + if (skl_bgc) call init_bgc ! biogeochemistry + + !----------------------------------------------------------------- + ! aggregate tracers + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + call aggregate (nx_block, ny_block, & + aicen(:,:,:,iblk), & + trcrn(:,:,:,:,iblk),& + vicen(:,:,:,iblk), & + vsnon(:,:,:,iblk), & + aice (:,:, iblk), & + trcr (:,:,:,iblk), & + vice (:,:, iblk), & + vsno (:,:, iblk), & + aice0(:,:, iblk), & + tmask(:,:, iblk), & + max_ntrcr, & + trcr_depend) + + enddo + !$OMP END PARALLEL DO + + end subroutine init_restart + +!======================================================================= +! +! Check whether a file indicating that the previous run finished cleanly +! If so, then do not continue the current restart. This is needed only +! for runs on machine 'bering' (set using runid = 'bering'). +! +! author: Adrian Turner, LANL + + subroutine check_finished_file() + + use ice_communicate, only: my_task, master_task + use ice_exit, only: abort_ice + use ice_restart_shared, only: restart_dir + + character(len=char_len_long) :: filename + logical :: lexist = .false. + + if (my_task == master_task) then + + filename = trim(restart_dir)//"finished" + inquire(file=filename, exist=lexist) + if (lexist) then + call abort_ice("Found already finished file - quitting") + end if + + endif + + end subroutine check_finished_file + +!======================================================================= + + end module CICE_InitMod + +!======================================================================= diff --git a/cicecore/drivers/mct/cesm2/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm2/CICE_RunMod.F90 new file mode 100644 index 000000000..ef9e4cf73 --- /dev/null +++ b/cicecore/drivers/mct/cesm2/CICE_RunMod.F90 @@ -0,0 +1,535 @@ +! SVN:$Id: CICE_RunMod.F90 746 2013-09-28 22:47:56Z eclare $ +!======================================================================= +! +! Main driver for time stepping of CICE. +! +! authors Elizabeth C. Hunke, LANL +! Philip W. Jones, LANL +! William H. Lipscomb, LANL +! +! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep +! 2006 ECH: Streamlined for efficiency +! 2006 ECH: Converted to free source form (F90) +! 2007 BPB: Modified Delta-Eddington shortwave interface +! 2008 ECH: moved ESMF code to its own driver + + module CICE_RunMod + + use ice_kinds_mod + use perf_mod, only : t_startf, t_stopf, t_barrierf + use ice_fileunits, only: nu_diag + + implicit none + private + public :: CICE_Run, ice_step + +!======================================================================= + + contains + +!======================================================================= +! +! This is the main driver routine for advancing CICE forward in time. +! +! author Elizabeth C. Hunke, LANL +! Philip W. Jones, LANL +! William H. Lipscomb, LANL + + subroutine CICE_Run + + use ice_aerosol, only: faero_default + use ice_algae, only: get_forcing_bgc + use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_forcing, only: get_forcing_atmo, get_forcing_ocn + use ice_flux, only: init_flux_atm, init_flux_ocn + use ice_state, only: tr_aero + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_couple, timer_step + use ice_zbgc_shared, only: skl_bgc + + !-------------------------------------------------------------------- + ! initialize error code and step timer + !-------------------------------------------------------------------- + + call ice_timer_start(timer_step) ! start timing entire run + + !-------------------------------------------------------------------- + ! timestep loop + !-------------------------------------------------------------------- + + ! timeLoop: do + + istep = istep + 1 ! update time step counters + istep1 = istep1 + 1 + time = time + dt ! determine the time and date + + call init_flux_atm ! initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + call calendar(time) ! at the end of the timestep + + call ice_step + +! if (stop_now >= 1) exit timeLoop + +! enddo timeLoop + + !-------------------------------------------------------------------- + ! end of timestep loop + !-------------------------------------------------------------------- + + call ice_timer_stop(timer_step) ! end timestepping loop timer + + end subroutine CICE_Run + +!======================================================================= +! +! Calls drivers for physics components, some initialization, and output +! +! author Elizabeth C. Hunke, LANL +! William H. Lipscomb, LANL + + subroutine ice_step + + use ice_age, only: write_restart_age + use ice_aerosol, only: write_restart_aero + use ice_boundary, only: ice_HaloUpdate + use ice_brine, only: hbrine_diags, write_restart_hbrine + use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep, idate, sec + use ice_constants, only: field_loc_center, field_type_scalar + use ice_diagnostics, only: init_mass_diags, runtime_diags, print_points_state + use ice_domain, only: halo_info, nblocks + use ice_domain_size, only: nslyr + use ice_dyn_eap, only: write_restart_eap + use ice_dyn_shared, only: kdyn + use ice_firstyear, only: write_restart_FY + use ice_flux, only: scale_factor, init_history_therm + use ice_history, only: accum_hist + use ice_lvl, only: write_restart_lvl + use ice_restart, only: final_restart + use ice_restart_driver, only: dumpfile + use ice_meltpond_cesm, only: write_restart_pond_cesm + use ice_meltpond_lvl, only: write_restart_pond_lvl + use ice_meltpond_topo, only: write_restart_pond_topo + use ice_restoring, only: restore_ice, ice_HaloRestore + use ice_state, only: nt_qsno, trcrn, tr_iage, tr_FY, tr_lvl, & + tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero + use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, & + post_thermo, step_dynamics, step_radiation + use ice_therm_shared, only: calc_Tsfc + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_diags, timer_column, timer_thermo, timer_bound, & + timer_hist, timer_readwrite + use ice_algae, only: bgc_diags, write_restart_bgc + use ice_zbgc, only: init_history_bgc, biogeochemistry + use ice_zbgc_shared, only: skl_bgc + use ice_communicate, only: MPI_COMM_ICE + use ice_prescribed_mod + + integer (kind=int_kind) :: & + iblk , & ! block index + k ! dynamics supercycling index + + !----------------------------------------------------------------- + ! restoring on grid boundaries + !----------------------------------------------------------------- + + if (restore_ice) call ice_HaloRestore + + !----------------------------------------------------------------- + ! initialize diagnostics + !----------------------------------------------------------------- + + call ice_timer_start(timer_diags) ! diagnostics/history + call init_mass_diags ! diagnostics per timestep + call init_history_therm + call init_history_bgc + call ice_timer_stop(timer_diags) ! diagnostics/history + + if(prescribed_ice) then ! read prescribed ice + call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) + call t_startf ('cice_run_presc') + call ice_prescribed_run(idate, sec) + call t_stopf ('cice_run_presc') + endif + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + !----------------------------------------------------------------- + ! Scale radiation fields + !----------------------------------------------------------------- + + if (calc_Tsfc) call prep_radiation (dt, iblk) + + !----------------------------------------------------------------- + ! thermodynamics + !----------------------------------------------------------------- + + call step_therm1 (dt, iblk) ! vertical thermodynamics + call biogeochemistry (dt, iblk) ! biogeochemistry + if (.not.prescribed_ice) & + call step_therm2 (dt, iblk) ! ice thickness distribution thermo + + enddo ! iblk + !$OMP END PARALLEL DO + + call post_thermo (dt) ! finalize thermo update + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + !----------------------------------------------------------------- + ! dynamics, transport, ridging + !----------------------------------------------------------------- + + if (.not.prescribed_ice .and. kdyn>0) then + do k = 1, ndtd + call step_dynamics (dt_dyn, ndtd) + enddo + endif + + !----------------------------------------------------------------- + ! albedo, shortwave radiation + !----------------------------------------------------------------- + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + call step_radiation (dt, iblk) + + !----------------------------------------------------------------- + ! get ready for coupling and the next time step + !----------------------------------------------------------------- + + call coupling_prep (iblk) + + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (scale_factor, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + !----------------------------------------------------------------- + ! write data + !----------------------------------------------------------------- + + call ice_timer_start(timer_diags) ! diagnostics + if (mod(istep,diagfreq) == 0) then + call runtime_diags(dt) ! log file + if (skl_bgc) call bgc_diags (dt) + if (tr_brine) call hbrine_diags (dt) + endif + call ice_timer_stop(timer_diags) ! diagnostics + + call ice_timer_start(timer_hist) ! history + call accum_hist (dt) ! history file + call ice_timer_stop(timer_hist) ! history + + call ice_timer_start(timer_readwrite) ! reading/writing + if (write_restart == 1) then + call dumpfile ! core variables for restarting + if (tr_iage) call write_restart_age + if (tr_FY) call write_restart_FY + if (tr_lvl) call write_restart_lvl + if (tr_pond_cesm) call write_restart_pond_cesm + if (tr_pond_lvl) call write_restart_pond_lvl + if (tr_pond_topo) call write_restart_pond_topo + if (tr_aero) call write_restart_aero + if (skl_bgc) call write_restart_bgc + if (tr_brine) call write_restart_hbrine + if (kdyn == 2) call write_restart_eap + call final_restart + endif + + call ice_timer_stop(timer_readwrite) ! reading/writing + + end subroutine ice_step + +!======================================================================= +! +! Prepare for coupling +! +! authors: Elizabeth C. Hunke, LANL + + subroutine coupling_prep (iblk) + + use ice_blocks, only: block, nx_block, ny_block + use ice_calendar, only: dt, nstreams + use ice_constants, only: c0, c1, puny, rhofresh + use ice_domain_size, only: ncat + use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & + albpnd, albcnt, apeff_ai, coszen, fpond, fresh, l_mpond_fresh, & + alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & + fresh_ai, fsalt_ai, fsalt, & + fswthru_ai, fhocn, fswthru, scale_factor, & + fswthruvdr, fswthruvdf, fswthruidr, fswthruidf, & + swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyt, & + fsens, flat, fswabs, flwout, evap, Tref, Qref, Uref, faero_ocn, & + fsurfn_f, flatn_f, scale_fluxes, frzmlt_init, frzmlt, wind, & + snowfrac + use ice_grid, only: tmask + use ice_ocean, only: oceanmixed_ice, ocean_mixed_layer + use ice_shortwave, only: alvdfn, alidfn, alvdrn, alidrn, & + albicen, albsnon, albpndn, apeffn, snowfracn + use ice_state, only: aicen, aice, aice_init, nbtrcr + use ice_therm_shared, only: calc_Tsfc + use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop + use ice_zbgc_shared, only: flux_bio, flux_bio_ai + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + n , & ! thickness category index + i,j , & ! horizontal indices + k ! tracer index + + real (kind=dbl_kind) :: cszn ! counter for history averaging + + real (kind=dbl_kind) :: netsw + + !----------------------------------------------------------------- + ! Save current value of frzmlt for diagnostics. + ! Update mixed layer with heat and radiation from ice. + !----------------------------------------------------------------- + + do j = 1, ny_block + do i = 1, nx_block + frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk) + enddo + enddo + + call ice_timer_start(timer_couple,iblk) ! atm/ocn coupling + + if (oceanmixed_ice) & + call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst + + !----------------------------------------------------------------- + ! Aggregate albedos + !----------------------------------------------------------------- + + do j = 1, ny_block + do i = 1, nx_block + alvdf(i,j,iblk) = c0 + alidf(i,j,iblk) = c0 + alvdr(i,j,iblk) = c0 + alidr(i,j,iblk) = c0 + + albice(i,j,iblk) = c0 + albsno(i,j,iblk) = c0 + albpnd(i,j,iblk) = c0 + apeff_ai(i,j,iblk) = c0 + snowfrac(i,j,iblk) = c0 + + ! for history averaging + cszn = c0 + netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk) + if (netsw > puny) cszn = c1 + do n = 1, nstreams + albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn + enddo + enddo + enddo + do n = 1, ncat + do j = 1, ny_block + do i = 1, nx_block + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidf(i,j,iblk) = alidf(i,j,iblk) & + + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alvdr(i,j,iblk) = alvdr(i,j,iblk) & + + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidr(i,j,iblk) = alidr(i,j,iblk) & + + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) + + if (coszen(i,j,iblk) > puny) then ! sun above horizon + albice(i,j,iblk) = albice(i,j,iblk) & + + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) + albsno(i,j,iblk) = albsno(i,j,iblk) & + + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) + albpnd(i,j,iblk) = albpnd(i,j,iblk) & + + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) + endif + + apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history + + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) + snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history + + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) + enddo + enddo + enddo + + do j = 1, ny_block + do i = 1, nx_block + + !----------------------------------------------------------------- + ! reduce fresh by fpond for coupling + !----------------------------------------------------------------- + + if (l_mpond_fresh) then + fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt + fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk) + endif + + !---------------------------------------------------------------- + ! Store grid box mean albedos and fluxes before scaling by aice + !---------------------------------------------------------------- + + alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) + alidf_ai (i,j,iblk) = alidf (i,j,iblk) + alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) + alidr_ai (i,j,iblk) = alidr (i,j,iblk) + fresh_ai (i,j,iblk) = fresh (i,j,iblk) + fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) + fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) + fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) + + if (nbtrcr > 0) then + do k = 1, nbtrcr + flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) + enddo + endif + + !----------------------------------------------------------------- + ! Save net shortwave for scaling factor in scale_factor + !----------------------------------------------------------------- + scale_factor(i,j,iblk) = & + swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & + + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & + + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & + + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) + + enddo + enddo + + !----------------------------------------------------------------- + ! Divide fluxes by ice area + ! - the CCSM coupler assumes fluxes are per unit ice area + ! - also needed for global budget in diagnostics + !----------------------------------------------------------------- + + call scale_fluxes (nx_block, ny_block, & + tmask (:,:,iblk) , nbtrcr, & + aice (:,:,iblk) , Tf (:,:,iblk), & + Tair (:,:,iblk) , Qa (:,:,iblk), & + strairxT (:,:,iblk) , strairyT(:,:,iblk), & + fsens (:,:,iblk) , flat (:,:,iblk), & + fswabs (:,:,iblk) , flwout (:,:,iblk), & + evap (:,:,iblk) , & + Tref (:,:,iblk) , Qref (:,:,iblk), & + fresh (:,:,iblk) , fsalt (:,:,iblk), & + fhocn (:,:,iblk) , fswthru (:,:,iblk), & + fswthruvdr(:,:,iblk), fswthruvdf(:,:,iblk), & + fswthruidr(:,:,iblk) , fswthruidf(:,:,iblk), & + faero_ocn (:,:,:,iblk), & + alvdr (:,:,iblk) , alidr (:,:,iblk), & + alvdf (:,:,iblk) , alidf (:,:,iblk), & + flux_bio (:,:,1:nbtrcr,iblk), & + Uref=Uref (:,:,iblk), wind=wind(:,:,iblk) ) + +!echmod - comment this out for efficiency, if .not. calc_Tsfc + if (.not. calc_Tsfc) then + + !--------------------------------------------------------------- + ! If surface fluxes were provided, conserve these fluxes at ice + ! free points by passing to ocean. + !--------------------------------------------------------------- + + call sfcflux_to_ocn & + (nx_block, ny_block, & + tmask (:,:,iblk), aice_init(:,:,iblk), & + fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), & + fresh (:,:,iblk), fhocn (:,:,iblk)) + endif +!echmod + + call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling + + end subroutine coupling_prep + +!======================================================================= +! +! If surface heat fluxes are provided to CICE instead of CICE calculating +! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can +! be provided at points which do not have ice. (This is could be due to +! the heat fluxes being calculated on a lower resolution grid or the +! heat fluxes not recalculated at every CICE timestep.) At ice free points, +! conserve energy and water by passing these fluxes to the ocean. +! +! author: A. McLaren, Met Office + + subroutine sfcflux_to_ocn(nx_block, ny_block, & + tmask, aice, & + fsurfn_f, flatn_f, & + fresh, fhocn) + + use ice_domain_size, only: ncat + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block ! block dimensions + + logical (kind=log_kind), dimension (nx_block,ny_block), & + intent(in) :: & + tmask ! land/boundary mask, thickness (T-cell) + + real (kind=dbl_kind), dimension(nx_block,ny_block), & + intent(in):: & + aice ! initial ice concentration + + real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), & + intent(in) :: & + fsurfn_f, & ! net surface heat flux (provided as forcing) + flatn_f ! latent heat flux (provided as forcing) + + real (kind=dbl_kind), dimension(nx_block,ny_block), & + intent(inout):: & + fresh , & ! fresh water flux to ocean (kg/m2/s) + fhocn ! actual ocn/ice heat flx (W/m**2) + +#ifdef CICE_IN_NEMO + + ! local variables + integer (kind=int_kind) :: & + i, j, n ! horizontal indices + + real (kind=dbl_kind) :: & + rLsub ! 1/Lsub + + rLsub = c1 / Lsub + + do n = 1, ncat + do j = 1, ny_block + do i = 1, nx_block + if (tmask(i,j) .and. aice(i,j) <= puny) then + fhocn(i,j) = fhocn(i,j) & + + fsurfn_f(i,j,n) + flatn_f(i,j,n) + fresh(i,j) = fresh(i,j) & + + flatn_f(i,j,n) * rLsub + endif + enddo ! i + enddo ! j + enddo ! n + +#endif + + end subroutine sfcflux_to_ocn + +!======================================================================= + + end module CICE_RunMod + +!======================================================================= diff --git a/cicecore/drivers/mct/cesm2/ice_comp_mct.F90 b/cicecore/drivers/mct/cesm2/ice_comp_mct.F90 new file mode 100644 index 000000000..678b94312 --- /dev/null +++ b/cicecore/drivers/mct/cesm2/ice_comp_mct.F90 @@ -0,0 +1,1196 @@ +module ice_comp_mct + +!--------------------------------------------------------------------------- +!BOP +! +! !MODULE: ice_comp_mct +! +! !DESCRIPTION: +! CICE interface routine for the ccsm cpl7 mct system +! +! !USES: + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod, only : shr_sys_abort, shr_sys_flush + use shr_file_mod, only : shr_file_getlogunit, shr_file_getloglevel, & + shr_file_setloglevel, shr_file_setlogunit + use mct_mod +#ifdef USE_ESMF_LIB + use esmf +#else + use esmf, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet +#endif + + use seq_flds_mod + use seq_cdata_mod, only : seq_cdata, seq_cdata_setptrs + use seq_infodata_mod,only : seq_infodata_type, seq_infodata_getdata, & + seq_infodata_putdata, seq_infodata_start_type_cont, & + seq_infodata_start_type_brnch, seq_infodata_start_type_start + use seq_timemgr_mod, only : seq_timemgr_eclockgetdata, & + seq_timemgr_restartalarmison, & + seq_timemgr_eclockdateinsync, & + seq_timemgr_stopalarmison + use seq_comm_mct, only : seq_comm_suffix, seq_comm_inst, seq_comm_name + use perf_mod, only : t_startf, t_stopf, t_barrierf + + use ice_cpl_indices + use ice_import_export + use ice_state, only : aice + use ice_domain_size, only : nx_global, ny_global, block_size_x, block_size_y, max_blocks + use ice_domain, only : nblocks, blocks_ice, halo_info, distrb_info + use ice_blocks, only : block, get_block, nx_block, ny_block + use ice_grid, only : tlon, tlat, tarea, tmask, anglet, hm, & + grid_type, t2ugrid_vector, gridcpl_file, ocn_gridcell_frac + use ice_constants, only : c0, c1, spval_dbl, rad_to_deg, radius, secday + use ice_communicate, only : my_task, master_task, MPI_COMM_ICE + use ice_calendar, only : istep, istep1, force_restart_now, write_ic,& + idate, idate0, mday, time, month, daycal, & + sec, dt, dt_dyn, calendar, & + calendar_type, nextsw_cday, days_per_year, & + nyr, new_year, time2sec, year_init, & + use_leap_years, basis_seconds + use ice_orbital, only : eccen, obliqr, lambm0, mvelpp + use ice_ocean, only : tfrz_option + use ice_timers + + use ice_kinds_mod, only : int_kind, dbl_kind, char_len_long, log_kind + use ice_boundary, only : ice_HaloUpdate + use ice_scam, only : scmlat, scmlon, single_column + use ice_fileunits, only : nu_diag, inst_index, inst_name, inst_suffix, & + release_all_fileunits + use ice_therm_shared, only: ktherm + use ice_prescribed_mod + use ice_step_mod + use ice_global_reductions + use ice_broadcast + use CICE_RunMod + use ice_atmo, only : flux_convergence_tolerance, flux_convergence_max_iteration, use_coldair_outbreak_mod + +! !PUBLIC MEMBER FUNCTIONS: + implicit none + public :: ice_init_mct + public :: ice_run_mct + public :: ice_final_mct + SAVE + private ! By default make data private +! +! ! PUBLIC DATA: +! +! !REVISION HISTORY: +! Author: Jacob Sewall, Mariana Vertenstein +! +!EOP +! !PRIVATE MEMBER FUNCTIONS: + private :: ice_SetGSMap_mct + private :: ice_domain_mct + private :: ice_setdef_mct + private :: ice_coffset_mct + private :: ice_setcoupling_mct + +! +! !PRIVATE VARIABLES + + integer (kind=int_kind) :: ICEID + + !--- for coupling on other grid from gridcpl_file --- + type(mct_gsMap) :: gsMap_iloc ! local gsmaps + type(mct_gGrid) :: dom_iloc ! local domain + type(mct_aVect) :: x2i_iloc, i2x_iloc + type(mct_rearr) :: rearr_ice2iloc + type(mct_rearr) :: rearr_iloc2ice + integer :: nxcpl, nycpl ! size of coupling grid + logical :: other_cplgrid ! using different coupling grid +#ifdef COMPARE_TO_NUOPC + logical :: compare_to_nuopc = .true. +#else + logical :: compare_to_nuopc = .false. +#endif +!======================================================================= + +contains + +!======================================================================= +!BOP +! +! !IROUTINE: ice_init_mct +! +! !INTERFACE: + subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename ) +! +! !DESCRIPTION: +! Initialize thermodynamic ice model and obtain relevant atmospheric model +! arrays back from driver +! +! !USES: + + use CICE_InitMod + use ice_restart_shared, only: runid, runtype, restart_dir, restart_format + use ice_history, only: accum_hist + use ice_history_shared, only: history_dir, history_file, model_doi_url +! +! !ARGUMENTS: + type(ESMF_Clock) , intent(inout) :: EClock + type(seq_cdata) , intent(inout) :: cdata_i + type(mct_aVect) , intent(inout) :: x2i_i, i2x_i + character(len=*), optional , intent(in) :: NLFilename ! Namelist filename +! +! !LOCAL VARIABLES: +! + type(mct_gsMap) , pointer :: gsMap_ice + type(mct_gGrid) , pointer :: dom_i + type(seq_infodata_type) , pointer :: infodata ! Input init object + integer :: lsize,lsize_loc + integer :: xoff,yoff + integer :: nxg,nyg + integer :: k, iblk + + type(mct_gsMap) :: gsmap_extend ! local gsmaps + + character(len=256) :: drvarchdir ! driver archive directory + character(len=32) :: starttype ! infodata start type + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! start time of day (s) + integer :: curr_ymd ! Current date (YYYYMMDD) + integer :: curr_tod ! Current time of day (s) + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (s) + integer :: iyear ! yyyy + integer :: nyrp ! yyyy + integer :: dtime ! time step + integer :: shrlogunit,shrloglev ! old values + integer :: iam,ierr + integer :: lbnum + integer :: daycal(13) !number of cumulative days per month + integer :: nleaps ! number of leap days before current year + integer :: mpicom_loc ! temporary mpicom + logical (kind=log_kind) :: atm_aero + real(r8) :: mrss, mrss0,msize,msize0 + type(ESMF_TIME) :: currTime + integer :: rc + character(len=*), parameter :: SubName = "ice_init_mct" +!EOP +!----------------------------------------------------------------------- + + call t_startf ('cice_init_total') + + !-------------------------------------------------------------------------- + ! Determine attribute vector indices + !-------------------------------------------------------------------------- + + call ice_cpl_indices_set() + + !--------------------------------------------------------------------------- + ! Set cdata pointers + !--------------------------------------------------------------------------- + + call seq_cdata_setptrs(cdata_i, ID=ICEID, mpicom=mpicom_loc, & + gsMap=gsMap_ice, dom=dom_i, infodata=infodata) + + ! Determine time of next atmospheric shortwave calculation + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + + ! Determine if aerosols are coming from the coupler + call seq_infodata_GetData(infodata, atm_aero=atm_aero ) + + ! Determine orbital parameters + call seq_infodata_GetData(infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & + orb_lambm0=lambm0, orb_obliqr=obliqr) + + ! Get model_doi_url + call seq_infodata_GetData(infodata, model_doi_url=model_doi_url) + + ! call shr_init_memusage() + + !--------------------------------------------------------------------------- + ! use infodata to determine type of run + !--------------------------------------------------------------------------- + + ! Preset single column values + + single_column = .false. + scmlat = -999. + scmlon = -999. + + call seq_infodata_GetData( infodata, case_name=runid , & + single_column=single_column ,scmlat=scmlat,scmlon=scmlon) + call seq_infodata_GetData( infodata, start_type=starttype) + + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + runtype = "initial" + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + runtype = "continue" + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + runtype = "continue" + else + write(nu_diag,*) trim(subname),' ERROR: unknown starttype' + call shr_sys_abort() + end if + + ! Set nextsw_cday to -1 for continue and branch runs. + + if (trim(runtype) /= 'initial') then + nextsw_cday = -1 + else + if (compare_to_nuopc) then + ! Note that in the mct version the atm was initialized first + ! so that nextsw_cday could be passed to the other + ! components - this assumed that cam or datm was ALWAYS + ! initialized first. In the nuopc version it will be easier + ! to assume that on startup - nextsw_cday is just the current time + + call ESMF_ClockGet( Eclock, currTime=currTime, rc=rc ) + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + end if + end if + + !============================================================= + ! Set ice dtime to ice coupling frequency + !============================================================= + + call seq_timemgr_EClockGetData(EClock, dtime=dtime, calendar=calendar_type) + dt = real(dtime) + + !============================================================= + ! Initialize cice because grid information is needed for + ! creation of GSMap_ice. cice_init also sets time manager info + !============================================================= + + inst_name = seq_comm_name(ICEID) + inst_index = seq_comm_inst(ICEID) + inst_suffix = seq_comm_suffix(ICEID) + call t_startf ('cice_init') + call cice_init( mpicom_loc ) + call t_stopf ('cice_init') + + call seq_infodata_GetData(infodata, tfreeze_option=tfrz_option ) + + if (my_task == master_task) then + write(nu_diag,*) trim(subname),' tfrz_option = ',trim(tfrz_option) + if (ktherm == 2 .and. trim(tfrz_option) /= 'mushy') then + write(nu_diag,*) trim(subname),' Warning: Using ktherm = 2 and tfrz_option = ', & + trim(tfrz_option) + endif + endif + + ! atmice flux calculation + call seq_infodata_GetData(infodata, & + coldair_outbreak_mod=use_coldair_outbreak_mod, & + flux_convergence=flux_convergence_tolerance, & + flux_max_iteration=flux_convergence_max_iteration) + + if (my_task == master_task) then + write(nu_diag,*) trim(subname),' inst_name = ',trim(inst_name) + write(nu_diag,*) trim(subname),' inst_index = ',inst_index + write(nu_diag,*) trim(subname),' inst_suffix = ',trim(inst_suffix) + write(nu_diag,*) trim(subname),' flux_convergence = ', flux_convergence_tolerance + write(nu_diag,*) trim(subname),' flux_convergence_max_iteration = ', flux_convergence_max_iteration + endif + + !--------------------------------------------------------------------------- + ! Reset shr logging to my log file + !--------------------------------------------------------------------------- + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (nu_diag) + + !--------------------------------------------------------------------------- + ! use EClock to reset calendar information on initial start + !--------------------------------------------------------------------------- + + ! - on restart run + ! - istep0, time and time_forc are read from restart file + ! - istep1 is set to istep0 + ! - idate is determined from time via the call to calendar (see below) + ! - on initial run + ! - iyear, month and mday obtained from sync clock + ! - time determined from iyear, month and mday + ! - istep0 and istep1 are set to 0 + + call seq_timemgr_EClockGetData(EClock, & + start_ymd=start_ymd, start_tod=start_tod, & + curr_ymd=curr_ymd, curr_tod=curr_tod, & + ref_ymd=ref_ymd, ref_tod=ref_tod) + + if (runtype == 'initial') then + if (ref_ymd /= start_ymd .or. ref_tod /= start_tod) then + if (my_task == master_task) then + write(nu_diag,*) trim(subname),': ref_ymd ',ref_ymd, & + ' must equal start_ymd ',start_ymd + write(nu_diag,*) trim(subname),': ref_ymd ',ref_tod, & + ' must equal start_ymd ',start_tod + end if + end if + + if (my_task == master_task) then + write(nu_diag,*) trim(subname),' idate from sync clock = ', & + start_ymd + write(nu_diag,*) trim(subname),' tod from sync clock = ', & + start_tod + write(nu_diag,*) & + trim(subname),' resetting idate to match sync clock' + end if + + idate = curr_ymd + + if (idate < 0) then + write(nu_diag,*) trim(subname),' ERROR curr_ymd,year_init =',curr_ymd,year_init + write(nu_diag,*) trim(subname),' ERROR idate lt zero',idate + call shr_sys_abort(subname//' :: ERROR idate lt zero') + endif + iyear = (idate/10000) ! integer year of basedate + month = (idate-iyear*10000)/100 ! integer month of basedate + mday = idate-iyear*10000-month*100 ! day of month of basedate + + if (my_task == master_task) then + write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd + write(nu_diag,*) trim(subname),' cice year_init = ',year_init + write(nu_diag,*) trim(subname),' cice start date = ',idate + write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + endif + + if (calendar_type /= "GREGORIAN") then + call time2sec(iyear-year_init,month,mday,time) + else + call time2sec(iyear-(year_init-1),month,mday,time) + endif + + time = time+start_tod + + call shr_sys_flush(nu_diag) + end if + + call calendar(time) ! update calendar info + if (write_ic) call accum_hist(dt) ! write initial conditions + + !--------------------------------------------------------------------------- + ! Initialize MCT attribute vectors and indices + !--------------------------------------------------------------------------- + + call t_startf ('cice_mct_init') + + ! Initialize ice gsMap + + if (trim(gridcpl_file) == 'unknown_gridcpl_file') then + call ice_SetGSMap_mct( MPI_COMM_ICE, ICEID, GSMap_ice ) + lsize = mct_gsMap_lsize(gsMap_ice, MPI_COMM_ICE) + call ice_domain_mct( lsize, gsMap_ice, dom_i ) + other_cplgrid = .false. + nxg = nx_global + nyg = ny_global + else + call ice_SetGSMap_mct( MPI_COMM_ICE, ICEID, GSMap_iloc ) + lsize_loc = mct_gsMap_lsize(gsMap_iloc, MPI_COMM_ICE) + call ice_domain_mct( lsize_loc, gsMap_iloc, dom_iloc ) + + call ice_setcoupling_mct(MPI_COMM_ICE, ICEID, gsmap_ice, dom_i) + lsize = mct_gsMap_lsize(gsMap_ice, MPI_COMM_ICE) + + call ice_coffset_mct(xoff,yoff,gsmap_iloc,dom_iloc,gsmap_ice,dom_i,MPI_COMM_ICE) + + call ice_SetGSMap_mct( MPI_COMM_ICE, ICEID, gsmap_extend, xoff, yoff, nxcpl, nycpl) + if (lsize_loc /= mct_gsmap_lsize(gsmap_extend,MPI_COMM_ICE)) then + write(nu_diag,*) subname,' :: gsmap_extend extended ',lsize_loc, & + mct_gsmap_lsize(gsmap_extend,MPI_COMM_ICE) + call shr_sys_abort(subname//' :: error in gsmap_extend extended') + endif + + call mct_rearr_init(gsmap_ice, gsmap_extend, MPI_COMM_ICE, rearr_ice2iloc) + call mct_rearr_init(gsmap_extend, gsmap_ice, MPI_COMM_ICE, rearr_iloc2ice) + call mct_aVect_init(x2i_iloc, rList=seq_flds_x2i_fields, lsize=lsize_loc) + call mct_aVect_zero(x2i_iloc) + call mct_aVect_init(i2x_iloc, rList=seq_flds_i2x_fields, lsize=lsize_loc) + call mct_aVect_zero(i2x_iloc) + call mct_gsmap_clean(gsmap_extend) + + other_cplgrid = .true. + nxg = nxcpl + nyg = nycpl + endif + + ! Inialize mct attribute vectors + + call mct_aVect_init(x2i_i, rList=seq_flds_x2i_fields, lsize=lsize) + call mct_aVect_zero(x2i_i) + + call mct_aVect_init(i2x_i, rList=seq_flds_i2x_fields, lsize=lsize) + call mct_aVect_zero(i2x_i) + + !----------------------------------------------------------------- + ! Prescribed ice initialization + !----------------------------------------------------------------- + + if (other_cplgrid) then + call ice_prescribed_init(ICEID, gsmap_iloc, dom_iloc) + else + call ice_prescribed_init(ICEID, gsmap_ice, dom_i) + endif + + !--------------------------------------------------------------------------- + ! Fill in export state for driver + !--------------------------------------------------------------------------- + + if (other_cplgrid) then + call ice_export (i2x_iloc%rattr) !Send initial state to driver + call ice_setdef_mct ( i2x_i ) + call mct_rearr_rearrange(i2x_iloc, i2x_i, rearr_iloc2ice) + else + call ice_export (i2x_i%rattr) !Send initial state to driver + endif + ! tcraig: iceberg_prognostic is false by default in cesm1.3 + ! not explicitly setting it here makes cice5 work in cesm1.1 + ! call seq_infodata_PutData( infodata, ice_prognostic=.true., & + ! iceberg_prognostic=.false., ice_nx = nxg, ice_ny = nyg ) + call seq_infodata_PutData( infodata, ice_prognostic=.true., & + ice_nx = nxg, ice_ny = nyg ) + call t_stopf ('cice_mct_init') + + ! Error check + if (tr_aero .and. .not. atm_aero) then + write(nu_diag,*) 'ice_import ERROR: atm_aero must be set for tr_aero' + call shr_sys_abort() + end if + + !--------------------------------------------------------------------------- + ! Reset shr logging to original values + !--------------------------------------------------------------------------- + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + + call t_stopf ('cice_init_total') + + ! call ice_timer_stop(timer_total) ! time entire run + ! call shr_get_memusage(msize,mrss) + ! call shr_mpi_max(mrss, mrss0, MPI_COMM_ICE,trim(subname)//' mrss0') + ! call shr_mpi_max(msize,msize0,MPI_COMM_ICE,trim(subname)//' msize0') + ! if(my_task == 0) then + ! write(shrlogunit,105) trim(subname)//': memory_write: model date = ',start_ymd,start_tod, & + ! ' memory = ',msize0,' MB (highwater) ',mrss0,' MB (usage)' + ! endif + + 105 format( A, 2i8, A, f10.2, A, f10.2, A) + + end subroutine ice_init_mct + +!--------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ice_run_mct +! +! !INTERFACE: + subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i ) +! +! !DESCRIPTION: +! Run thermodynamic CICE +! +! !USES: + use ice_history + use ice_restart + use ice_diagnostics + use ice_restoring , only : restore_ice, ice_HaloRestore + use ice_shortwave , only : init_shortwave + +! !ARGUMENTS: + type(ESMF_Clock),intent(inout) :: EClock + type(seq_cdata), intent(inout) :: cdata_i + type(mct_aVect), intent(inout) :: x2i_i + type(mct_aVect), intent(inout) :: i2x_i + +! !LOCAL VARIABLES: + integer :: k ! index + logical :: stop_now ! .true. ==> stop at the end of this run phase + integer :: ymd ! Current date (YYYYMMDD) + integer :: tod ! Current time of day (sec) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: ymd_sync ! Current year of sync clock + integer :: curr_ymd ! Current date (YYYYMMDD) + integer :: curr_tod ! Current time of day (s) + integer :: shrlogunit,shrloglev ! old values + integer :: lbnum + integer :: n, nyrp + type(mct_gGrid) , pointer :: dom_i + type(seq_infodata_type), pointer :: infodata + type(mct_gsMap) , pointer :: gsMap_i + character(len=char_len_long) :: fname + character(len=char_len_long) :: string1, string2 + character(len=*), parameter :: SubName = "ice_run_mct" + + real(r8) :: mrss, mrss0,msize,msize0 + logical, save :: first_time = .true. + +! +! !REVISION HISTORY: +! Author: Jacob Sewall, Mariana Vertenstein +! +!EOP +!--------------------------------------------------------------------------- + + call ice_timer_start(timer_total) ! time entire run + call t_barrierf('cice_run_total_BARRIER',MPI_COMM_ICE) + call t_startf ('cice_run_total') + + !--------------------------------------------------------------------------- + ! Reset shr logging to my log file + !--------------------------------------------------------------------------- + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (nu_diag) + + call seq_cdata_setptrs(cdata_i, infodata=infodata, dom=dom_i, & + gsMap=gsMap_i) + + ! Determine time of next atmospheric shortwave calculation + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + + if (my_task == master_task) then + write(nu_diag,*) trim(subname),' cice istep, nextsw_cday = ',istep, nextsw_cday + end if + + ! Determine orbital parameters + call seq_infodata_GetData(infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & + orb_lambm0=lambm0, orb_obliqr=obliqr) + + ! Get clock information + call seq_timemgr_EClockGetData(EClock, & + curr_ymd=curr_ymd, curr_tod=curr_tod) + + force_restart_now = seq_timemgr_RestartAlarmIsOn(EClock) + + !------------------------------------------------------------------- + ! get import state + !------------------------------------------------------------------- + + call t_barrierf('cice_run_import_BARRIER',MPI_COMM_ICE) + call t_startf ('cice_run_import') + call ice_timer_start(timer_cplrecv) + if (other_cplgrid) then + call mct_rearr_rearrange(x2i_i, x2i_iloc, rearr_ice2iloc) + call ice_import( x2i_iloc%rattr ) + else + call ice_import( x2i_i%rattr ) + endif + call ice_timer_stop(timer_cplrecv) + call t_stopf ('cice_run_import') + + !-------------------------------------------------------------------- + ! timestep update + !-------------------------------------------------------------------- + + call CICE_Run() + + !----------------------------------------------------------------- + ! send export state to driver + !----------------------------------------------------------------- + + call t_barrierf('cice_run_export_BARRIER',MPI_COMM_ICE) + call t_startf ('cice_run_export') + call ice_timer_start(timer_cplsend) + if (other_cplgrid) then + call ice_export ( i2x_iloc%rattr ) + call ice_setdef_mct ( i2x_i ) + call mct_rearr_rearrange(i2x_iloc, i2x_i, rearr_iloc2ice) + else + call ice_export ( i2x_i%rattr ) + endif + call ice_timer_stop(timer_cplsend) + call t_stopf ('cice_run_export') + + !-------------------------------------------------------------------- + ! check that internal clock is in sync with master clock + !-------------------------------------------------------------------- + + tod = sec + ymd = idate + if (.not. seq_timemgr_EClockDateInSync( EClock, ymd, tod )) then + call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, & + curr_tod=tod_sync ) + write(nu_diag,*)' cice ymd=',ymd ,' cice tod= ',tod + write(nu_diag,*)' sync ymd=',ymd_sync,' sync tod= ',tod_sync + call shr_sys_abort( SubName// & + ":: Internal sea-ice clock not in sync with Sync Clock") + end if + + ! reset shr logging to my original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + + !------------------------------------------------------------------- + ! stop timers and print timer info + !------------------------------------------------------------------- + ! Need to have this logic here instead of in ice_final_mct since + ! the ice_final_mct.F90 will still be called even in aqua-planet mode + ! Could put this logic in the driver - but it seems easier here + + ! Need to stop this at the end of every run phase in a coupled run. + call ice_timer_stop(timer_total) ! stop timing + + stop_now = seq_timemgr_StopAlarmIsOn( EClock ) + if (stop_now) then + call ice_timer_print_all(stats=.true.) ! print timing information + call release_all_fileunits + end if + +! if(tod == 0) then +! call shr_get_memusage(msize,mrss) +! call shr_mpi_max(mrss, mrss0, MPI_COMM_ICE,trim(subname)//' mrss0') +! call shr_mpi_max(msize,msize0,MPI_COMM_ICE,trim(subname)//' msize0') +! if(my_task == 0 ) then +! write(shrlogunit,105) trim(subname)//': memory_write: model date = ',ymd,tod, & +! ' memory = ',msize0,' MB (highwater) ',mrss0,' MB (usage)' +! endif +! endif + call t_stopf ('cice_run_total') + + 105 format( A, 2i8, A, f10.2, A, f10.2, A) + + end subroutine ice_run_mct + +!--------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ice_final_mct +! +! !INTERFACE: + subroutine ice_final_mct( EClock, cdata_i, x2i_i, i2x_i ) +! +! !DESCRIPTION: +! Finalize CICE +! +! !USES: +! +!------------------------------------------------------------------------------ +!BOP +! +! !ARGUMENTS: + + type(ESMF_Clock),intent(inout) :: EClock + type(seq_cdata), intent(inout) :: cdata_i + type(mct_aVect), intent(inout) :: x2i_i + type(mct_aVect), intent(inout) :: i2x_i +! +! !REVISION HISTORY: +! +!EOP +!--------------------------------------------------------------------------- + + + end subroutine ice_final_mct + +!=============================================================================== + + subroutine ice_SetGSMap_mct( mpicom, ID, gsMap_ice, xoff, yoff, nxgin, nygin ) + + !------------------------------------------------------------------- + ! + ! Arguments + ! + integer , intent(in) :: mpicom + integer , intent(in) :: ID + type(mct_gsMap), intent(inout) :: gsMap_ice + integer,optional, intent(in) :: xoff ! x offset + integer,optional, intent(in) :: yoff ! y offset + integer,optional, intent(in) :: nxgin ! global size + integer,optional, intent(in) :: nygin ! global size + ! + ! Local variables + ! + integer,allocatable :: gindex(:) + integer :: lat + integer :: lon + integer :: i, j, iblk, n, gi + integer :: lsize,gsize + integer :: lxoff,lyoff,nxg,nyg + integer :: ier + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type(block) :: this_block ! block information for current block + !------------------------------------------------------------------- + + ! Build the CICE grid numbering for MCT + ! NOTE: Numbering scheme is: West to East and South to North + ! starting at south pole. Should be the same as what's used + ! in SCRIP + + lxoff = 1 + lyoff = 1 + if (present(xoff)) then + lxoff = xoff + endif + if (present(yoff)) then + lyoff = yoff + endif + + nxg = nx_global + nyg = ny_global + if (present(nxgin)) then + nxg = nxgin + endif + if (present(nygin)) then + nyg = nygin + endif + gsize = nxg*nyg + + ! number the local grid + + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + enddo !i + enddo !j + enddo !iblk + lsize = n + + allocate(gindex(lsize),stat=ier) + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + lon = this_block%i_glob(i) + lxoff - 1 + lat = this_block%j_glob(j) + lyoff - 1 + gi = (lat-1)*nxg + lon + gindex(n) = gi + enddo !i + enddo !j + enddo !iblk + + call mct_gsMap_init( gsMap_ice, gindex, mpicom, ID, lsize, gsize ) + + deallocate(gindex) + + end subroutine ice_SetGSMap_mct + + subroutine ice_domain_mct( lsize, gsMap_i, dom_i ) + + !------------------------------------------------------------------- + ! + ! Arguments + ! + integer , intent(in) :: lsize + type(mct_gsMap), intent(in) :: gsMap_i + type(mct_ggrid), intent(inout) :: dom_i + ! + ! Local Variables + ! + integer :: i, j, iblk, n, gi ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + real(dbl_kind), pointer :: work_dom(:) ! temporary + real(dbl_kind), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + type(block) :: this_block ! block information for current block + !------------------------------------------------------------------- + ! + ! Initialize mct domain type + ! lat/lon in degrees, area in radians^2, mask is 1 (ocean), 0 (non-ocean) + ! + call mct_gGrid_init(GGrid=dom_i, CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize ) + call mct_aVect_zero(dom_i%data) + ! + allocate(data(lsize)) + ! + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + ! + call mct_gsMap_orderedPoints(gsMap_i, my_task, idata) + call mct_gGrid_importIAttr(dom_i,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_i,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_i,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_i,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_i,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_i,"mask",data,lsize) + call mct_gGrid_importRAttr(dom_i,"frac",data,lsize) + ! + ! Fill in correct values for domain components + ! + allocate(work_dom(lsize)) + work_dom(:) = 0.0_dbl_kind + + data(:) = -9999.0_R8 + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + data(n) = TLON(i,j,iblk)*rad_to_deg + enddo !i + enddo !j + enddo !iblk + call mct_gGrid_importRattr(dom_i,"lon",data,lsize) + + data(:) = -9999.0_R8 + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + data(n) = TLAT(i,j,iblk)*rad_to_deg + enddo !i + enddo !j + enddo !iblk + call mct_gGrid_importRattr(dom_i,"lat",data,lsize) + + data(:) = -9999.0_R8 + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + data(n) = tarea(i,j,iblk)/(radius*radius) + enddo !i + enddo !j + enddo !iblk + call mct_gGrid_importRattr(dom_i,"area",data,lsize) + + data(:) = 0.0_R8 + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + data(n) = real(nint(hm(i,j,iblk)),kind=dbl_kind) + enddo !i + enddo !j + enddo !iblk + call mct_gGrid_importRattr(dom_i,"mask",data,lsize) + + data(:) = 0.0_R8 + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + if (trim(grid_type) == 'latlon') then + data(n) = ocn_gridcell_frac(i,j,iblk) + else + data(n) = real(nint(hm(i,j,iblk)),kind=dbl_kind) + end if + enddo !i + enddo !j + enddo !iblk + call mct_gGrid_importRattr(dom_i,"frac",data,lsize) + + deallocate(data) + deallocate(idata) + deallocate(work_dom) + + end subroutine ice_domain_mct + + !======================================================================= + + subroutine ice_setdef_mct( i2x_i ) + + !----------------------------------------------------- + type(mct_aVect) , intent(inout) :: i2x_i + + !----------------------------------------------------- + + call mct_aVect_zero(i2x_i) + + ! tcraig : this is where observations could be read in + + end subroutine ice_setdef_mct + + !======================================================================= + + subroutine ice_coffset_mct(xoff,yoff,gsmap_a,dom_a,gsmap_b,dom_b,mpicom_i) + + integer , intent(out) :: xoff + integer , intent(out) :: yoff + type(mct_gsmap), intent(in) :: gsmap_a + type(mct_ggrid), intent(in) :: dom_a + type(mct_gsmap), intent(in) :: gsmap_b + type(mct_ggrid), intent(in) :: dom_b + integer , intent(in) :: mpicom_i + + type(mct_aVect) :: ava + type(mct_aVect) :: avag + integer :: k1,k2,k + integer :: npt + integer :: noff,noffg + real(dbl_kind) :: x1,y1,x2,y2 + real(dbl_kind) :: dist,distmin,distming + integer :: lsizea,lsizeb + integer :: iam,ierr + integer, pointer :: ipoints(:) + character(len=*),parameter :: subname = "ice_coffset_mct" + + call mpi_comm_rank(mpicom_i,iam,ierr) + + lsizea = mct_aVect_lsize(dom_a%data) + lsizeb = mct_aVect_lsize(dom_b%data) + + !--- compute lon/lat at dom_a (local) point (1,1) + + call mct_aVect_init(ava,rList='lon:lat',lsize=lsizea) + call mct_aVect_copy(dom_a%data,ava,'lon:lat') + call mct_aVect_gather(ava,avag,gsmap_a,0,mpicom_i) + + if (iam == 0) then + k1 = mct_aVect_indexRA(avag,'lon',dieWith=subname//'_avag') + k2 = mct_aVect_indexRA(avag,'lat',dieWith=subname//'_avag') + npt = 1 ! actual corner points screwed up by U average/wraparound + npt = nx_global + 2 ! use global point (2,2) + x1 = mod(avag%rAttr(k1,npt)+360.0_r8,360.0_r8) + y1 = avag%rAttr(k2,npt) + endif + + call mct_aVect_clean(avag) + call mct_aVect_clean(ava) + + call shr_mpi_bcast(x1,mpicom_i) + call shr_mpi_bcast(y1,mpicom_i) + + !--- find x1,y1 point in dom_b (extended grid) + + noff = -1 + noffg = -1 + + call mct_gsMap_orderedPoints(gsMap_b, iam, ipoints) + if (size(ipoints) /= lsizeb) then + write(nu_diag,*) subname,' size ipoints = ',size(ipoints),lsizeb + call shr_sys_abort(subname//' :: error size of ipoints') + endif + + k1 = mct_aVect_indexRA(dom_b%data,'lon',dieWith=subname//'_domb') + k2 = mct_aVect_indexRA(dom_b%data,'lat',dieWith=subname//'_domb') + distmin = 1.0e36 + do k = 1,lsizeb + x2 = mod(dom_b%data%rAttr(k1,k)+360.0_r8,360.0_r8) + y2 = dom_b%data%rAttr(k2,k) + dist = abs((x1-x2)*(x1-x2))+abs((y1-y2)*(y1-y2)) + if (dist < distmin) then + distmin = dist + noff = ipoints(k) + endif + dist = abs((x1-x2-360.0_r8)*(x1-x2-360.0_r8))+abs((y1-y2)*(y1-y2)) + if (dist < distmin) then + distmin = dist + noff = ipoints(k) + endif + dist = abs((x1-x2+360.0_r8)*(x1-x2+360.0_r8))+abs((y1-y2)*(y1-y2)) + if (dist < distmin) then + distmin = dist + noff = ipoints(k) + endif + enddo + + deallocate(ipoints) + + call shr_mpi_min(distmin,distming,mpicom_i,'distmin',all=.true.) + + if (distming /= distmin) then + noff = -1 + endif + + call shr_mpi_max(noff,noffg,mpicom_i,'noffg',all=.true.) + + ! subtract extra -1 and -nxcpl for point (2,2) + xoff = mod(noffg-1-1,nxcpl) + 1 + yoff = (noffg-1-nxcpl)/nxcpl + 1 + + if (iam == 0) then + write(nu_diag,*) subname,' :: x1,y1 = ',x1,y1 + write(nu_diag,*) subname,' :: offset = ',noffg,xoff,yoff + call shr_sys_flush(nu_diag) + endif + + if (noffg < 1) then + call shr_sys_abort(subname//' :: noffg lt 1') + endif + + end subroutine ice_coffset_mct + + !======================================================================= + + subroutine ice_setcoupling_mct(mpicom_i, ICEID, gsmap_i, dom_i) + + include 'netcdf.inc' + + integer , intent(in) :: mpicom_i + integer , intent(in) :: ICEID + type(mct_gsmap), intent(inout) :: gsmap_i + type(mct_ggrid), intent(inout) :: dom_i + + integer :: n ! counter + integer :: iam ! pe rank + integer :: npes ! number of pes + integer :: ierr ! error code + integer :: rcode ! error code + integer :: nx,ny ! grid size + integer :: gsize ! global size + integer :: lsize ! local size + integer, pointer :: start(:),length(:),pe_loc(:) + integer, pointer :: idata(:) + real(dbl_kind),pointer :: data(:) + type(mct_avect) :: avg, av1 + integer :: fid,did,vid + character(len=8) :: avfld,dofld + character(len=*), parameter :: SubName = "ice_setcoupling_mct" + + call MPI_comm_rank(mpicom_i,iam,ierr) + call MPI_comm_size(mpicom_i,npes,ierr) + + allocate(start(npes),length(npes),pe_loc(npes)) + + if (iam == 0) then + rcode = nf_open(gridcpl_file(1:len_trim(gridcpl_file)),NF_NOWRITE,fid) + rcode = nf_inq_dimid (fid, 'ni', did) + rcode = nf_inq_dimlen(fid, did, nx) + rcode = nf_inq_dimid (fid, 'nj', did) + rcode = nf_inq_dimlen(fid, did, ny) + gsize = nx*ny + nxcpl = nx + nycpl = ny + + length = gsize / npes + do n = 1,npes + if (n <= mod(gsize,npes)) length(n) = length(n) + 1 + enddo + + start(1) = 1 + pe_loc(1) = 0 + do n = 2,npes + pe_loc(n) = n-1 + start(n) = start(n-1) + length(n-1) + enddo + if ((start(npes) + length(npes) - 1) /= gsize) then + write(nu_diag,*) & + subname,' gsize, start, length = ',gsize,start(npes),length(npes) + call shr_sys_flush(nu_diag) + call shr_sys_abort( SubName//":: decomp inconsistent") + endif + + write(nu_diag,*) subname,' read ',trim(gridcpl_file) + write(nu_diag,*) subname,' size ',nx,ny,gsize + endif + + call shr_mpi_bcast(nxcpl,mpicom_i) + call shr_mpi_bcast(nycpl,mpicom_i) + call shr_mpi_bcast(gsize,mpicom_i) + call mct_gsmap_init(gsmap_i,npes,start,length,pe_loc,0,mpicom_i,ICEID,gsize) + deallocate(start,length,pe_loc) + + lsize = mct_gsmap_lsize(gsmap_i,mpicom_i) + call mct_gGrid_init(GGrid=dom_i, CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize ) + call mct_aVect_zero(dom_i%data) + + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + + call mct_gsMap_orderedPoints(gsMap_i, my_task, idata) + call mct_gGrid_importIAttr(dom_i,'GlobGridNum',idata,lsize) + deallocate(idata) + + ! Initialize attribute vector with special value + + allocate(data(lsize)) + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_i,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_i,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_i,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_i,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_i,"mask",data,lsize) + call mct_gGrid_importRAttr(dom_i,"frac",data,lsize) + deallocate(data) + + ! Read domain arrays + + if (iam == 0) then + call mct_avect_init(avg,rList='fld',lsize=gsize) + endif + + do n = 1,5 + + if (n == 1) avfld = 'lat' + if (n == 1) dofld = 'yc' + if (n == 2) avfld = 'lon' + if (n == 2) dofld = 'xc' + if (n == 3) avfld = 'area' + if (n == 3) dofld = 'area' + if (n == 4) avfld = 'frac' + if (n == 4) dofld = 'frac' + if (n == 5) avfld = 'mask' + if (n == 5) dofld = 'mask' + if (iam == 0) then + rcode = nf_inq_varid(fid,trim(dofld),vid) + if (n == 5) then + allocate(idata(gsize)) + rcode = nf_get_var_int(fid,vid,idata) + avg%rAttr(1,:) = idata + deallocate(idata) + else + rcode = nf_get_var_double(fid,vid,avg%rAttr(1,:)) + endif + endif + + call mct_aVect_scatter(avg,av1,gsmap_i,0,mpicom_i) + call mct_aVect_copy(av1,dom_i%data,'fld',avfld) + + if (iam == 0) then + call mct_avect_clean(av1) + endif + + enddo + + if (iam == 0) then + call mct_avect_clean(avg) + endif + + end subroutine ice_setcoupling_mct +!======================================================================= + +end module ice_comp_mct diff --git a/cicecore/drivers/mct/cesm2/ice_constants.F90 b/cicecore/drivers/mct/cesm2/ice_constants.F90 new file mode 100644 index 000000000..06584c537 --- /dev/null +++ b/cicecore/drivers/mct/cesm2/ice_constants.F90 @@ -0,0 +1,234 @@ +!======================================================================= +!BOP +! +! !MODULE: ice_constants - sets physical constants +! +! !DESCRIPTION: +! +! This module defines a variety of physical and numerical constants +! used throughout the ice model \\ +! +! Code originally based on constants.F in POP +! +! !REVISION HISTORY: +! SVN:$Id: ice_constants.F90 37 2006-11-29 18:06:44Z eclare $ +! +! author Elizabeth C. Hunke, LANL +! +! !INTERFACE: + + module ice_constants +! +! !USES: +! + use shr_const_mod + use ice_kinds_mod +! +!EOP +! + implicit none + save + + public + + !----------------------------------------------------------------- + ! physical constants + !----------------------------------------------------------------- + + real (kind=dbl_kind), parameter :: & + rhos = 330.0_dbl_kind ,&! density of snow (kg/m^3) + rhoi = SHR_CONST_RHOICE ,&! density of ice (kg/m^3) + rhow = SHR_CONST_RHOSW ,&! density of seawater (kg/m^3) + cp_air = SHR_CONST_CPDAIR ,&! specific heat of air (J/kg/K) + ! (Briegleb JGR 97 11475-11485 July 1992) + emissivity = 0.95_dbl_kind ,&! emissivity of snow and ice + cp_ice = SHR_CONST_CPICE ,&! specific heat of fresh ice (J/kg/K) + cp_ocn = SHR_CONST_CPSW ,&! specific heat of ocn (J/kg/K) + depressT = 0.054_dbl_kind ,&! Tf:brine salinity ratio (C/ppt) + dragio = 0.00536_dbl_kind ,&! ice-ocn drag coefficient + albocn = 0.06_dbl_kind ! ocean albedo + + real (kind=dbl_kind), parameter :: & + gravit = SHR_CONST_G ,&! gravitational acceleration (m/s^2) + omega = SHR_CONST_OMEGA ,&! angular velocity of earth (rad/sec) + radius = SHR_CONST_REARTH ! earth radius (m) + + real (kind=dbl_kind), parameter :: & + secday = SHR_CONST_CDAY ,&! seconds in calendar day + viscosity_dyn = 1.79e-3_dbl_kind,&! dynamic viscosity of brine (kg/m/s) + Tocnfrz= -34.0_dbl_kind*depressT,&! freezing temp of seawater (C), + ! used as Tsfcn for open water + rhofresh = SHR_CONST_RHOFW ,&! density of fresh water (kg/m^3) + zvir = SHR_CONST_ZVIR ,&! rh2o/rair - 1.0 + vonkar = SHR_CONST_KARMAN,&! von Karman constant + cp_wv = SHR_CONST_CPWV ,&! specific heat of water vapor (J/kg/K) + stefan_boltzmann = SHR_CONST_STEBOL,&! W/m^2/K^4 + Tffresh = SHR_CONST_TKFRZ ,&! freezing temp of fresh ice (K) + Lsub = SHR_CONST_LATSUB,&! latent heat, sublimation freshwater (J/kg) + Lvap = SHR_CONST_LATVAP,&! latent heat, vaporization freshwater (J/kg) + Lfresh = SHR_CONST_LATICE,&! latent heat of melting of fresh ice (J/kg) + Timelt = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ,&! melting temp. ice top surface (C) + Tsmelt = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ,&! melting temp. snow top surface (C) + ice_ref_salinity = SHR_CONST_ICE_REF_SAL ,&! (psu) +! ocn_ref_salinity = SHR_CONST_OCN_REF_SAL ,&! (psu) +! rho_air = SHR_CONST_RHODAIR,&! ambient air density (kg/m^3) + spval_dbl = SHR_CONST_SPVAL ! special value + + real (kind=real_kind), parameter :: & + spval = 1.0e30_real_kind ! special value for netCDF output + + real (kind=dbl_kind), parameter :: & + iceruf = 0.0005_dbl_kind ,&! default ice surface roughness (m) + + ! (Ebert, Schramm and Curry JGR 100 15965-15975 Aug 1995) + kappav = 1.4_dbl_kind ,&! vis extnctn coef in ice, wvlngth<700nm (1/m) + !kappan = 17.6_dbl_kind,&! vis extnctn coef in ice, wvlngth<700nm (1/m) + + kice = 2.03_dbl_kind ,&! thermal conductivity of fresh ice(W/m/deg) + kseaice= 2.00_dbl_kind ,&! thermal conductivity of sea ice (W/m/deg) + ! (used in zero layer thermodynamics option) + ksno = 0.30_dbl_kind ,&! thermal conductivity of snow (W/m/deg) + zref = 10._dbl_kind ,&! reference height for stability (m) +! hs0 = 0.03_dbl_kind, &! parameter for delta-Eddington snow frac +! hsmin = 0.0001_dbl_kind, &! minimum snow thickness for dEdd + hs_min = 1.e-4_dbl_kind ,&! min snow thickness for computing zTsn (m) + snowpatch = 0.005_dbl_kind ! parameter for fractional snow area (m) +!tcx note cice snowpatch = 0.02 + + ! weights for albedos + ! 4 Jan 2007 BPB Following are appropriate for complete cloud + ! in a summer polar atmosphere with 1.5m bare sea ice surface: + ! .636/.364 vis/nir with only 0.5% direct for each band. + real (kind=dbl_kind), parameter :: & ! currently used only + awtvdr = 0.00318_dbl_kind, &! visible, direct ! for history and + awtidr = 0.00182_dbl_kind, &! near IR, direct ! diagnostics + awtvdf = 0.63282_dbl_kind, &! visible, diffuse + awtidf = 0.36218_dbl_kind ! near IR, diffuse + + real (kind=dbl_kind), parameter :: & + qqqice = 11637800._dbl_kind ,&! for qsat over ice + TTTice = 5897.8_dbl_kind ,&! for qsat over ice + qqqocn = 627572.4_dbl_kind ,&! for qsat over ocn + TTTocn = 5107.4_dbl_kind ! for qsat over ocn + + ! these are currently set so as to have no effect on the decomposition + real (kind=dbl_kind), parameter :: & + shlat = 30.0_dbl_kind ,&! artificial masking edge (deg) + nhlat = -30.0_dbl_kind ! artificial masking edge (deg) + + !----------------------------------------------------------------- + ! numbers + !----------------------------------------------------------------- + + real (kind=dbl_kind), parameter :: & + c0 = 0.0_dbl_kind, & + c1 = 1.0_dbl_kind, & + c1p5 = 1.5_dbl_kind, & + c2 = 2.0_dbl_kind, & + c3 = 3.0_dbl_kind, & + c4 = 4.0_dbl_kind, & + c5 = 5.0_dbl_kind, & + c6 = 6.0_dbl_kind, & + c7 = 7.0_dbl_kind, & + c8 = 8.0_dbl_kind, & + c9 = 9.0_dbl_kind, & + c10 = 10.0_dbl_kind, & + c12 = 12.0_dbl_kind, & + c15 = 15.0_dbl_kind, & + c16 = 16.0_dbl_kind, & + c20 = 20.0_dbl_kind, & + c25 = 25.0_dbl_kind, & + c30 = 30.0_dbl_kind, & + c90 = 90.0_dbl_kind, & + c100 = 100.0_dbl_kind, & + c180 = 180.0_dbl_kind, & + c360 = 360.0_dbl_kind, & + c365 = 365.0_dbl_kind, & + c400 = 400.0_dbl_kind, & + c3600= 3600.0_dbl_kind, & + c1000= 1000.0_dbl_kind, & + p001 = 0.001_dbl_kind, & + p01 = 0.01_dbl_kind, & + p025 = 0.025_dbl_kind, & + p1 = 0.1_dbl_kind, & + p2 = 0.2_dbl_kind, & + p4 = 0.4_dbl_kind, & + p5 = 0.5_dbl_kind, & + p6 = 0.6_dbl_kind, & + p05 = 0.05_dbl_kind, & + p15 = 0.15_dbl_kind, & + p25 = 0.25_dbl_kind, & + p75 = 0.75_dbl_kind, & + p166 = c1/c6, & + p333 = c1/c3, & + p666 = c2/c3, & + p111 = c1/c9, & + p055 = p111*p5, & + p027 = p055*p5, & + p222 = c2/c9, & + eps04 = 1.0e-4_dbl_kind, & + eps11 = 1.0e-11_dbl_kind, & + eps12 = 1.0e-12_dbl_kind, & + eps13 = 1.0e-13_dbl_kind, & + eps15 = 1.0e-15_dbl_kind, & + eps16 = 1.0e-16_dbl_kind, & + puny = eps11, & + bignum = 1.0e+30_dbl_kind, & + pi = SHR_CONST_PI ,&! pi + pih = p5*pi, & + piq = p5*pih, & + pi2 = c2*pi + + !----------------------------------------------------------------- + ! location of fields for staggered grids + !----------------------------------------------------------------- + + integer (int_kind), parameter :: & + field_loc_unknown = 0, & + field_loc_noupdate = -1, & + field_loc_center = 1, & + field_loc_NEcorner = 2, & + field_loc_Nface = 3, & + field_loc_Eface = 4, & + field_loc_Wface = 5 + + + !----------------------------------------------------------------- + ! field type attribute - necessary for handling + ! changes of direction across tripole boundary + !----------------------------------------------------------------- + + integer (int_kind), parameter :: & + field_type_unknown = 0, & + field_type_noupdate = -1, & + field_type_scalar = 1, & + field_type_vector = 2, & + field_type_angle = 3 + + !----------------------------------------------------------------- + ! conversion factors + !----------------------------------------------------------------- + + real (kind=dbl_kind), parameter :: & + cm_to_m = 0.01_dbl_kind ,&! cm to meters + m_to_cm = 100._dbl_kind ,&! meters to cm + m2_to_km2 = 1.e-6_dbl_kind ,&! m^2 to km^2 + kg_to_g = 1000._dbl_kind ,&! kilograms to grams + mps_to_cmpdy = 8.64e6_dbl_kind ,&! m per s to cm per day + rad_to_deg = 180._dbl_kind/pi ! degree-radian conversion + +#ifndef USE_ESMF + integer (kind=int_kind), parameter :: & + ESMF_SUCCESS = 0 ! otherwise ESMF defines this parameter +#endif + + ! useful for debugging + integer (kind=int_kind), parameter :: & + mtest = -999, itest = 1, jtest = 1, ntest = 1, btest = 1 +! mtest = 2, itest = 50, jtest = 53, ntest = 1, btest = 1 + +!======================================================================= + + end module ice_constants + +!======================================================================= diff --git a/cicecore/drivers/mct/cesm2/ice_cpl_indices.F90 b/cicecore/drivers/mct/cesm2/ice_cpl_indices.F90 new file mode 100644 index 000000000..08a86cc42 --- /dev/null +++ b/cicecore/drivers/mct/cesm2/ice_cpl_indices.F90 @@ -0,0 +1,256 @@ +module ice_cpl_indices + + use seq_flds_mod + use mct_mod + use ice_domain_size, only: ncat + use ice_flux, only: send_i2x_per_cat + + implicit none + + SAVE + public ! By default make data private + + ! ice -> drv + + integer :: index_i2x_Si_ifrac ! fractional ice coverage wrt ocean + integer :: index_i2x_Si_snowh ! snow height (m) + integer :: index_i2x_Si_t ! temperature + integer :: index_i2x_Si_tref ! 2m reference temperature + integer :: index_i2x_Si_qref ! 2m reference specific humidity + integer :: index_i2x_Si_logz0 ! surface roughness length (m) + integer :: index_i2x_Si_avsdr ! albedo: visible, direct + integer :: index_i2x_Si_avsdf ! albedo: near ir, direct + integer :: index_i2x_Si_anidr ! albedo: visible, diffuse + integer :: index_i2x_Si_anidf ! albedo: near ir, diffuse + integer :: index_i2x_Si_u10 ! 10m wind + integer :: index_i2x_Faii_lwup ! upward longwave heat flux + integer :: index_i2x_Faii_lat ! latent heat flux + integer :: index_i2x_Faii_sen ! sensible heat flux + integer :: index_i2x_Faii_evap ! evaporation water flux + integer :: index_i2x_Faii_taux ! wind stress, zonal + integer :: index_i2x_Faii_tauy ! wind stress, meridional + integer :: index_i2x_Faii_swnet ! sw: net + integer :: index_i2x_Fioi_swpen ! sw: net penetrating ice + integer :: index_i2x_Fioi_melth ! heat flux from melting ice (<0) + integer :: index_i2x_Fioi_meltw ! water flux from melting ice + integer :: index_i2x_Fioi_salt ! salt flux from meting ice + integer :: index_i2x_Fioi_taux ! ice/ocn stress, zonal + integer :: index_i2x_Fioi_tauy ! ice/ocn stress, zonal + integer :: index_i2x_Fioi_bcphi ! flux: Black Carbon hydrophilic deposition + integer :: index_i2x_Fioi_bcpho ! flux: Black Carbon hydrophobic deposition + integer :: index_i2x_Fioi_flxdst ! flux: Dust + + integer :: index_i2x_Si_ifrac_n(ncat) ! fractional ice coverage wrt ocean per thickness category + integer :: index_i2x_PFioi_swpen_ifrac_n(ncat) ! sw: net penetrating ice per thickness category + + integer :: index_i2x_Si_qref_HDO ! 2m reference specific humidity + integer :: index_i2x_Si_qref_16O ! 2m reference specific humidity + integer :: index_i2x_Si_qref_18O ! 2m reference specific humidity + integer :: index_i2x_Fioi_meltw_HDO ! isotope melt water flux + integer :: index_i2x_Fioi_meltw_16O ! isotope melt water flux + integer :: index_i2x_Fioi_meltw_18O ! isotope melt water flux + integer :: index_i2x_Faii_evap_HDO ! isotope evaporation water flux + integer :: index_i2x_Faii_evap_16O ! isotope evaporation water flux + integer :: index_i2x_Faii_evap_18O ! isotope evaporation water flux + + ! drv -> ice + + integer :: index_x2i_So_t ! ocn layer temperature + integer :: index_x2i_So_s ! ocn salinity + integer :: index_x2i_So_u ! ocn u velocity + integer :: index_x2i_So_v ! ocn v velocity + integer :: index_x2i_Sa_z ! bottom atm level height + integer :: index_x2i_Sa_u ! bottom atm level zon wind + integer :: index_x2i_Sa_v ! bottom atm level mer wind + integer :: index_x2i_Sa_tbot ! bottom atm level temp + integer :: index_x2i_Sa_pbot ! bottom atm level pressure + integer :: index_x2i_Sa_ptem ! bottom atm level pot temp + integer :: index_x2i_Sa_shum ! bottom atm level spec hum + integer :: index_x2i_Sa_dens ! bottom atm level air den + integer :: index_x2i_So_dhdx ! ocn surface slope, zonal + integer :: index_x2i_So_dhdy ! ocn surface slope, meridional + integer :: index_x2i_Faxa_lwdn ! downward lw heat flux + integer :: index_x2i_Faxa_rain ! prec: liquid + integer :: index_x2i_Faxa_snow ! prec: frozen + integer :: index_x2i_Faxa_swndr ! sw: nir direct downward + integer :: index_x2i_Faxa_swvdr ! sw: vis direct downward + integer :: index_x2i_Faxa_swndf ! sw: nir diffuse downward + integer :: index_x2i_Faxa_swvdf ! sw: vis diffuse downward + integer :: index_x2i_Faxa_swnet ! sw: net + integer :: index_x2i_Fioo_q ! ocn freeze or melt heat + integer :: index_x2i_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition + integer :: index_x2i_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition + integer :: index_x2i_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition + integer :: index_x2i_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition + integer :: index_x2i_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition + integer :: index_x2i_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition + integer :: index_x2i_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition + integer :: index_x2i_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition + integer :: index_x2i_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition + integer :: index_x2i_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition + integer :: index_x2i_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition + integer :: index_x2i_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition + integer :: index_x2i_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition + integer :: index_x2i_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition + + integer :: index_x2i_So_roce_HDO ! ocn: HDO + integer :: index_x2i_So_roce_16O ! ocn: H2_16O + integer :: index_x2i_So_roce_18O ! ocn: H2_18O + integer :: index_x2i_Sa_shum_16O ! bottom atm level spec hum + integer :: index_x2i_Sa_shum_18O ! bottom atm level spec hum + integer :: index_x2i_Sa_shum_HDO ! bottom atm level spec hum + integer :: index_x2i_Faxa_rain_16O ! flux: H2_16O + integer :: index_x2i_Faxa_rain_18O ! flux: H2_18O + integer :: index_x2i_Faxa_rain_HDO ! flux: HDO + integer :: index_x2i_Faxa_snow_16O ! flux: H2_16O + integer :: index_x2i_Faxa_snow_18O ! flux: H2_18O + integer :: index_x2i_Faxa_snow_HDO ! flux: HDO + + +contains + + subroutine ice_cpl_indices_set( ) + + type(mct_aVect) :: i2x ! temporary + type(mct_aVect) :: x2i ! temporary + + integer :: n ! thickness category index + character(len=2) :: cn ! character version of n + + ! Determine attribute vector indices + + ! create temporary attribute vectors + call mct_aVect_init(x2i, rList=seq_flds_x2i_fields, lsize=1) + call mct_aVect_init(i2x, rList=seq_flds_i2x_fields, lsize=1) + + index_i2x_Si_t = mct_avect_indexra(i2x,'Si_t') + index_i2x_Si_tref = mct_avect_indexra(i2x,'Si_tref') + index_i2x_Si_qref = mct_avect_indexra(i2x,'Si_qref') + index_i2x_Si_logz0 = mct_avect_indexra(i2x,'Si_logz0',perrWith='quiet') ! optional + index_i2x_Si_ifrac = mct_avect_indexra(i2x,'Si_ifrac') + index_i2x_Si_avsdr = mct_avect_indexra(i2x,'Si_avsdr') + index_i2x_Si_anidr = mct_avect_indexra(i2x,'Si_anidr') + index_i2x_Si_avsdf = mct_avect_indexra(i2x,'Si_avsdf') + index_i2x_Si_anidf = mct_avect_indexra(i2x,'Si_anidf') + index_i2x_Si_snowh = mct_avect_indexra(i2x,'Si_snowh') + index_i2x_Si_u10 = mct_avect_indexra(i2x,'Si_u10') + index_i2x_Faii_taux = mct_avect_indexra(i2x,'Faii_taux') + index_i2x_Faii_tauy = mct_avect_indexra(i2x,'Faii_tauy') + index_i2x_Faii_lat = mct_avect_indexra(i2x,'Faii_lat') + index_i2x_Faii_sen = mct_avect_indexra(i2x,'Faii_sen') + index_i2x_Faii_lwup = mct_avect_indexra(i2x,'Faii_lwup') + index_i2x_Faii_evap = mct_avect_indexra(i2x,'Faii_evap') + index_i2x_Faii_swnet = mct_avect_indexra(i2x,'Faii_swnet') + index_i2x_Fioi_swpen = mct_avect_indexra(i2x,'Fioi_swpen') + index_i2x_Fioi_melth = mct_avect_indexra(i2x,'Fioi_melth') + index_i2x_Fioi_meltw = mct_avect_indexra(i2x,'Fioi_meltw') + index_i2x_Fioi_salt = mct_avect_indexra(i2x,'Fioi_salt') + index_i2x_Fioi_taux = mct_avect_indexra(i2x,'Fioi_taux') + index_i2x_Fioi_tauy = mct_avect_indexra(i2x,'Fioi_tauy') + index_i2x_Fioi_bcphi = mct_avect_indexra(i2x,'Fioi_bcphi',perrWith='quiet') + index_i2x_Fioi_bcpho = mct_avect_indexra(i2x,'Fioi_bcpho',perrWith='quiet') + index_i2x_Fioi_flxdst = mct_avect_indexra(i2x,'Fioi_flxdst',perrWith='quiet') + +! Needed for ISOTOPES. + + index_i2x_Fioi_meltw_HDO = 0 + index_i2x_Fioi_meltw_16O = 0 + index_i2x_Fioi_meltw_18O = 0 + index_i2x_Faii_evap_HDO = 0 + index_i2x_Faii_evap_16O = 0 + index_i2x_Faii_evap_18O = 0 + index_i2x_Si_qref_HDO = 0 + index_i2x_Si_qref_16O = 0 + index_i2x_Si_qref_18O = 0 +! index_i2x_Fioi_meltw_HDO = mct_avect_indexra(i2x,'Fioi_meltw_HDO') +! index_i2x_Fioi_meltw_16O = mct_avect_indexra(i2x,'Fioi_meltw_16O') +! index_i2x_Fioi_meltw_18O = mct_avect_indexra(i2x,'Fioi_meltw_18O') +! index_i2x_Faii_evap_HDO = mct_avect_indexra(i2x,'Faii_evap_HDO') +! index_i2x_Faii_evap_16O = mct_avect_indexra(i2x,'Faii_evap_16O') +! index_i2x_Faii_evap_18O = mct_avect_indexra(i2x,'Faii_evap_18O') +! index_i2x_Si_qref_HDO = mct_avect_indexra(i2x,'Si_qref_HDO') +! index_i2x_Si_qref_16O = mct_avect_indexra(i2x,'Si_qref_16O') +! index_i2x_Si_qref_18O = mct_avect_indexra(i2x,'Si_qref_18O') + + ! optional per thickness category fields + + send_i2x_per_cat = seq_flds_i2o_per_cat + + if (send_i2x_per_cat) then + do n = 1, ncat + write(cn,'(i2.2)') n + index_i2x_Si_ifrac_n(n) = mct_avect_indexra(i2x,'Si_ifrac_'//cn) + index_i2x_PFioi_swpen_ifrac_n(n) = mct_avect_indexra(i2x,'PFioi_swpen_ifrac_'//cn) + end do + end if + + index_x2i_So_t = mct_avect_indexra(x2i,'So_t') + index_x2i_So_s = mct_avect_indexra(x2i,'So_s') + index_x2i_So_u = mct_avect_indexra(x2i,'So_u') + index_x2i_So_v = mct_avect_indexra(x2i,'So_v') + index_x2i_Sa_z = mct_avect_indexra(x2i,'Sa_z') + index_x2i_Sa_u = mct_avect_indexra(x2i,'Sa_u') + index_x2i_Sa_v = mct_avect_indexra(x2i,'Sa_v') + index_x2i_Sa_tbot = mct_avect_indexra(x2i,'Sa_tbot') + index_x2i_Sa_ptem = mct_avect_indexra(x2i,'Sa_ptem') + index_x2i_Sa_pbot = mct_avect_indexra(x2i,'Sa_pbot') + index_x2i_Sa_shum = mct_avect_indexra(x2i,'Sa_shum') + index_x2i_Sa_dens = mct_avect_indexra(x2i,'Sa_dens') + index_x2i_So_dhdx = mct_avect_indexra(x2i,'So_dhdx') + index_x2i_So_dhdy = mct_avect_indexra(x2i,'So_dhdy') + index_x2i_Faxa_lwdn = mct_avect_indexra(x2i,'Faxa_lwdn') + index_x2i_Faxa_rain = mct_avect_indexra(x2i,'Faxa_rain') + index_x2i_Faxa_snow = mct_avect_indexra(x2i,'Faxa_snow') + index_x2i_Faxa_swndr = mct_avect_indexra(x2i,'Faxa_swndr') + index_x2i_Faxa_swvdr = mct_avect_indexra(x2i,'Faxa_swvdr') + index_x2i_Faxa_swndf = mct_avect_indexra(x2i,'Faxa_swndf') + index_x2i_Faxa_swvdf = mct_avect_indexra(x2i,'Faxa_swvdf') + index_x2i_Fioo_q = mct_avect_indexra(x2i,'Fioo_q') + index_x2i_Faxa_bcphidry = mct_avect_indexra(x2i,'Faxa_bcphidry') + index_x2i_Faxa_bcphodry = mct_avect_indexra(x2i,'Faxa_bcphodry') + index_x2i_Faxa_bcphiwet = mct_avect_indexra(x2i,'Faxa_bcphiwet') + index_x2i_Faxa_ocphidry = mct_avect_indexra(x2i,'Faxa_ocphidry') + index_x2i_Faxa_ocphodry = mct_avect_indexra(x2i,'Faxa_ocphodry') + index_x2i_Faxa_ocphiwet = mct_avect_indexra(x2i,'Faxa_ocphiwet') + index_x2i_Faxa_dstdry1 = mct_avect_indexra(x2i,'Faxa_dstdry1') + index_x2i_Faxa_dstdry2 = mct_avect_indexra(x2i,'Faxa_dstdry2') + index_x2i_Faxa_dstdry3 = mct_avect_indexra(x2i,'Faxa_dstdry3') + index_x2i_Faxa_dstdry4 = mct_avect_indexra(x2i,'Faxa_dstdry4') + index_x2i_Faxa_dstwet1 = mct_avect_indexra(x2i,'Faxa_dstwet1') + index_x2i_Faxa_dstwet2 = mct_avect_indexra(x2i,'Faxa_dstwet2') + index_x2i_Faxa_dstwet3 = mct_avect_indexra(x2i,'Faxa_dstwet3') + index_x2i_Faxa_dstwet4 = mct_avect_indexra(x2i,'Faxa_dstwet4') + +! Needed for ISOTOPES. + + index_x2i_Sa_shum_16O = 0 + index_x2i_Sa_shum_18O = 0 + index_x2i_Sa_shum_HDO = 0 + index_x2i_Faxa_rain_16O = 0 + index_x2i_Faxa_rain_18O = 0 + index_x2i_Faxa_rain_HDO = 0 + index_x2i_Faxa_snow_16O = 0 + index_x2i_Faxa_snow_18O = 0 + index_x2i_Faxa_snow_HDO = 0 + index_x2i_So_roce_16O = 0 + index_x2i_So_roce_18O = 0 + index_x2i_So_roce_HDO = 0 +! index_x2i_Sa_shum_16O = mct_avect_indexra(x2i,'Sa_shum_16O') +! index_x2i_Sa_shum_18O = mct_avect_indexra(x2i,'Sa_shum_18O') +! index_x2i_Sa_shum_HDO = mct_avect_indexra(x2i,'Sa_shum_HDO') +! index_x2i_Faxa_rain_16O = mct_avect_indexra(x2i,'Faxa_rain_16O') +! index_x2i_Faxa_rain_18O = mct_avect_indexra(x2i,'Faxa_rain_18O') +! index_x2i_Faxa_rain_HDO = mct_avect_indexra(x2i,'Faxa_rain_HDO') +! index_x2i_Faxa_snow_16O = mct_avect_indexra(x2i,'Faxa_snow_16O') +! index_x2i_Faxa_snow_18O = mct_avect_indexra(x2i,'Faxa_snow_18O') +! index_x2i_Faxa_snow_HDO = mct_avect_indexra(x2i,'Faxa_snow_HDO') +! index_x2i_So_roce_16O = mct_avect_indexra(x2i,'So_roce_16O') +! index_x2i_So_roce_18O = mct_avect_indexra(x2i,'So_roce_18O') +! index_x2i_So_roce_HDO = mct_avect_indexra(x2i,'So_roce_HDO') + + call mct_aVect_clean(x2i) + call mct_aVect_clean(i2x) + + end subroutine ice_cpl_indices_set + +end module ice_cpl_indices diff --git a/cicecore/drivers/mct/cesm2/ice_import_export.F90 b/cicecore/drivers/mct/cesm2/ice_import_export.F90 new file mode 100644 index 000000000..056b27485 --- /dev/null +++ b/cicecore/drivers/mct/cesm2/ice_import_export.F90 @@ -0,0 +1,767 @@ +module ice_import_export + + use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl + use shr_sys_mod , only: shr_sys_abort, shr_sys_flush + use shr_frz_mod + use ice_kinds_mod , only: int_kind, dbl_kind, char_len_long, log_kind + use ice_constants , only: c0, c1, puny, tffresh, spval_dbl + use ice_constants , only: field_loc_center, field_type_scalar + use ice_constants , only: field_type_vector, c100 + use ice_constants , only: vonkar, zref, iceruf + use ice_constants , only: p001 + use ice_blocks , only: block, get_block, nx_block, ny_block + use ice_flux , only: strairxt, strairyt, strocnxt, strocnyt + use ice_flux , only: alvdr, alidr, alvdf, alidf, Tref, Qref, Uref + use ice_flux , only: flat, fsens, flwout, evap, fswabs, fhocn, fswthru + use ice_flux , only: fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa + use ice_flux , only: rhoa, swvdr, swvdf, swidr, swidf, flw, frain + use ice_flux , only: fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt + use ice_flux , only: sss, tf, wind, fsw, init_flux_atm, init_flux_ocn + use ice_flux , only: faero_atm, faero_ocn + use ice_flux , only: fiso_atm, fiso_ocn, fiso_rain, fiso_evap, & + Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn + use ice_flux , only: send_i2x_per_cat, fswthrun_ai + use ice_init , only: atm2ice_fmap_is_pos_def, atm2ice_smap_is_pos_def + use ice_ocean , only: tfrz_option + use ice_atmo , only: Cdn_atm + use ice_state , only: vice, vsno, aice, aicen_init, trcr + use ice_state , only: tr_aero, tr_iso, tr_iage, tr_FY, tr_pond, tr_lvl + use ice_domain , only: nblocks, blocks_ice, halo_info, distrb_info + use ice_domain_size , only: nx_global, ny_global, block_size_x, block_size_y, max_blocks, ncat + use ice_grid , only: tlon, tlat, tarea, tmask, anglet, hm + use ice_grid , only: grid_type, t2ugrid_vector + use ice_boundary , only: ice_HaloUpdate + use ice_fileunits , only: nu_diag + use ice_prescribed_mod + use ice_cpl_indices + use ice_communicate , only: my_task, master_task, MPI_COMM_ICE + use ice_calendar , only: idate, sec + use perf_mod , only: t_startf, t_stopf, t_barrierf + + implicit none + public + +#ifdef RASM_MODS +! (1) Andrew Roberts: Added artificial correction to snow and rain division +! This is to be consistent with VIC in the Regional Arctic System Model + logical, parameter :: rasm_snowrain_split = .true. +#else + logical, parameter :: rasm_snowrain_split = .false. +#endif + integer ,parameter :: debug = 0 ! internal debug level + character(*),parameter :: F01 = "('(ice_import_export) ',a,3(i8,2x),d21.14)" + +!============================================================================== +contains +!============================================================================== + + subroutine ice_import( x2i ) + + !----------------------------------------------------- + ! Arguments + real(r8), intent(inout) :: x2i(:,:) + ! + ! Local variables + integer :: i, j, iblk, n + integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain + type(block) :: this_block ! block information for current block + integer,parameter :: nflds=15,nfldv=6 + real (kind=dbl_kind),allocatable :: aflds(:,:,:,:) + real (kind=dbl_kind) :: workx, worky + real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP + logical (kind=log_kind) :: first_call = .true. + character(len=*),parameter :: subname = 'ice_import' + !----------------------------------------------------- + + ! Note that the precipitation fluxes received from the coupler + ! are in units of kg/s/m^2 which is what CICE requires. + ! Note also that the read in below includes only values needed + ! by the thermodynamic component of CICE. Variables uocn, vocn, + ! ss_tltx, and ss_tlty are excluded. Also, because the SOM and + ! DOM don't compute SSS. SSS is not read in and is left at + ! the initilized value (see ice_flux.F init_coupler_flux) of + ! 34 ppt + + ! Use aflds to gather the halo updates of multiple fields + ! Need to separate the scalar from the vector halo updates + + allocate(aflds(nx_block,ny_block,nflds,nblocks)) + aflds = c0 + + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + n = n+1 + aflds(i,j, 1,iblk) = x2i(index_x2i_So_t,n) + aflds(i,j, 2,iblk) = x2i(index_x2i_So_s,n) + aflds(i,j, 3,iblk) = x2i(index_x2i_Sa_z,n) + aflds(i,j, 4,iblk) = x2i(index_x2i_Sa_ptem,n) + aflds(i,j, 5,iblk) = x2i(index_x2i_Sa_tbot,n) + aflds(i,j, 6,iblk) = x2i(index_x2i_Sa_shum,n) + aflds(i,j, 7,iblk) = x2i(index_x2i_Sa_dens,n) + aflds(i,j, 8,iblk) = x2i(index_x2i_Fioo_q,n) + aflds(i,j, 9,iblk) = x2i(index_x2i_Faxa_swvdr,n) + aflds(i,j,10,iblk) = x2i(index_x2i_Faxa_swndr,n) + aflds(i,j,11,iblk) = x2i(index_x2i_Faxa_swvdf,n) + aflds(i,j,12,iblk) = x2i(index_x2i_Faxa_swndf,n) + aflds(i,j,13,iblk) = x2i(index_x2i_Faxa_lwdn,n) + aflds(i,j,14,iblk) = x2i(index_x2i_Faxa_rain,n) + aflds(i,j,15,iblk) = x2i(index_x2i_Faxa_snow,n) + + enddo !i + enddo !j + enddo !iblk + + if (.not.prescribed_ice) then + call t_startf ('cice_imp_halo') + call ice_HaloUpdate(aflds, halo_info, field_loc_center, & + field_type_scalar) + call t_stopf ('cice_imp_halo') + endif + + if (rasm_snowrain_split) then + MIN_RAIN_TEMP = Tffresh-c1 + MAX_SNOW_TEMP = Tffresh+c0 + endif + + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + sst (i,j,iblk) = aflds(i,j, 1,iblk) + sss (i,j,iblk) = aflds(i,j, 2,iblk) + zlvl (i,j,iblk) = aflds(i,j, 3,iblk) + potT (i,j,iblk) = aflds(i,j, 4,iblk) + Tair (i,j,iblk) = aflds(i,j, 5,iblk) + Qa (i,j,iblk) = aflds(i,j, 6,iblk) + rhoa (i,j,iblk) = aflds(i,j, 7,iblk) + frzmlt (i,j,iblk) = aflds(i,j, 8,iblk) + swvdr(i,j,iblk) = aflds(i,j, 9,iblk) + swidr(i,j,iblk) = aflds(i,j,10,iblk) + swvdf(i,j,iblk) = aflds(i,j,11,iblk) + swidf(i,j,iblk) = aflds(i,j,12,iblk) + flw (i,j,iblk) = aflds(i,j,13,iblk) + frain(i,j,iblk) = aflds(i,j,14,iblk) + fsnow(i,j,iblk) = aflds(i,j,15,iblk) + enddo !i + enddo !j + enddo !iblk + !$OMP END PARALLEL DO + + if (.not. atm2ice_smap_is_pos_def) then + Qa = max(Qa , c0) + rhoa = max(rhoa, c0) + end if + if (.not. atm2ice_fmap_is_pos_def) then + swvdr = max(swvdr, c0) + swidr = max(swidr, c0) + swvdf = max(swvdf, c0) + swidf = max(swidf, c0) + frain = max(frain, c0) + fsnow = max(fsnow, c0) + end if + + if (rasm_snowrain_split) then + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + !--- Artificial correction to snow and rain for RASM + if (Tair(i,j,iblk)MAX_SNOW_TEMP) then + frain(i,j,iblk)=fsnow(i,j,iblk)+frain(i,j,iblk) + fsnow(i,j,iblk)=0 + else + frain(i,j,iblk)=fsnow(i,j,iblk)+frain(i,j,iblk) + fsnow(i,j,iblk)=frain(i,j,iblk) + frain(i,j,iblk)=frain(i,j,iblk)*(Tair(i,j,iblk)-MIN_RAIN_TEMP) / & + (MAX_SNOW_TEMP-MIN_RAIN_TEMP) + fsnow(i,j,iblk)=fsnow(i,j,iblk)-frain(i,j,iblk) + endif + !--- end artificial RASM correction + enddo !i + enddo !j + enddo !iblk + !$OMP END PARALLEL DO + endif ! rasm_snowrain_split + + + deallocate(aflds) + allocate(aflds(nx_block,ny_block,nfldv,nblocks)) + aflds = c0 + + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + aflds(i,j, 1,iblk) = x2i(index_x2i_So_u,n) + aflds(i,j, 2,iblk) = x2i(index_x2i_So_v,n) + aflds(i,j, 3,iblk) = x2i(index_x2i_Sa_u,n) + aflds(i,j, 4,iblk) = x2i(index_x2i_Sa_v,n) + aflds(i,j, 5,iblk) = x2i(index_x2i_So_dhdx,n) + aflds(i,j, 6,iblk) = x2i(index_x2i_So_dhdy,n) + enddo + enddo + enddo + + if (.not.prescribed_ice) then + call t_startf ('cice_imp_halo') + call ice_HaloUpdate(aflds, halo_info, field_loc_center, & + field_type_vector) + call t_stopf ('cice_imp_halo') + endif + + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + uocn (i,j,iblk) = aflds(i,j, 1,iblk) + vocn (i,j,iblk) = aflds(i,j, 2,iblk) + uatm (i,j,iblk) = aflds(i,j, 3,iblk) + vatm (i,j,iblk) = aflds(i,j, 4,iblk) + ss_tltx(i,j,iblk) = aflds(i,j, 5,iblk) + ss_tlty(i,j,iblk) = aflds(i,j, 6,iblk) + enddo !i + enddo !j + enddo !iblk + !$OMP END PARALLEL DO + + deallocate(aflds) + + !------------------------------------------------------- + ! Set aerosols from coupler + !------------------------------------------------------- + + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + n = n+1 + faero_atm(i,j,1,iblk) = x2i(index_x2i_Faxa_bcphodry,n) + + faero_atm(i,j,2,iblk) = x2i(index_x2i_Faxa_bcphidry,n) & + + x2i(index_x2i_Faxa_bcphiwet,n) + ! Combine all of the dust into one category + faero_atm(i,j,3,iblk) = x2i(index_x2i_Faxa_dstwet1,n) & + + x2i(index_x2i_Faxa_dstdry1,n) & + + x2i(index_x2i_Faxa_dstwet2,n) & + + x2i(index_x2i_Faxa_dstdry2,n) & + + x2i(index_x2i_Faxa_dstwet3,n) & + + x2i(index_x2i_Faxa_dstdry3,n) & + + x2i(index_x2i_Faxa_dstwet4,n) & + + x2i(index_x2i_Faxa_dstdry4,n) + + if (index_x2i_Sa_shum_HDO > 0) then + + Qa_iso(i,j,1,iblk) = x2i(index_x2i_Sa_shum_HDO,n) + Qa_iso(i,j,2,iblk) = x2i(index_x2i_Sa_shum_16O,n) + Qa_iso(i,j,3,iblk) = x2i(index_x2i_Sa_shum_18O,n) + + fiso_rain(i,j,1,iblk) = x2i(index_x2i_Faxa_rain_HDO,n) + fiso_rain(i,j,2,iblk) = x2i(index_x2i_Faxa_rain_16O,n) + fiso_rain(i,j,3,iblk) = x2i(index_x2i_Faxa_rain_18O,n) + + fiso_atm(i,j,1,iblk) = x2i(index_x2i_Faxa_snow_HDO,n) + fiso_atm(i,j,2,iblk) = x2i(index_x2i_Faxa_snow_16O,n) + fiso_atm(i,j,3,iblk) = x2i(index_x2i_Faxa_snow_18O,n) + + HDO_ocn(i,j,iblk) = x2i(index_x2i_So_roce_HDO,n) + H2_16O_ocn(i,j,iblk) = x2i(index_x2i_So_roce_16O,n) + H2_18O_ocn(i,j,iblk) = x2i(index_x2i_So_roce_18O,n) + + endif + enddo !i + enddo !j + + enddo !iblk + + + !----------------------------------------------------------------- + ! rotate zonal/meridional vectors to local coordinates + ! compute data derived quantities + !----------------------------------------------------------------- + + ! Vector fields come in on T grid, but are oriented geographically + ! need to rotate to pop-grid FIRST using ANGLET + ! then interpolate to the U-cell centers (otherwise we + ! interpolate across the pole) + ! use ANGLET which is on the T grid ! + + call t_startf ('cice_imp_ocn') + !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) + do iblk = 1, nblocks + + do j = 1,ny_block + do i = 1,nx_block + + ! ocean + workx = uocn (i,j,iblk) ! currents, m/s + worky = vocn (i,j,iblk) + uocn(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + worky*sin(ANGLET(i,j,iblk)) + vocn(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & + - workx*sin(ANGLET(i,j,iblk)) + + workx = ss_tltx (i,j,iblk) ! sea sfc tilt, m/m + worky = ss_tlty (i,j,iblk) + ss_tltx(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + worky*sin(ANGLET(i,j,iblk)) + ss_tlty(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & + - workx*sin(ANGLET(i,j,iblk)) + + sst(i,j,iblk) = sst(i,j,iblk) - Tffresh ! sea sfc temp (C) + + sss(i,j,iblk)=max(sss(i,j,iblk),c0) + + enddo + enddo + +! Use shr_frz_mod for this + Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) + + enddo + !$OMP END PARALLEL DO + call t_stopf ('cice_imp_ocn') + + ! Interpolate ocean dynamics variables from T-cell centers to + ! U-cell centers. + + if (.not.prescribed_ice) then + call t_startf ('cice_imp_t2u') + call t2ugrid_vector(uocn) + call t2ugrid_vector(vocn) + call t2ugrid_vector(ss_tltx) + call t2ugrid_vector(ss_tlty) + call t_stopf ('cice_imp_t2u') + end if + + ! Atmosphere variables are needed in T cell centers in + ! subroutine stability and are interpolated to the U grid + ! later as necessary. + + call t_startf ('cice_imp_atm') + !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + + ! atmosphere + workx = uatm(i,j,iblk) ! wind velocity, m/s + worky = vatm(i,j,iblk) + uatm (i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + worky*sin(ANGLET(i,j,iblk)) ! note uatm, vatm, wind + vatm (i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & ! are on the T-grid here + - workx*sin(ANGLET(i,j,iblk)) + + wind (i,j,iblk) = sqrt(uatm(i,j,iblk)**2 + vatm(i,j,iblk)**2) + fsw (i,j,iblk) = swvdr(i,j,iblk) + swvdf(i,j,iblk) & + + swidr(i,j,iblk) + swidf(i,j,iblk) + enddo + enddo + enddo + !$OMP END PARALLEL DO + call t_stopf ('cice_imp_atm') + + !----------------------------------------------------------------- + ! debug output + !----------------------------------------------------------------- + + if (debug > 0 .and. my_task==master_task) then + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo; ihi = this_block%ihi + jlo = this_block%jlo; jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + write(nu_diag,F01)'import: date, sec, n, So_dhdx = ',idate,sec,n,x2i(index_x2i_So_dhdx,n) + write(nu_diag,F01)'import: date, sec, n, So_dhdxy = ',idate,sec,n,x2i(index_x2i_So_dhdy,n) + write(nu_diag,F01)'import: date, sec, n, So_t = ',idate,sec,n,x2i(index_x2i_So_t,n) + write(nu_diag,F01)'import: date, sec, n, So_s = ',idate,sec,n,x2i(index_x2i_So_s,n) + write(nu_diag,F01)'import: date, sec, n, So_u = ',idate,sec,n,x2i(index_x2i_So_u,n) + write(nu_diag,F01)'import: date, sec, n, So_v = ',idate,sec,n,x2i(index_x2i_So_v,n) + write(nu_diag,F01)'import: date, sec, n, Sa_u = ',idate,sec,n,x2i(index_x2i_Sa_u,n) + write(nu_diag,F01)'import: date, sec, n, Sa_v = ',idate,sec,n,x2i(index_x2i_Sa_v,n) + write(nu_diag,F01)'import: date, sec, n, Sa_z = ',idate,sec,n,x2i(index_x2i_Sa_z,n) + write(nu_diag,F01)'import: date, sec, n, So_ptem = ',idate,sec,n,x2i(index_x2i_Sa_ptem,n) + write(nu_diag,F01)'import: date, sec, n, So_tbot = ',idate,sec,n,x2i(index_x2i_Sa_tbot,n) + write(nu_diag,F01)'import: date, sec, n, So_shum = ',idate,sec,n,x2i(index_x2i_Sa_shum,n) + write(nu_diag,F01)'import: date, sec, n, Sa_dens = ',idate,sec,n,x2i(index_x2i_Sa_dens,n) + write(nu_diag,F01)'import: date, sec, n, Fioo_q = ',idate,sec,n,x2i(index_x2i_Fioo_q,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_swvdr = ',idate,sec,n,x2i(index_x2i_Faxa_swvdr,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_swndr = ',idate,sec,n,x2i(index_x2i_Faxa_swndr,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_swvdf = ',idate,sec,n,x2i(index_x2i_Faxa_swvdf,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_swndf = ',idate,sec,n,x2i(index_x2i_Faxa_swndf,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_lwdn = ',idate,sec,n,x2i(index_x2i_Faxa_lwdn,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_rain = ',idate,sec,n,x2i(index_x2i_Faxa_rain,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_snow = ',idate,sec,n,x2i(index_x2i_Faxa_snow,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_bcphodry = ',idate,sec,n,x2i(index_x2i_Faxa_bcphodry,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_bcphidry = ',idate,sec,n,x2i(index_x2i_Faxa_bcphidry,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_bcphiwet = ',idate,sec,n,x2i(index_x2i_Faxa_bcphiwet,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_dstwet1 = ',idate,sec,n,x2i(index_x2i_Faxa_dstwet1,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_dstdry1 = ',idate,sec,n,x2i(index_x2i_Faxa_dstdry1,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_dstwet2 = ',idate,sec,n,x2i(index_x2i_Faxa_dstwet2,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_dstdry2 = ',idate,sec,n,x2i(index_x2i_Faxa_dstdry2,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_dstwet3 = ',idate,sec,n,x2i(index_x2i_Faxa_dstwet3,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_dstdry3 = ',idate,sec,n,x2i(index_x2i_Faxa_dstdry3,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_dstwet4 = ',idate,sec,n,x2i(index_x2i_Faxa_dstwet4,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_dstdry4 = ',idate,sec,n,x2i(index_x2i_Faxa_dstdry4,n) + if (index_x2i_Sa_shum_HDO > 0) then + write(nu_diag,F01)'import: date, sec, n, Sa_shum_HDO = ',idate,sec,n,x2i(index_x2i_Sa_shum_HDO,n) + write(nu_diag,F01)'import: date, sec, n, Sa_shum_16O = ',idate,sec,n,x2i(index_x2i_Sa_shum_16O,n) + write(nu_diag,F01)'import: date, sec, n, Sa_shum_18O = ',idate,sec,n,x2i(index_x2i_Sa_shum_18O,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_rain_HDO = ',idate,sec,n,x2i(index_x2i_Faxa_rain_HDO,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_rain_16O = ',idate,sec,n,x2i(index_x2i_Faxa_rain_16O,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_rain_18O = ',idate,sec,n,x2i(index_x2i_Faxa_rain_18O,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_snow_HDO = ',idate,sec,n,x2i(index_x2i_Faxa_snow_HDO,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_snow_16O = ',idate,sec,n,x2i(index_x2i_Faxa_snow_16O,n) + write(nu_diag,F01)'import: date, sec, n, Faxa_snow_18O = ',idate,sec,n,x2i(index_x2i_Faxa_snow_18O,n) + write(nu_diag,F01)'import: date, sec, n, So_roce_HDO = ',idate,sec,n,x2i(index_x2i_So_roce_HDO,n) + write(nu_diag,F01)'import: date, sec, n, So_roce_16O = ',idate,sec,n,x2i(index_x2i_So_roce_16O,n) + write(nu_diag,F01)'import: date, sec, n, So_roce_18O = ',idate,sec,n,x2i(index_x2i_So_roce_18O,n) + end if + end do + end do + end do + end if + + end subroutine ice_import + + !=============================================================================== + + subroutine ice_export( i2x ) + + !----------------------------------------------------- + ! + ! Arguments + real(r8), intent(inout) :: i2x(:,:) + ! + ! Local Variables + integer :: i, j, iblk, n, ij + integer :: n2 ! thickness category index + integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain + integer (kind=int_kind) :: icells ! number of ocean/ice cells + integer (kind=int_kind), dimension (nx_block*ny_block) :: indxi ! compressed indices in i + integer (kind=int_kind), dimension (nx_block*ny_block) :: indxj ! compressed indices in i + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: & + Tsrf & ! surface temperature + , tauxa & ! atmo/ice stress + , tauya & + , tauxo & ! ice/ocean stress + , tauyo & + , ailohi ! fractional ice area + + real (kind=dbl_kind) :: & + workx, worky ! tmps for converting grid + + type(block) :: this_block ! block information for current block + logical :: flag + character(len=*),parameter :: subname = 'ice_export' + !----------------------------------------------------- + + flag=.false. + + !calculate ice thickness from aice and vice. Also + !create Tsrf from the first tracer (trcr) in ice_state.F + + ailohi(:,:,:) = c0 + Tsrf(:,:,:) = c0 + tauxa(:,:,:) = c0 + tauya(:,:,:) = c0 + tauxo(:,:,:) = c0 + tauyo(:,:,:) = c0 + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky, this_block, ilo, ihi, jlo, jhi) + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo,jhi + do i = ilo,ihi + + ! ice fraction + ailohi(i,j,iblk) = min(aice(i,j,iblk), c1) + + ! surface temperature + Tsrf(i,j,iblk) = Tffresh + trcr(i,j,1,iblk) !Kelvin (original ???) + + ! wind stress (on POP T-grid: convert to lat-lon) + workx = strairxT(i,j,iblk) ! N/m^2 + worky = strairyT(i,j,iblk) ! N/m^2 + tauxa(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & + - worky*sin(ANGLET(i,j,iblk)) + tauya(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & + + workx*sin(ANGLET(i,j,iblk)) + + ! ice/ocean stress (on POP T-grid: convert to lat-lon) + workx = -strocnxT(i,j,iblk) ! N/m^2 + worky = -strocnyT(i,j,iblk) ! N/m^2 + tauxo(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & + - worky*sin(ANGLET(i,j,iblk)) + tauyo(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & + + workx*sin(ANGLET(i,j,iblk)) + + enddo + enddo + enddo + !$OMP END PARALLEL DO + + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo,jhi + do i = ilo,ihi + if (tmask(i,j,iblk) .and. ailohi(i,j,iblk) < c0 ) then + flag = .true. + endif + end do + end do + end do + if (flag) then + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo,jhi + do i = ilo,ihi + if (tmask(i,j,iblk) .and. ailohi(i,j,iblk) < c0 ) then + write(nu_diag,*) & + ' (ice) send: ERROR ailohi < 0.0 ',i,j,ailohi(i,j,iblk) + call shr_sys_flush(nu_diag) + endif + end do + end do + end do + endif + + ! Fill export state i2x_i + + i2x(:,:) = spval_dbl + + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + n = n+1 + + !--- zero out fields with tmask for proper coupler accumulation in ice free areas + + if ( tmask(i,j,iblk)) i2x(:,n) = c0 + + !-------states-------------------- + i2x(index_i2x_Si_ifrac ,n) = ailohi(i,j,iblk) + + if ( tmask(i,j,iblk) .and. ailohi(i,j,iblk) > c0 ) then + !-------states-------------------- + i2x(index_i2x_Si_t ,n) = Tsrf(i,j,iblk) + i2x(index_i2x_Si_avsdr ,n) = alvdr(i,j,iblk) + i2x(index_i2x_Si_anidr ,n) = alidr(i,j,iblk) + i2x(index_i2x_Si_avsdf ,n) = alvdf(i,j,iblk) + i2x(index_i2x_Si_anidf ,n) = alidf(i,j,iblk) + i2x(index_i2x_Si_u10 ,n) = Uref(i,j,iblk) + i2x(index_i2x_Si_tref ,n) = Tref(i,j,iblk) + i2x(index_i2x_Si_qref ,n) = Qref(i,j,iblk) + i2x(index_i2x_Si_snowh ,n) = vsno(i,j,iblk) / ailohi(i,j,iblk) + + if (index_i2x_Si_logz0 > 0) then + if (Cdn_atm(i,j,iblk) > c0) then + i2x(index_i2x_Si_logz0 ,n) = log(zref)-(vonkar/sqrt(Cdn_atm(i,j,iblk))) + else + !--- tcraig, this should not happen but if it does, continue gracefully + write(nu_diag,*) trim(subname), ' WARNING: Cdn_atm error ',Cdn_atm(i,j,iblk),i,j,iblk + i2x(index_i2x_Si_logz0 ,n) = log(iceruf) + endif + endif + + !--- a/i fluxes computed by ice + i2x(index_i2x_Faii_taux ,n) = tauxa(i,j,iblk) + i2x(index_i2x_Faii_tauy ,n) = tauya(i,j,iblk) + i2x(index_i2x_Faii_lat ,n) = flat(i,j,iblk) + i2x(index_i2x_Faii_sen ,n) = fsens(i,j,iblk) + i2x(index_i2x_Faii_lwup ,n) = flwout(i,j,iblk) + i2x(index_i2x_Faii_evap ,n) = evap(i,j,iblk) + i2x(index_i2x_Faii_swnet,n) = fswabs(i,j,iblk) + + !--- i/o fluxes computed by ice + i2x(index_i2x_Fioi_melth,n) = fhocn(i,j,iblk) + i2x(index_i2x_Fioi_swpen,n) = fswthru(i,j,iblk) ! hf from melting + i2x(index_i2x_Fioi_meltw,n) = fresh(i,j,iblk) ! h2o flux from melting ??? + i2x(index_i2x_Fioi_salt ,n) = fsalt(i,j,iblk) ! salt flux from melting ??? + i2x(index_i2x_Fioi_taux ,n) = tauxo(i,j,iblk) ! stress : i/o zonal ??? + i2x(index_i2x_Fioi_tauy ,n) = tauyo(i,j,iblk) ! stress : i/o meridional ??? + + if (index_i2x_Fioi_bcpho > 0) then + i2x(index_i2x_Fioi_bcpho ,n) = faero_ocn(i,j,1,iblk) ! hydrophobic bc + end if + if (index_i2x_Fioi_bcphi > 0) then + i2x(index_i2x_Fioi_bcphi ,n) = faero_ocn(i,j,2,iblk) ! hydrophilic bc + end if + if (index_i2x_Fioi_flxdst > 0) then + i2x(index_i2x_Fioi_flxdst,n) = faero_ocn(i,j,3,iblk) ! dust + end if + if (index_i2x_Fioi_meltw_HDO > 0) then + i2x(index_i2x_Fioi_meltw_HDO,n) = fiso_ocn (i,j,1,iblk) ! Isotopes to ocean + i2x(index_i2x_Fioi_meltw_16O,n) = fiso_ocn (i,j,2,iblk) ! Isotopes to ocean + i2x(index_i2x_Fioi_meltw_18O,n) = fiso_ocn (i,j,3,iblk) ! Isotopes to ocean + i2x(index_i2x_Faii_evap_HDO ,n) = fiso_evap(i,j,1,iblk) ! Isotope evap to atm + i2x(index_i2x_Faii_evap_16O ,n) = fiso_evap(i,j,2,iblk) ! Isotope evap to atm + i2x(index_i2x_Faii_evap_18O ,n) = fiso_evap(i,j,3,iblk) ! Isotope evap to atm + i2x(index_i2x_Si_qref_HDO ,n) = Qref_iso(i,j,1,iblk) ! Isotope qref to atm + i2x(index_i2x_Si_qref_16O ,n) = Qref_iso(i,j,2,iblk) ! Isotope qref to atm + i2x(index_i2x_Si_qref_18O ,n) = Qref_iso(i,j,3,iblk) ! Isotope qref to atm + endif + end if + enddo !i + enddo !j + enddo !iblk + + if (send_i2x_per_cat) then + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + n = n+1 + + ! ice fraction + do n2 = 1, ncat + i2x(index_i2x_Si_ifrac_n(n2),n) = aicen_init(i,j,n2,iblk) + enddo + + if ( tmask(i,j,iblk) .and. ailohi(i,j,iblk) > c0 ) then + ! penetrative shortwave + do n2 = 1, ncat + i2x(index_i2x_PFioi_swpen_ifrac_n(n2),n) = fswthrun_ai(i,j,n2,iblk) + enddo + else + !--- zero out pass-through fields over land for benefit of x2oacc fields in cpl hist files + do n2 = 1, ncat + i2x(index_i2x_PFioi_swpen_ifrac_n(n2),n) = c0 + enddo + end if + enddo !i + enddo !j + enddo !iblk + end if ! send_i2x_per_cat + + !----------------------------------------------------------------- + ! Debug output + !----------------------------------------------------------------- + + if (debug > 0 .and. my_task==master_task) then + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo; ihi = this_block%ihi + jlo = this_block%jlo; jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + + !--- ice states + write(nu_diag,F01)'export: date, sec, n, Si_ifrac = ',idate,sec,n,i2x(index_i2x_Si_ifrac ,n) + write(nu_diag,F01)'export: date, sec, n, Si_t = ',idate,sec,n,i2x(index_i2x_Si_t ,n) + write(nu_diag,F01)'export: date, sec, n, Si_avsdr = ',idate,sec,n,i2x(index_i2x_Si_avsdr ,n) + write(nu_diag,F01)'export: date, sec, n, Si_anidr = ',idate,sec,n,i2x(index_i2x_Si_anidr ,n) + write(nu_diag,F01)'export: date, sec, n, Si_avsdf = ',idate,sec,n,i2x(index_i2x_Si_avsdf ,n) + write(nu_diag,F01)'export: date, sec, n, Si_anidf = ',idate,sec,n,i2x(index_i2x_Si_anidf ,n) + write(nu_diag,F01)'export: date, sec, n, Si_u10 = ',idate,sec,n,i2x(index_i2x_Si_u10 ,n) + write(nu_diag,F01)'export: date, sec, n, Si_tref = ',idate,sec,n,i2x(index_i2x_Si_tref ,n) + write(nu_diag,F01)'export: date, sec, n, Si_qref = ',idate,sec,n,i2x(index_i2x_Si_qref ,n) + write(nu_diag,F01)'export: date, sec, n, Si_snowh = ',idate,sec,n,i2x(index_i2x_Si_snowh ,n) + if (index_i2x_Si_logz0 > 0) then + write(nu_diag,F01)'export: date, sec, n, Si_logz0= ',idate,sec,n, i2x(index_i2x_Si_logz0 ,n) + end if + + !--- a/i fluxes computed by ice + write(nu_diag,F01)'export: date, sec, n, Faii_taux = ',idate,sec,n,i2x(index_i2x_Faii_taux ,n) + write(nu_diag,F01)'export: date, sec, n, Faii_tauy = ',idate,sec,n,i2x(index_i2x_Faii_tauy ,n) + write(nu_diag,F01)'export: date, sec, n, Faii_lat = ',idate,sec,n,i2x(index_i2x_Faii_lat ,n) + write(nu_diag,F01)'export: date, sec, n, Faii_sen = ',idate,sec,n,i2x(index_i2x_Faii_sen ,n) + write(nu_diag,F01)'export: date, sec, n, Faii_lwup = ',idate,sec,n,i2x(index_i2x_Faii_lwup ,n) + write(nu_diag,F01)'export: date, sec, n, Faii_evap = ',idate,sec,n,i2x(index_i2x_Faii_evap ,n) + write(nu_diag,F01)'export: date, sec, n, Faii_swnet = ',idate,sec,n,i2x(index_i2x_Faii_swnet,n) + + !--- i/o fluxes computed by ice + write(nu_diag,F01)'export: date, sec, n, Fioi_melth = ',idate,sec,n,i2x(index_i2x_Fioi_melth,n) + write(nu_diag,F01)'export: date, sec, n, Fioi_swpen = ',idate,sec,n,i2x(index_i2x_Fioi_swpen,n) + write(nu_diag,F01)'export: date, sec, n, Fioi_meltw = ',idate,sec,n,i2x(index_i2x_Fioi_meltw,n) + write(nu_diag,F01)'export: date, sec, n, Fioi_salt = ',idate,sec,n,i2x(index_i2x_Fioi_salt ,n) + write(nu_diag,F01)'export: date, sec, n, Fioi_taux = ',idate,sec,n,i2x(index_i2x_Fioi_taux ,n) + write(nu_diag,F01)'export: date, sec, n, Fioi_tauy = ',idate,sec,n,i2x(index_i2x_Fioi_tauy ,n) + if (index_i2x_Fioi_bcpho > 0) then + write(nu_diag,F01)'export: date, sec, n, Fioi_bcpho = ',idate,sec,n,i2x(index_i2x_Fioi_bcpho ,n) + end if + if (index_i2x_Fioi_bcphi > 0) then + write(nu_diag,F01)'export: date, sec, n, Fioi_bcphi = ',idate,sec,n,i2x(index_i2x_Fioi_bcpho ,n) + end if + if (index_i2x_Fioi_flxdst > 0) then + write(nu_diag,F01)'export: date, sec, n, Fioi_flxdst = ',idate,sec,n,i2x(index_i2x_Fioi_flxdst,n) + end if + if (index_i2x_Fioi_meltw_HDO > 0) then + write(nu_diag,F01)'export: date, sec, n, Fioi_HDO = ',idate,sec,n,i2x(index_i2x_Fioi_meltw_HDO,n) + write(nu_diag,F01)'export: date, sec, n, Fioi_16O = ',idate,sec,n,i2x(index_i2x_Fioi_meltw_16O,n) + write(nu_diag,F01)'export: date, sec, n, Fioi_18O = ',idate,sec,n,i2x(index_i2x_Fioi_meltw_18O,n) + write(nu_diag,F01)'export: date, sec, n, Faii_evap_HDO = ',idate,sec,n,i2x(index_i2x_Faii_evap_HDO ,n) + write(nu_diag,F01)'export: date, sec, n, Faii_evap_16O = ',idate,sec,n,i2x(index_i2x_Faii_evap_16O ,n) + write(nu_diag,F01)'export: date, sec, n, Faii_evap_18O = ',idate,sec,n,i2x(index_i2x_Faii_evap_18O ,n) + write(nu_diag,F01)'export: date, sec, n, Si_qref_HDO = ',idate,sec,n,i2x(index_i2x_Si_qref_HDO ,n) + write(nu_diag,F01)'export: date, sec, n, Si_qref_16O = ',idate,sec,n,i2x(index_i2x_Si_qref_16O ,n) + write(nu_diag,F01)'export: date, sec, n, Si_qref_18O = ',idate,sec,n,i2x(index_i2x_Si_qref_18O ,n) + end if + end do + end do + end do + end if + + end subroutine ice_export + +end module ice_import_export diff --git a/cicecore/drivers/mct/cesm2/ice_prescribed_mod.F90 b/cicecore/drivers/mct/cesm2/ice_prescribed_mod.F90 new file mode 100644 index 000000000..4d95be1d3 --- /dev/null +++ b/cicecore/drivers/mct/cesm2/ice_prescribed_mod.F90 @@ -0,0 +1,561 @@ +!=================================================================== +!BOP +! +! !MODULE: ice_prescribed_mod - Prescribed Ice Model +! +! !DESCRIPTION: +! +! The prescribed ice model reads in ice concentration data from a netCDF +! file. Ice thickness, temperature, the ice temperature profile are +! prescribed. Air/ice fluxes are computed to get surface temperature, +! Ice/ocean fluxes are set to zero, and ice dynamics are not calculated. +! Regridding and data cycling capabilities are included. +! +! !REVISION HISTORY: +! SVN:$Id: ice_prescribed_mod.F90 40 2006-12-01 19:09:30Z eclare $ +! +! 2010-May-15 - Tony Craig and Mariana Vertenstein - updated to latest streams +! 2006-Aug-22 - D. Bailey, E. Hunke, modified to fit with CICE +! 2005-May-19 - J. Schramm - first version +! 2005-Apr-19 - B. Kauffman, J. Schramm, M. Vertenstein, NCAR - design +! +! !INTERFACE: ---------------------------------------------------------- + +module ice_prescribed_mod + +! !USES: + + use shr_nl_mod, only : shr_nl_find_group_name + use shr_strdata_mod + use shr_dmodel_mod + use shr_string_mod + use shr_ncread_mod + use shr_sys_mod + use shr_mct_mod + use mct_mod + use pio + + use ice_broadcast + use ice_communicate, only : my_task, master_task, MPI_COMM_ICE + use ice_kinds_mod + use ice_fileunits + use ice_exit, only : abort_ice + use ice_domain_size, only : nx_global, ny_global, ncat, nilyr, nslyr, max_blocks + use ice_constants + use ice_blocks, only : nx_block, ny_block, block, get_block + use ice_domain, only : nblocks, distrb_info, blocks_ice + use ice_grid, only : TLAT,TLON,hm,tmask + use ice_calendar, only : idate, sec, calendar_type + use ice_itd, only : hin_max + use ice_read_write + + implicit none + + private ! except + + +! !PUBLIC TYPES: + +! !PUBLIC MEMBER FUNCTIONS: + + public :: ice_prescribed_init ! initialize input data stream + public :: ice_prescribed_run ! get time slices and time interp + public :: ice_prescribed_phys ! set prescribed ice state and fluxes + +! !PUBLIC DATA MEMBERS: + + logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice + +!EOP + + integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files + integer(kind=int_kind) :: stream_year_first ! first year in stream to use + integer(kind=int_kind) :: stream_year_last ! last year in stream to use + integer(kind=int_kind) :: model_year_align ! align stream_year_first + ! with this model year + + character(len=char_len_long) :: stream_fldVarName + character(len=char_len_long) :: stream_fldFileName(nFilesMaximum) + character(len=char_len_long) :: stream_domTvarName + character(len=char_len_long) :: stream_domXvarName + character(len=char_len_long) :: stream_domYvarName + character(len=char_len_long) :: stream_domAreaName + character(len=char_len_long) :: stream_domMaskName + character(len=char_len_long) :: stream_domFileName + character(len=char_len_long) :: stream_mapread + logical(kind=log_kind) :: prescribed_ice_fill ! true if data fill required + + type(shr_strdata_type) :: sdat ! prescribed data stream + character(len=char_len_long) :: fldList ! list of fields in data stream + real(kind=dbl_kind) :: ice_cov(nx_block,ny_block,max_blocks) ! ice cover + + real (kind=dbl_kind), parameter :: & + cp_sno = 0.0_dbl_kind & ! specific heat of snow (J/kg/K) + , rLfi = Lfresh*rhoi & ! latent heat of fusion ice (J/m^3) + , rLfs = Lfresh*rhos & ! latent heat of fusion snow (J/m^3) + , rLvi = Lvap*rhoi & ! latent heat of vapor*rhoice (J/m^3) + , rLvs = Lvap*rhos & ! latent heat of vapor*rhosno (J/m^3) + , rcpi = cp_ice*rhoi & ! heat capacity of fresh ice (J/m^3) + , rcps = cp_sno*rhos & ! heat capacity of snow (J/m^3) + , rcpidepressT = rcpi*depressT & ! param for finding T(z) from q (J/m^3) + , rLfidepressT = rLfi*depressT ! param for heat capacity (J deg/m^3) + ! heat capacity of sea ice, rhoi*C=rcpi+rLfidepressT*salinity/T^2 + +!======================================================================= +contains +!=============================================================================== +!BOP +! +! !IROUTINE: ice_prescribed_init - prescribed ice initialization +! +! !INTERFACE: + subroutine ice_prescribed_init(compid, gsmap, dom) + use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat +! !DESCRIPTION: +! Prescribed ice initialization - needed to +! work with new shr_strdata module derived type +! +! !REVISION HISTORY: +! 2009-Oct-12 - M. Vertenstein +! +! !INPUT/OUTPUT PARAMETERS: +! + implicit none + include 'mpif.h' + integer(kind=int_kind), intent(in) :: compid + type(mct_gsMap) :: gsmap + type(mct_gGrid) :: dom + +!EOP + !----- Local ------ + integer(kind=int_kind) :: nml_error ! namelist i/o error flag + integer(kind=int_kind) :: n, nFile, ierr + character(len=8) :: fillalgo + character(*),parameter :: subName = "('ice_prescribed_init2')" + character(*),parameter :: F00 = "('(ice_prescribed_init2) ',4a)" + + namelist /ice_prescribed_nml/ & + prescribed_ice, & + model_year_align, & + stream_year_first , & + stream_year_last , & + stream_fldVarName , & + stream_fldFileName, & + stream_domTvarName, & + stream_domXvarName, & + stream_domYvarName, & + stream_domAreaName, & + stream_domMaskName, & + stream_domFileName, & + stream_mapread, & + prescribed_ice_fill + + ! default values for namelist + prescribed_ice = .false. ! if true, prescribe ice + stream_year_first = 1 ! first year in pice stream to use + stream_year_last = 1 ! last year in pice stream to use + model_year_align = 1 ! align stream_year_first with this model year + stream_fldVarName = 'ice_cov' + stream_fldFileName(:) = ' ' + stream_domTvarName = 'time' + stream_domXvarName = 'lon' + stream_domYvarName = 'lat' + stream_domAreaName = 'area' + stream_domMaskName = 'mask' + stream_domFileName = ' ' + stream_mapread = 'NOT_SET' + prescribed_ice_fill = .false. ! true if pice data fill required + + ! read from input file + call get_fileunit(nu_nml) + if (my_task == master_task) then + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + call shr_nl_find_group_name(nu_nml, 'ice_prescribed_nml', status=nml_error) + if (nml_error == 0) then + read(nu_nml, ice_prescribed_nml, iostat=nml_error) + if (nml_error > 0) then + call shr_sys_abort( 'problem on read of ice_prescribed namelist in ice_prescribed_mod' ) + endif + endif + end if + call release_fileunit(nu_nml) + call broadcast_scalar(prescribed_ice, master_task) + + ! *** If not prescribed ice then return *** + if (.not. prescribed_ice) RETURN + + call broadcast_scalar(model_year_align,master_task) + call broadcast_scalar(stream_year_first,master_task) + call broadcast_scalar(stream_year_last,master_task) + call broadcast_scalar(stream_fldVarName,master_task) + call broadcast_scalar(stream_domTvarName,master_task) + call broadcast_scalar(stream_domXvarName,master_task) + call broadcast_scalar(stream_domYvarName,master_task) + call broadcast_scalar(stream_domAreaName,master_task) + call broadcast_scalar(stream_domMaskName,master_task) + call broadcast_scalar(stream_domFileName,master_task) + call broadcast_scalar(stream_mapread,master_task) + call broadcast_scalar(prescribed_ice_fill,master_task) + call mpi_bcast(stream_fldFileName, len(stream_fldFileName(1))*NFilesMaximum, & + MPI_CHARACTER, 0, MPI_COMM_ICE, ierr) + + nFile = 0 + do n=1,nFilesMaximum + if (stream_fldFileName(n) /= ' ') nFile = nFile + 1 + end do + + ! Read shr_strdata_nml namelist + if (prescribed_ice_fill) then + fillalgo='nn' + else + fillalgo='none' + endif + + if (my_task == master_task) then + write(nu_diag,*) ' ' + write(nu_diag,*) 'This is the prescribed ice coverage option.' + write(nu_diag,*) ' stream_year_first = ',stream_year_first + write(nu_diag,*) ' stream_year_last = ',stream_year_last + write(nu_diag,*) ' model_year_align = ',model_year_align + write(nu_diag,*) ' stream_fldVarName = ',trim(stream_fldVarName) + do n = 1,nFile + write(nu_diag,*) ' stream_fldFileName = ',trim(stream_fldFileName(n)),n + end do + write(nu_diag,*) ' stream_domTvarName = ',trim(stream_domTvarName) + write(nu_diag,*) ' stream_domXvarName = ',trim(stream_domXvarName) + write(nu_diag,*) ' stream_domYvarName = ',trim(stream_domYvarName) + write(nu_diag,*) ' stream_domFileName = ',trim(stream_domFileName) + write(nu_diag,*) ' stream_mapread = ',trim(stream_mapread) + write(nu_diag,*) ' stream_fillalgo = ',trim(fillalgo) + write(nu_diag,*) ' ' + endif + + call shr_strdata_create(sdat,name="prescribed_ice", & + mpicom=MPI_COMM_ICE, compid=compid, & + gsmap=gsmap, ggrid=dom, & + nxg=nx_global,nyg=ny_global, & + yearFirst=stream_year_first, & + yearLast=stream_year_last, & + yearAlign=model_year_align, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_domFileName), & + domTvarName=stream_domTvarName, & + domXvarName=stream_domXvarName, & + domYvarName=stream_domYvarName, & + domAreaName=stream_domAreaName, & + domMaskName=stream_domMaskName, & + filePath='', & + filename=stream_fldFileName(1:nFile), & + fldListFile=stream_fldVarName, & + fldListModel=stream_fldVarName, & + fillalgo=trim(fillalgo), & + calendar=trim(calendar_type), & + mapread=trim(stream_mapread)) + + if (my_task == master_task) then + call shr_strdata_print(sdat,'SPRESICE data') + endif + + !----------------------------------------------------------------- + ! For one ice category, set hin_max(1) to something big + !----------------------------------------------------------------- + if (ncat == 1) then + hin_max(1) = 999._dbl_kind + end if +end subroutine ice_prescribed_init + +!======================================================================= +!BOP =================================================================== +! +! !IROUTINE: ice_prescribed_run -- Update ice coverage +! +! !DESCRIPTION: +! +! Finds two time slices bounding current model time, remaps if necessary +! +! !REVISION HISTORY: +! 2005-May-19 - J. Schramm - first version +! 2009-Oct-15 - M. Vertenstein - update to new data model changes +! +! !INTERFACE: ----------------------------------------------------------- + +subroutine ice_prescribed_run(mDateIn, secIn) + +! !USES: + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(kind=int_kind), intent(in) :: mDateIn ! Current model date (yyyymmdd) + integer(kind=int_kind), intent(in) :: secIn ! Elapsed seconds on model date + +!EOP + + integer(kind=int_kind) :: i,j,n,iblk ! loop indices and counter + integer(kind=int_kind) :: ilo,ihi,jlo,jhi ! beginning and end of physical domain + type (block) :: this_block + real(kind=dbl_kind) :: aice_max ! maximun ice concentration + logical, save :: first_time = .true. + character(*),parameter :: subName = "('ice_prescribed_run')" + character(*),parameter :: F00 = "('(ice_prescribed_run) ',a,2g20.13)" + + !------------------------------------------------------------------------ + ! Interpolate to new ice coverage + !------------------------------------------------------------------------ + + call shr_strdata_advance(sdat,mDateIn,SecIn,MPI_COMM_ICE,'cice_pice') + + ice_cov(:,:,:) = c0 ! This initializes ghost cells as well + + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + ice_cov(i,j,iblk) = sdat%avs(1)%rAttr(1,n) + end do + end do + end do + + !-------------------------------------------------------------------- + ! Check to see that ice concentration is in fraction, not percent + !-------------------------------------------------------------------- + if (first_time) then + aice_max = maxval(ice_cov) + + if (aice_max > c10) then + write(nu_diag,F00) "ERROR: Ice conc data must be in fraction, aice_max= ",& + aice_max + call abort_ice(subName) + end if + first_time = .false. + end if + + !----------------------------------------------------------------- + ! Set prescribed ice state and fluxes + !----------------------------------------------------------------- + + call ice_prescribed_phys() + +end subroutine ice_prescribed_run + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: ice_prescribed_phys -- set prescribed ice state and fluxes +! +! !DESCRIPTION: +! +! Set prescribed ice state using input ice concentration; +! set surface ice temperature to atmospheric value; use +! linear temperature gradient in ice to ocean temperature. +! +! !REVISION HISTORY: +! 2005-May-23 - J. Schramm - Updated with data models +! 2004-July - J. Schramm - Modified to allow variable snow cover +! 2001-May - B. P. Briegleb - Original version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine ice_prescribed_phys + +! !USES: + + use ice_flux +! use ice_grid, only : bound + use ice_state + use ice_itd, only : aggregate + use ice_dyn_evp + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + +!EOP + + !----- Local ------ + integer(kind=int_kind) :: layer ! level index + integer(kind=int_kind) :: nc ! ice category index + integer(kind=int_kind) :: i,j,k ! longitude, latitude and level indices + integer(kind=int_kind) :: iblk + + real(kind=dbl_kind) :: slope ! diff in underlying ocean tmp and ice surface tmp + real(kind=dbl_kind) :: Ti ! ice level temperature + real(kind=dbl_kind) :: Tmlt ! ice level melt temperature + real(kind=dbl_kind) :: qin_save(nilyr) + real(kind=dbl_kind) :: qsn_save(nslyr) + real(kind=dbl_kind) :: hi ! ice prescribed (hemispheric) ice thickness + real(kind=dbl_kind) :: hs ! snow thickness + real(kind=dbl_kind) :: zn ! normalized ice thickness + real(kind=dbl_kind) :: salin(nilyr) ! salinity (ppt) + + real(kind=dbl_kind), parameter :: nsal = 0.407_dbl_kind + real(kind=dbl_kind), parameter :: msal = 0.573_dbl_kind + real(kind=dbl_kind), parameter :: saltmax = 3.2_dbl_kind ! max salinity at ice base (ppm) + + !----------------------------------------------------------------- + ! Initialize ice state + !----------------------------------------------------------------- + + ! TODO - can we now get rid of the following??? + + ! aicen(:,:,:,:) = c0 + ! vicen(:,:,:,:) = c0 + ! eicen(:,:,:,:) = c0 + + ! do nc=1,ncat + ! trcrn(:,:,nt_Tsfc,nc,:) = Tf(:,:,:) + ! enddo + + !----------------------------------------------------------------- + ! Set ice cover over land to zero, not sure if this should be + ! be done earier, before time/spatial interp?????? + !----------------------------------------------------------------- + do iblk = 1,nblocks + do j = 1,ny_block + do i = 1,nx_block + if (tmask(i,j,iblk)) then + if (ice_cov(i,j,iblk) .lt. eps04) ice_cov(i,j,iblk) = c0 + if (ice_cov(i,j,iblk) .gt. c1) ice_cov(i,j,iblk) = c1 + else + ice_cov(i,j,iblk) = c0 + end if + enddo + enddo + enddo + + do iblk = 1,nblocks + do j = 1,ny_block + do i = 1,nx_block + + if (tmask(i,j,iblk)) then ! Over ocean points + + !-------------------------------------------------------------- + ! Place ice where ice concentration > .0001 + !-------------------------------------------------------------- + + if (ice_cov(i,j,iblk) >= eps04) then + + hi = 0.0_dbl_kind + !---------------------------------------------------------- + ! Set ice thickness in each hemisphere + !---------------------------------------------------------- + if(TLAT(i,j,iblk)*rad_to_deg > 40.0_dbl_kind) then + hi = 2.0_dbl_kind + else if(TLAT(i,j,iblk)*rad_to_deg < -40.0_dbl_kind) then + hi = 1.0_dbl_kind + end if + + !---------------------------------------------------------- + ! All ice in appropriate thickness category + !---------------------------------------------------------- + do nc = 1,ncat + + if(hin_max(nc-1) < hi .and. hi < hin_max(nc)) then + + if (aicen(i,j,nc,iblk) > c0) then + hs = vsnon(i,j,nc,iblk) / aicen(i,j,nc,iblk) + else + hs = c0 + endif + + aicen(i,j,nc,iblk) = ice_cov(i,j,iblk) + vicen(i,j,nc,iblk) = hi*aicen(i,j,nc,iblk) + vsnon(i,j,nc,iblk) = hs*aicen(i,j,nc,iblk) + + !--------------------------------------------------------- + ! make linear temp profile and compute enthalpy + !--------------------------------------------------------- + + if (abs(trcrn(i,j,nt_qice,nc,iblk)) < puny) then + + if (aice(i,j,iblk) < puny) & + trcrn(i,j,nt_Tsfc,nc,iblk) = Tf(i,j,iblk) + + slope = Tf(i,j,iblk) - trcrn(i,j,nt_Tsfc,nc,iblk) + do k = 1, nilyr + zn = (real(k,kind=dbl_kind)-p5) / real(nilyr,kind=dbl_kind) + Ti = trcrn(i,j,nt_Tsfc,nc,iblk) + slope*zn + salin(k) = (saltmax/c2)*(c1-cos(pi*zn**(nsal/(msal+zn)))) + Tmlt = -salin(k)*depressT + trcrn(i,j,nt_sice+k-1,nc,iblk) = salin(k) + trcrn(i,j,nt_qice+k-1,nc,iblk) = & + -(rhoi * (cp_ice*(Tmlt-Ti) & + + Lfresh*(c1-Tmlt/Ti) - cp_ocn*Tmlt)) + enddo + + do k=1,nslyr + trcrn(i,j,nt_qsno+k-1,nc,iblk) = & + -rhos*(Lfresh - cp_ice*trcrn(i,j,nt_Tsfc,nc,iblk)) + enddo + + endif ! aice < puny + end if ! hin_max + enddo ! ncat + else + trcrn(i,j,nt_Tsfc,:,iblk) = Tf(i,j,iblk) + aicen(i,j,:,iblk) = c0 + vicen(i,j,:,iblk) = c0 + vsnon(i,j,:,iblk) = c0 + trcrn(i,j,nt_sice:nt_sice+nilyr-1,:,iblk) = c0 + trcrn(i,j,nt_qice:nt_qice+nilyr-1,:,iblk) = c0 + trcrn(i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk) = c0 + end if ! ice_cov >= eps04 + end if ! tmask + enddo ! i + enddo ! j + + !-------------------------------------------------------------------- + ! compute aggregate ice state and open water area + !-------------------------------------------------------------------- + call aggregate (nx_block, ny_block, & + aicen(:,:,:,iblk), & + trcrn(:,:,1:ntrcr,:,iblk), & + vicen(:,:,:,iblk), vsnon(:,:, :,iblk), & + aice (:,:, iblk), & + trcr (:,:,1:ntrcr, iblk), & + vice (:,:, iblk), vsno (:,:, iblk), & + aice0(:,:, iblk), tmask(:,:, iblk), & + ntrcr, trcr_depend(1:ntrcr)) + + enddo ! iblk + + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + aice_init(i,j,iblk) = aice(i,j,iblk) + enddo + enddo + enddo + + !-------------------------------------------------------------------- + ! set non-computed fluxes, ice velocities, ice-ocn stresses to zero + !-------------------------------------------------------------------- + + frzmlt (:,:,:) = c0 + uvel (:,:,:) = c0 + vvel (:,:,:) = c0 + strocnxT (:,:,:) = c0 + strocnyT (:,:,:) = c0 + + !----------------------------------------------------------------- + ! other atm and ocn fluxes + !----------------------------------------------------------------- + call init_flux_atm + call init_flux_ocn + +end subroutine ice_prescribed_phys + +!============================================================================== + +end module ice_prescribed_mod + +!============================================================================== diff --git a/cicecore/drivers/mct/cesm2/ice_scam.F90 b/cicecore/drivers/mct/cesm2/ice_scam.F90 new file mode 100644 index 000000000..86a56d19c --- /dev/null +++ b/cicecore/drivers/mct/cesm2/ice_scam.F90 @@ -0,0 +1,15 @@ +module ice_scam + + use ice_kinds_mod + + implicit none + + ! single column control variables (only used for latlon grid) + + logical :: single_column ! true => single column mode + real (kind=dbl_kind) scmlat ! single column latitude (degrees) + real (kind=dbl_kind) scmlon ! single column longitude (degrees) + +end module ice_scam + + From 22f8fd635767f49f514a00b8acbe55fb401f3962 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 1 Jun 2020 09:33:33 -0600 Subject: [PATCH 2/4] Remove CESM2 MCT drivers --- cicecore/cicedynB/general/ice_flux.F90 | 14 + cicecore/cicedynB/general/ice_step_mod.F90 | 34 +- cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 | 94 -- cicecore/drivers/mct/cesm2/CICE_InitMod.F90 | 355 ----- cicecore/drivers/mct/cesm2/CICE_RunMod.F90 | 535 -------- cicecore/drivers/mct/cesm2/ice_comp_mct.F90 | 1196 ----------------- cicecore/drivers/mct/cesm2/ice_constants.F90 | 234 ---- .../drivers/mct/cesm2/ice_cpl_indices.F90 | 256 ---- .../drivers/mct/cesm2/ice_import_export.F90 | 767 ----------- .../drivers/mct/cesm2/ice_prescribed_mod.F90 | 561 -------- cicecore/drivers/mct/cesm2/ice_scam.F90 | 15 - .../drivers/standalone/cice/CICE_RunMod.F90 | 11 +- cicecore/shared/ice_arrays_column.F90 | 8 + cicecore/shared/ice_init_column.F90 | 14 +- doc/source/cice_index.rst | 4 + icepack | 2 +- 16 files changed, 76 insertions(+), 4024 deletions(-) delete mode 100644 cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 delete mode 100644 cicecore/drivers/mct/cesm2/CICE_InitMod.F90 delete mode 100644 cicecore/drivers/mct/cesm2/CICE_RunMod.F90 delete mode 100644 cicecore/drivers/mct/cesm2/ice_comp_mct.F90 delete mode 100644 cicecore/drivers/mct/cesm2/ice_constants.F90 delete mode 100644 cicecore/drivers/mct/cesm2/ice_cpl_indices.F90 delete mode 100644 cicecore/drivers/mct/cesm2/ice_import_export.F90 delete mode 100644 cicecore/drivers/mct/cesm2/ice_prescribed_mod.F90 delete mode 100644 cicecore/drivers/mct/cesm2/ice_scam.F90 diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index b09102d0d..206c44808 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -994,6 +994,8 @@ subroutine scale_fluxes (nx_block, ny_block, & Tref, Qref, & fresh, fsalt, & fhocn, fswthru, & + fswthruvdr, fswthruvdf, & + fswthruidr, fswthruidf, & faero_ocn, & alvdr, alidr, & alvdf, alidf, & @@ -1038,6 +1040,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt , & ! salt flux to ocean (kg/m2/s) fhocn , & ! actual ocn/ice heat flx (W/m**2) fswthru , & ! sw radiation through ice bot (W/m**2) + fswthruvdr , & ! vis dir sw radiation through ice bot (W/m**2) + fswthruvdf , & ! vis dif sw radiation through ice bot (W/m**2) + fswthruidr , & ! nir dir sw radiation through ice bot (W/m**2) + fswthruidf , & ! nir dif sw radiation through ice bot (W/m**2) alvdr , & ! visible, direct (fraction) alidr , & ! near-ir, direct (fraction) alvdf , & ! visible, diffuse (fraction) @@ -1106,6 +1112,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt (i,j) = fsalt (i,j) * ar fhocn (i,j) = fhocn (i,j) * ar fswthru (i,j) = fswthru (i,j) * ar + fswthruvdr (i,j) = fswthruvdr (i,j) * ar + fswthruvdf (i,j) = fswthruvdf (i,j) * ar + fswthruidr (i,j) = fswthruidr (i,j) * ar + fswthruidf (i,j) = fswthruidf (i,j) * ar alvdr (i,j) = alvdr (i,j) * ar alidr (i,j) = alidr (i,j) * ar alvdf (i,j) = alvdf (i,j) * ar @@ -1134,6 +1144,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt (i,j) = c0 fhocn (i,j) = c0 fswthru (i,j) = c0 + fswthruvdr (i,j) = c0 + fswthruvdf (i,j) = c0 + fswthruidr (i,j) = c0 + fswthruidf (i,j) = c0 alvdr (i,j) = c0 ! zero out albedo where ice is absent alidr (i,j) = c0 alvdf (i,j) = c0 diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 7f9f316a3..0e05a0e60 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -78,7 +78,8 @@ subroutine prep_radiation (iblk) use ice_flux, only: scale_factor, swvdr, swvdf, swidr, swidf, & alvdr_ai, alvdf_ai, alidr_ai, alidf_ai, & alvdr_init, alvdf_init, alidr_init, alidf_init - use ice_arrays_column, only: fswsfcn, fswintn, fswthrun, & + use ice_arrays_column, only: fswsfcn, fswintn, & + fswthrun, fswthrunvdr, fswthrunvdf, fswthrunidr, fswthrunidf, & fswpenln, Sswabsn, Iswabsn use ice_state, only: aice, aicen use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw @@ -130,7 +131,12 @@ subroutine prep_radiation (iblk) alvdr_ai = alvdr_ai(i,j, iblk), alvdf_ai = alvdf_ai(i,j, iblk), & alidr_ai = alidr_ai(i,j, iblk), alidf_ai = alidf_ai(i,j, iblk), & fswsfcn = fswsfcn (i,j, :,iblk), fswintn = fswintn (i,j, :,iblk), & - fswthrun = fswthrun(i,j, :,iblk), fswpenln = fswpenln(i,j,:,:,iblk), & + fswthrun = fswthrun(i,j, :,iblk), & + fswthrunvdr = fswthrunvdr(i,j, :,iblk), & + fswthrunvdf = fswthrunvdf(i,j, :,iblk), & + fswthrunidr = fswthrunidr(i,j, :,iblk), & + fswthrunidf = fswthrunidf(i,j, :,iblk), & + fswpenln = fswpenln(i,j,:,:,iblk), & Sswabsn = Sswabsn (i,j,:,:,iblk), Iswabsn = Iswabsn (i,j,:,:,iblk)) enddo ! i @@ -157,7 +163,8 @@ subroutine step_therm1 (dt, iblk) Cdn_ocn, Cdn_ocn_skin, Cdn_ocn_floe, Cdn_ocn_keel, Cdn_atm_ratio, & Cdn_atm, Cdn_atm_skin, Cdn_atm_floe, Cdn_atm_rdg, Cdn_atm_pond, & hfreebd, hdraft, hridge, distrdg, hkeel, dkeel, lfloe, dfloe, & - fswsfcn, fswintn, fswthrun, Sswabsn, Iswabsn + fswsfcn, fswintn, Sswabsn, Iswabsn, & + fswthrun, fswthrunvdr, fswthrunvdf, fswthrunidr, fswthrunidf use ice_blocks, only: block, get_block, nx_block, ny_block use ice_calendar, only: yday use ice_domain, only: blocks_ice @@ -168,7 +175,8 @@ subroutine step_therm1 (dt, iblk) flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, & frain, Tair, strairxT, strairyT, fsurf, fcondtop, fsens, & flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & - fswthru, meltt, melts, meltb, congel, snoice, & + fswthru, fswthruvdr, fswthruvdf, fswthruidr, fswthruidf, & + meltt, melts, meltb, congel, snoice, & flatn_f, fsensn_f, fsurfn_f, fcondtopn_f use ice_flux_bgc, only: dsnown, faero_atm, faero_ocn, fiso_atm, fiso_ocn, & Qa_iso, Qref_iso, fiso_evap, HDO_ocn, H2_16O_ocn, H2_18O_ocn @@ -387,6 +395,10 @@ subroutine step_therm1 (dt, iblk) fswsfcn = fswsfcn (i,j,:,iblk), & fswintn = fswintn (i,j,:,iblk), & fswthrun = fswthrun (i,j,:,iblk), & + fswthrunvdr = fswthrunvdr (i,j,:,iblk), & + fswthrunvdf = fswthrunvdf (i,j,:,iblk), & + fswthrunidr = fswthrunidr (i,j,:,iblk), & + fswthrunidf = fswthrunidf (i,j,:,iblk), & fswabs = fswabs (i,j, iblk), & flwout = flwout (i,j, iblk), & Sswabsn = Sswabsn (i,j,:,:,iblk), & @@ -403,6 +415,10 @@ subroutine step_therm1 (dt, iblk) fsalt = fsalt (i,j, iblk), & fhocn = fhocn (i,j, iblk), & fswthru = fswthru (i,j, iblk), & + fswthruvdr = fswthruvdr (i,j, iblk), & + fswthruvdf = fswthruvdf (i,j, iblk), & + fswthruidr = fswthruidr (i,j, iblk), & + fswthruidf = fswthruidf (i,j, iblk), & flatn_f = flatn_f (i,j,:,iblk), & fsensn_f = fsensn_f (i,j,:,iblk), & fsurfn_f = fsurfn_f (i,j,:,iblk), & @@ -983,7 +999,8 @@ end subroutine step_dyn_ridge subroutine step_radiation (dt, iblk) use ice_arrays_column, only: ffracn, dhsn, & - fswsfcn, fswintn, fswthrun, fswpenln, Sswabsn, Iswabsn, & + fswsfcn, fswintn, fswpenln, Sswabsn, Iswabsn, & + fswthrun, fswthrunvdr, fswthrunvdf, fswthrunidr, fswthrunidf, & albicen, albsnon, albpndn, & alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, & kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & @@ -1120,7 +1137,12 @@ subroutine step_radiation (dt, iblk) alvdrn =alvdrn (i,j,: ,iblk), alvdfn =alvdfn (i,j,: ,iblk), & alidrn =alidrn (i,j,: ,iblk), alidfn =alidfn (i,j,: ,iblk), & fswsfcn =fswsfcn (i,j,: ,iblk), fswintn =fswintn (i,j,: ,iblk), & - fswthrun =fswthrun (i,j,: ,iblk), fswpenln=fswpenln(i,j,:,:,iblk), & + fswthrun =fswthrun (i,j,: ,iblk), & + fswthrunvdr =fswthrunvdr (i,j,: ,iblk), & + fswthrunvdf =fswthrunvdf (i,j,: ,iblk), & + fswthrunidr =fswthrunidr (i,j,: ,iblk), & + fswthrunidf =fswthrunidf (i,j,: ,iblk), & + fswpenln=fswpenln(i,j,:,:,iblk), & Sswabsn =Sswabsn (i,j,:,:,iblk), Iswabsn =Iswabsn (i,j,:,:,iblk), & albicen =albicen (i,j,: ,iblk), albsnon =albsnon (i,j,: ,iblk), & albpndn =albpndn (i,j,: ,iblk), apeffn =apeffn (i,j,: ,iblk), & diff --git a/cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 b/cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 deleted file mode 100644 index a3b4e6084..000000000 --- a/cicecore/drivers/mct/cesm2/CICE_FinalMod.F90 +++ /dev/null @@ -1,94 +0,0 @@ -! SVN:$Id: CICE_FinalMod.F90 744 2013-09-27 22:53:24Z eclare $ -!======================================================================= -! -! This module contains routines for the final exit of the CICE model, -! including final output and clean exit from any message passing -! environments and frameworks. -! -! authors: Philip W. Jones, LANL -! 2006: Converted to free source form (F90) by Elizabeth Hunke -! 2008: E. Hunke moved ESMF code to its own driver - - module CICE_FinalMod - - use ice_kinds_mod - - implicit none - private - public :: CICE_Finalize - -!======================================================================= - - contains - -!======================================================================= -! -! This routine shuts down CICE by exiting all relevent environments. - - subroutine CICE_Finalize - - use ice_exit, only: end_run - use ice_fileunits, only: nu_diag, release_all_fileunits - use ice_restart_shared, only: runid - use ice_timers, only: ice_timer_stop, ice_timer_print_all, timer_total - - !------------------------------------------------------------------- - ! stop timers and print timer info - !------------------------------------------------------------------- - -! call ice_timer_stop(timer_total) ! stop timing entire run - call ice_timer_print_all(stats=.false.) ! print timing information - -!echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output - call release_all_fileunits - - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - - !------------------------------------------------------------------- - ! quit MPI - !------------------------------------------------------------------- - -#ifdef CESMCOUPLED -#define coupled -#endif - -#ifndef coupled - call end_run ! quit MPI -#endif - - end subroutine CICE_Finalize - -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - use ice_communicate, only: my_task, master_task - - character(len=char_len_long) :: filename - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - -!======================================================================= - - end module CICE_FinalMod - -!======================================================================= diff --git a/cicecore/drivers/mct/cesm2/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm2/CICE_InitMod.F90 deleted file mode 100644 index e48ff6b6f..000000000 --- a/cicecore/drivers/mct/cesm2/CICE_InitMod.F90 +++ /dev/null @@ -1,355 +0,0 @@ -! SVN:$Id: CICE_InitMod.F90 746 2013-09-28 22:47:56Z eclare $ -!======================================================================= -! -! This module contains the CICE initialization routine that sets model -! parameters and initializes the grid and CICE state variables. -! -! authors Elizabeth C. Hunke, LANL -! William H. Lipscomb, LANL -! Philip W. Jones, LANL -! -! 2006: Converted to free form source (F90) by Elizabeth Hunke -! 2008: E. Hunke moved ESMF code to its own driver - - module CICE_InitMod - - use ice_kinds_mod - - implicit none - private - public :: CICE_Initialize, cice_init - -!======================================================================= - - contains - -!======================================================================= - -! Initialize the basic state, grid and all necessary parameters for -! running the CICE model. Return the initial state in routine -! export state. -! Note: This initialization driver is designed for standalone and -! CCSM-coupled applications. For other -! applications (e.g., standalone CAM), this driver would be -! replaced by a different driver that calls subroutine cice_init, -! where most of the work is done. - - subroutine CICE_Initialize - - !-------------------------------------------------------------------- - ! model initialization - !-------------------------------------------------------------------- - - call cice_init - - end subroutine CICE_Initialize - -!======================================================================= -! -! Initialize CICE model. - - subroutine cice_init(mpicom_ice) - - use ice_aerosol, only: faero_default - use ice_algae, only: get_forcing_bgc - use ice_calendar, only: dt, dt_dyn, write_ic, & - init_calendar, calendar, time - use ice_communicate, only: init_communicate - use ice_diagnostics, only: init_diags - use ice_domain, only: init_domain_blocks - use ice_dyn_eap, only: init_eap - use ice_dyn_shared, only: kdyn, init_evp - use ice_fileunits, only: init_fileunits - use ice_flux, only: init_coupler_flux, init_history_therm, & - init_history_dyn, init_flux_atm, init_flux_ocn - use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & - get_forcing_atmo, get_forcing_ocn - use ice_grid, only: init_grid1, init_grid2 - use ice_history, only: init_hist, accum_hist - use ice_restart_shared, only: restart, runid, runtype - use ice_init, only: input_data, init_state - use ice_itd, only: init_itd - use ice_kinds_mod - use ice_restoring, only: ice_HaloRestore_init - use ice_shortwave, only: init_shortwave - use ice_state, only: tr_aero - use ice_therm_vertical, only: init_thermo_vertical - use ice_timers, only: timer_total, init_ice_timers, ice_timer_start, ice_timer_stop - use ice_transport_driver, only: init_transport - use ice_zbgc, only: init_zbgc - use ice_zbgc_shared, only: skl_bgc -#ifdef popcice - use drv_forcing, only: sst_sss -#endif - -! !INPUT/OUTPUT PARAMETERS: - integer (kind=int_kind), optional, intent(in) :: & - mpicom_ice ! communicator for sequential ccsm - - call init_communicate(mpicom_ice) ! initial setup for message passing - call init_fileunits ! unit numbers - call input_data ! namelist variables - if (trim(runid) == 'bering') call check_finished_file - call init_zbgc ! vertical biogeochemistry namelist - - call init_domain_blocks ! set up block decomposition - call init_grid1 ! domain distribution - call init_ice_timers ! initialize all timers - call ice_timer_start(timer_total) ! start timing entire run - call init_grid2 ! grid variables - - call init_calendar ! initialize some calendar stuff - call init_hist (dt) ! initialize output history file - - if (kdyn == 2) then - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables - endif - - call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif - call init_thermo_vertical ! initialize vertical thermodynamics - call init_itd ! initialize ice thickness distribution - call calendar(time) ! determine the initial date - - call init_forcing_ocn(dt) ! initialize sss and sst from data - call init_state ! initialize the ice state - call init_transport ! initialize horizontal transport - call ice_HaloRestore_init ! restored boundary conditions - - call init_restart ! initialize restart variables - - call init_diags ! initialize diagnostic output points - call init_history_therm ! initialize thermo history variables - call init_history_dyn ! initialize dynamic history variables - - ! Initialize shortwave components using swdn from previous timestep - ! if restarting. These components will be scaled to current forcing - ! in prep_radiation. - if (trim(runtype) == 'continue' .or. restart) & - call init_shortwave ! initialize radiative transfer - - !-------------------------------------------------------------------- - ! coupler communication or forcing data initialization - !-------------------------------------------------------------------- - - call init_forcing_atmo ! initialize atmospheric forcing (standalone) - -#ifdef CESMCOUPLED -#define coupled -#endif - -#ifndef coupled - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data -! if (tr_aero) call faero_data ! aerosols - if (tr_aero) call faero_default ! aerosols - if (skl_bgc) call get_forcing_bgc -#endif - - if (runtype == 'initial' .and. .not. restart) & - call init_shortwave ! initialize radiative transfer using current swdn - - call init_flux_atm ! initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler - - -! if (write_ic) call accum_hist(dt) ! write initial conditions - - call ice_timer_stop(timer_total) ! stop timing entire run - - end subroutine cice_init - -!======================================================================= - - subroutine init_restart - - use ice_aerosol, only: init_aerosol - use ice_age, only: init_age, restart_age, read_restart_age - use ice_blocks, only: nx_block, ny_block - use ice_brine, only: init_hbrine - use ice_calendar, only: time, calendar - use ice_domain, only: nblocks - use ice_domain_size, only: ncat, max_ntrcr - use ice_dyn_eap, only: read_restart_eap - use ice_dyn_shared, only: kdyn - use ice_firstyear, only: init_fy, restart_FY, read_restart_FY - use ice_flux, only: sss - use ice_grid, only: tmask - use ice_init, only: ice_ic - use ice_itd, only: aggregate - use ice_lvl, only: init_lvl, restart_lvl, read_restart_lvl - use ice_meltpond_cesm, only: init_meltponds_cesm, & - restart_pond_cesm, read_restart_pond_cesm - use ice_meltpond_lvl, only: init_meltponds_lvl, & - restart_pond_lvl, read_restart_pond_lvl, dhsn - use ice_meltpond_topo, only: init_meltponds_topo, & - restart_pond_topo, read_restart_pond_topo - use ice_restart_shared, only: runtype, restart - use ice_restart_driver, only: restartfile, restartfile_v4 - use ice_state ! almost everything - use ice_zbgc, only: init_bgc - use ice_zbgc_shared, only: skl_bgc - - integer(kind=int_kind) :: iblk, ltmp - - if (trim(runtype) == 'continue') then - ! start from core restart file - call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters - if (kdyn == 2) call read_restart_eap ! EAP - else if (restart) then ! ice_ic = core restart file - ltmp = len_trim(ice_ic) - if (ice_ic(ltmp-2:ltmp) == '.nc') then - call restartfile (ice_ic) ! or 'default' or 'none' - else - call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file - !!! uncomment if EAP restart data exists - ! if (kdyn == 2) call read_restart_eap - endif - endif - - ! tracers - ! ice age tracer - if (tr_iage) then - if (trim(runtype) == 'continue') & - restart_age = .true. - if (restart_age) then - call read_restart_age - else - do iblk = 1, nblocks - call init_age(nx_block, ny_block, ncat, trcrn(:,:,nt_iage,:,iblk)) - enddo ! iblk - endif - endif - ! first-year area tracer - if (tr_FY) then - if (trim(runtype) == 'continue') restart_FY = .true. - if (restart_FY) then - call read_restart_FY - else - do iblk = 1, nblocks - call init_FY(nx_block, ny_block, ncat, trcrn(:,:,nt_FY,:,iblk)) - enddo ! iblk - endif - endif - ! level ice tracer - if (tr_lvl) then - if (trim(runtype) == 'continue') restart_lvl = .true. - if (restart_lvl) then - call read_restart_lvl - else - do iblk = 1, nblocks - call init_lvl(nx_block, ny_block, ncat, & - trcrn(:,:,nt_alvl,:,iblk), trcrn(:,:,nt_vlvl,:,iblk)) - enddo ! iblk - endif - endif - ! CESM melt ponds - if (tr_pond_cesm) then - if (trim(runtype) == 'continue') & - restart_pond_cesm = .true. - if (restart_pond_cesm) then - call read_restart_pond_cesm - else - do iblk = 1, nblocks - call init_meltponds_cesm(nx_block, ny_block, ncat, & - trcrn(:,:,nt_apnd,:,iblk), trcrn(:,:,nt_hpnd,:,iblk)) - enddo ! iblk - endif - endif - ! level-ice melt ponds - if (tr_pond_lvl) then - if (trim(runtype) == 'continue') & - restart_pond_lvl = .true. - if (restart_pond_lvl) then - call read_restart_pond_lvl - else - do iblk = 1, nblocks - call init_meltponds_lvl(nx_block, ny_block, ncat, & - trcrn(:,:,nt_apnd,:,iblk), trcrn(:,:,nt_hpnd,:,iblk), & - trcrn(:,:,nt_ipnd,:,iblk), dhsn(:,:,:,iblk)) - enddo ! iblk - endif - endif - ! topographic melt ponds - if (tr_pond_topo) then - if (trim(runtype) == 'continue') & - restart_pond_topo = .true. - if (restart_pond_topo) then - call read_restart_pond_topo - else - do iblk = 1, nblocks - call init_meltponds_topo(nx_block, ny_block, ncat, & - trcrn(:,:,nt_apnd,:,iblk), trcrn(:,:,nt_hpnd,:,iblk), & - trcrn(:,:,nt_ipnd,:,iblk)) - enddo ! iblk - endif ! .not restart_pond - endif - if (tr_aero) call init_aerosol ! ice aerosol - if (tr_brine) call init_hbrine ! brine height tracer - if (skl_bgc) call init_bgc ! biogeochemistry - - !----------------------------------------------------------------- - ! aggregate tracers - !----------------------------------------------------------------- - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - call aggregate (nx_block, ny_block, & - aicen(:,:,:,iblk), & - trcrn(:,:,:,:,iblk),& - vicen(:,:,:,iblk), & - vsnon(:,:,:,iblk), & - aice (:,:, iblk), & - trcr (:,:,:,iblk), & - vice (:,:, iblk), & - vsno (:,:, iblk), & - aice0(:,:, iblk), & - tmask(:,:, iblk), & - max_ntrcr, & - trcr_depend) - - enddo - !$OMP END PARALLEL DO - - end subroutine init_restart - -!======================================================================= -! -! Check whether a file indicating that the previous run finished cleanly -! If so, then do not continue the current restart. This is needed only -! for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine check_finished_file() - - use ice_communicate, only: my_task, master_task - use ice_exit, only: abort_ice - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - logical :: lexist = .false. - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - inquire(file=filename, exist=lexist) - if (lexist) then - call abort_ice("Found already finished file - quitting") - end if - - endif - - end subroutine check_finished_file - -!======================================================================= - - end module CICE_InitMod - -!======================================================================= diff --git a/cicecore/drivers/mct/cesm2/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm2/CICE_RunMod.F90 deleted file mode 100644 index ef9e4cf73..000000000 --- a/cicecore/drivers/mct/cesm2/CICE_RunMod.F90 +++ /dev/null @@ -1,535 +0,0 @@ -! SVN:$Id: CICE_RunMod.F90 746 2013-09-28 22:47:56Z eclare $ -!======================================================================= -! -! Main driver for time stepping of CICE. -! -! authors Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL -! -! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep -! 2006 ECH: Streamlined for efficiency -! 2006 ECH: Converted to free source form (F90) -! 2007 BPB: Modified Delta-Eddington shortwave interface -! 2008 ECH: moved ESMF code to its own driver - - module CICE_RunMod - - use ice_kinds_mod - use perf_mod, only : t_startf, t_stopf, t_barrierf - use ice_fileunits, only: nu_diag - - implicit none - private - public :: CICE_Run, ice_step - -!======================================================================= - - contains - -!======================================================================= -! -! This is the main driver routine for advancing CICE forward in time. -! -! author Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL - - subroutine CICE_Run - - use ice_aerosol, only: faero_default - use ice_algae, only: get_forcing_bgc - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar - use ice_forcing, only: get_forcing_atmo, get_forcing_ocn - use ice_flux, only: init_flux_atm, init_flux_ocn - use ice_state, only: tr_aero - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_couple, timer_step - use ice_zbgc_shared, only: skl_bgc - - !-------------------------------------------------------------------- - ! initialize error code and step timer - !-------------------------------------------------------------------- - - call ice_timer_start(timer_step) ! start timing entire run - - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- - - ! timeLoop: do - - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call init_flux_atm ! initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler - - call calendar(time) ! at the end of the timestep - - call ice_step - -! if (stop_now >= 1) exit timeLoop - -! enddo timeLoop - - !-------------------------------------------------------------------- - ! end of timestep loop - !-------------------------------------------------------------------- - - call ice_timer_stop(timer_step) ! end timestepping loop timer - - end subroutine CICE_Run - -!======================================================================= -! -! Calls drivers for physics components, some initialization, and output -! -! author Elizabeth C. Hunke, LANL -! William H. Lipscomb, LANL - - subroutine ice_step - - use ice_age, only: write_restart_age - use ice_aerosol, only: write_restart_aero - use ice_boundary, only: ice_HaloUpdate - use ice_brine, only: hbrine_diags, write_restart_hbrine - use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep, idate, sec - use ice_constants, only: field_loc_center, field_type_scalar - use ice_diagnostics, only: init_mass_diags, runtime_diags, print_points_state - use ice_domain, only: halo_info, nblocks - use ice_domain_size, only: nslyr - use ice_dyn_eap, only: write_restart_eap - use ice_dyn_shared, only: kdyn - use ice_firstyear, only: write_restart_FY - use ice_flux, only: scale_factor, init_history_therm - use ice_history, only: accum_hist - use ice_lvl, only: write_restart_lvl - use ice_restart, only: final_restart - use ice_restart_driver, only: dumpfile - use ice_meltpond_cesm, only: write_restart_pond_cesm - use ice_meltpond_lvl, only: write_restart_pond_lvl - use ice_meltpond_topo, only: write_restart_pond_topo - use ice_restoring, only: restore_ice, ice_HaloRestore - use ice_state, only: nt_qsno, trcrn, tr_iage, tr_FY, tr_lvl, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero - use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, & - post_thermo, step_dynamics, step_radiation - use ice_therm_shared, only: calc_Tsfc - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_diags, timer_column, timer_thermo, timer_bound, & - timer_hist, timer_readwrite - use ice_algae, only: bgc_diags, write_restart_bgc - use ice_zbgc, only: init_history_bgc, biogeochemistry - use ice_zbgc_shared, only: skl_bgc - use ice_communicate, only: MPI_COMM_ICE - use ice_prescribed_mod - - integer (kind=int_kind) :: & - iblk , & ! block index - k ! dynamics supercycling index - - !----------------------------------------------------------------- - ! restoring on grid boundaries - !----------------------------------------------------------------- - - if (restore_ice) call ice_HaloRestore - - !----------------------------------------------------------------- - ! initialize diagnostics - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics/history - call init_mass_diags ! diagnostics per timestep - call init_history_therm - call init_history_bgc - call ice_timer_stop(timer_diags) ! diagnostics/history - - if(prescribed_ice) then ! read prescribed ice - call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) - call t_startf ('cice_run_presc') - call ice_prescribed_run(idate, sec) - call t_stopf ('cice_run_presc') - endif - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - !----------------------------------------------------------------- - ! Scale radiation fields - !----------------------------------------------------------------- - - if (calc_Tsfc) call prep_radiation (dt, iblk) - - !----------------------------------------------------------------- - ! thermodynamics - !----------------------------------------------------------------- - - call step_therm1 (dt, iblk) ! vertical thermodynamics - call biogeochemistry (dt, iblk) ! biogeochemistry - if (.not.prescribed_ice) & - call step_therm2 (dt, iblk) ! ice thickness distribution thermo - - enddo ! iblk - !$OMP END PARALLEL DO - - call post_thermo (dt) ! finalize thermo update - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! dynamics, transport, ridging - !----------------------------------------------------------------- - - if (.not.prescribed_ice .and. kdyn>0) then - do k = 1, ndtd - call step_dynamics (dt_dyn, ndtd) - enddo - endif - - !----------------------------------------------------------------- - ! albedo, shortwave radiation - !----------------------------------------------------------------- - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - call step_radiation (dt, iblk) - - !----------------------------------------------------------------- - ! get ready for coupling and the next time step - !----------------------------------------------------------------- - - call coupling_prep (iblk) - - enddo ! iblk - !$OMP END PARALLEL DO - - call ice_timer_start(timer_bound) - call ice_HaloUpdate (scale_factor, halo_info, & - field_loc_center, field_type_scalar) - call ice_timer_stop(timer_bound) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! write data - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics - if (mod(istep,diagfreq) == 0) then - call runtime_diags(dt) ! log file - if (skl_bgc) call bgc_diags (dt) - if (tr_brine) call hbrine_diags (dt) - endif - call ice_timer_stop(timer_diags) ! diagnostics - - call ice_timer_start(timer_hist) ! history - call accum_hist (dt) ! history file - call ice_timer_stop(timer_hist) ! history - - call ice_timer_start(timer_readwrite) ! reading/writing - if (write_restart == 1) then - call dumpfile ! core variables for restarting - if (tr_iage) call write_restart_age - if (tr_FY) call write_restart_FY - if (tr_lvl) call write_restart_lvl - if (tr_pond_cesm) call write_restart_pond_cesm - if (tr_pond_lvl) call write_restart_pond_lvl - if (tr_pond_topo) call write_restart_pond_topo - if (tr_aero) call write_restart_aero - if (skl_bgc) call write_restart_bgc - if (tr_brine) call write_restart_hbrine - if (kdyn == 2) call write_restart_eap - call final_restart - endif - - call ice_timer_stop(timer_readwrite) ! reading/writing - - end subroutine ice_step - -!======================================================================= -! -! Prepare for coupling -! -! authors: Elizabeth C. Hunke, LANL - - subroutine coupling_prep (iblk) - - use ice_blocks, only: block, nx_block, ny_block - use ice_calendar, only: dt, nstreams - use ice_constants, only: c0, c1, puny, rhofresh - use ice_domain_size, only: ncat - use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & - albpnd, albcnt, apeff_ai, coszen, fpond, fresh, l_mpond_fresh, & - alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & - fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, fswthru, scale_factor, & - fswthruvdr, fswthruvdf, fswthruidr, fswthruidf, & - swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyt, & - fsens, flat, fswabs, flwout, evap, Tref, Qref, Uref, faero_ocn, & - fsurfn_f, flatn_f, scale_fluxes, frzmlt_init, frzmlt, wind, & - snowfrac - use ice_grid, only: tmask - use ice_ocean, only: oceanmixed_ice, ocean_mixed_layer - use ice_shortwave, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, snowfracn - use ice_state, only: aicen, aice, aice_init, nbtrcr - use ice_therm_shared, only: calc_Tsfc - use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop - use ice_zbgc_shared, only: flux_bio, flux_bio_ai - - integer (kind=int_kind), intent(in) :: & - iblk ! block index - - ! local variables - - integer (kind=int_kind) :: & - n , & ! thickness category index - i,j , & ! horizontal indices - k ! tracer index - - real (kind=dbl_kind) :: cszn ! counter for history averaging - - real (kind=dbl_kind) :: netsw - - !----------------------------------------------------------------- - ! Save current value of frzmlt for diagnostics. - ! Update mixed layer with heat and radiation from ice. - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk) - enddo - enddo - - call ice_timer_start(timer_couple,iblk) ! atm/ocn coupling - - if (oceanmixed_ice) & - call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst - - !----------------------------------------------------------------- - ! Aggregate albedos - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - alvdf(i,j,iblk) = c0 - alidf(i,j,iblk) = c0 - alvdr(i,j,iblk) = c0 - alidr(i,j,iblk) = c0 - - albice(i,j,iblk) = c0 - albsno(i,j,iblk) = c0 - albpnd(i,j,iblk) = c0 - apeff_ai(i,j,iblk) = c0 - snowfrac(i,j,iblk) = c0 - - ! for history averaging - cszn = c0 - netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk) - if (netsw > puny) cszn = c1 - do n = 1, nstreams - albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn - enddo - enddo - enddo - do n = 1, ncat - do j = 1, ny_block - do i = 1, nx_block - alvdf(i,j,iblk) = alvdf(i,j,iblk) & - + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidf(i,j,iblk) = alidf(i,j,iblk) & - + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alvdr(i,j,iblk) = alvdr(i,j,iblk) & - + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidr(i,j,iblk) = alidr(i,j,iblk) & - + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) - - if (coszen(i,j,iblk) > puny) then ! sun above horizon - albice(i,j,iblk) = albice(i,j,iblk) & - + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) - albsno(i,j,iblk) = albsno(i,j,iblk) & - + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) - albpnd(i,j,iblk) = albpnd(i,j,iblk) & - + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) - endif - - apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history - + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) - snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history - + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) - enddo - enddo - enddo - - do j = 1, ny_block - do i = 1, nx_block - - !----------------------------------------------------------------- - ! reduce fresh by fpond for coupling - !----------------------------------------------------------------- - - if (l_mpond_fresh) then - fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt - fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk) - endif - - !---------------------------------------------------------------- - ! Store grid box mean albedos and fluxes before scaling by aice - !---------------------------------------------------------------- - - alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) - alidf_ai (i,j,iblk) = alidf (i,j,iblk) - alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) - alidr_ai (i,j,iblk) = alidr (i,j,iblk) - fresh_ai (i,j,iblk) = fresh (i,j,iblk) - fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) - fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) - fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - - if (nbtrcr > 0) then - do k = 1, nbtrcr - flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) - enddo - endif - - !----------------------------------------------------------------- - ! Save net shortwave for scaling factor in scale_factor - !----------------------------------------------------------------- - scale_factor(i,j,iblk) = & - swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & - + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & - + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & - + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) - - enddo - enddo - - !----------------------------------------------------------------- - ! Divide fluxes by ice area - ! - the CCSM coupler assumes fluxes are per unit ice area - ! - also needed for global budget in diagnostics - !----------------------------------------------------------------- - - call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk) , nbtrcr, & - aice (:,:,iblk) , Tf (:,:,iblk), & - Tair (:,:,iblk) , Qa (:,:,iblk), & - strairxT (:,:,iblk) , strairyT(:,:,iblk), & - fsens (:,:,iblk) , flat (:,:,iblk), & - fswabs (:,:,iblk) , flwout (:,:,iblk), & - evap (:,:,iblk) , & - Tref (:,:,iblk) , Qref (:,:,iblk), & - fresh (:,:,iblk) , fsalt (:,:,iblk), & - fhocn (:,:,iblk) , fswthru (:,:,iblk), & - fswthruvdr(:,:,iblk), fswthruvdf(:,:,iblk), & - fswthruidr(:,:,iblk) , fswthruidf(:,:,iblk), & - faero_ocn (:,:,:,iblk), & - alvdr (:,:,iblk) , alidr (:,:,iblk), & - alvdf (:,:,iblk) , alidf (:,:,iblk), & - flux_bio (:,:,1:nbtrcr,iblk), & - Uref=Uref (:,:,iblk), wind=wind(:,:,iblk) ) - -!echmod - comment this out for efficiency, if .not. calc_Tsfc - if (.not. calc_Tsfc) then - - !--------------------------------------------------------------- - ! If surface fluxes were provided, conserve these fluxes at ice - ! free points by passing to ocean. - !--------------------------------------------------------------- - - call sfcflux_to_ocn & - (nx_block, ny_block, & - tmask (:,:,iblk), aice_init(:,:,iblk), & - fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), & - fresh (:,:,iblk), fhocn (:,:,iblk)) - endif -!echmod - - call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling - - end subroutine coupling_prep - -!======================================================================= -! -! If surface heat fluxes are provided to CICE instead of CICE calculating -! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can -! be provided at points which do not have ice. (This is could be due to -! the heat fluxes being calculated on a lower resolution grid or the -! heat fluxes not recalculated at every CICE timestep.) At ice free points, -! conserve energy and water by passing these fluxes to the ocean. -! -! author: A. McLaren, Met Office - - subroutine sfcflux_to_ocn(nx_block, ny_block, & - tmask, aice, & - fsurfn_f, flatn_f, & - fresh, fhocn) - - use ice_domain_size, only: ncat - - integer (kind=int_kind), intent(in) :: & - nx_block, ny_block ! block dimensions - - logical (kind=log_kind), dimension (nx_block,ny_block), & - intent(in) :: & - tmask ! land/boundary mask, thickness (T-cell) - - real (kind=dbl_kind), dimension(nx_block,ny_block), & - intent(in):: & - aice ! initial ice concentration - - real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), & - intent(in) :: & - fsurfn_f, & ! net surface heat flux (provided as forcing) - flatn_f ! latent heat flux (provided as forcing) - - real (kind=dbl_kind), dimension(nx_block,ny_block), & - intent(inout):: & - fresh , & ! fresh water flux to ocean (kg/m2/s) - fhocn ! actual ocn/ice heat flx (W/m**2) - -#ifdef CICE_IN_NEMO - - ! local variables - integer (kind=int_kind) :: & - i, j, n ! horizontal indices - - real (kind=dbl_kind) :: & - rLsub ! 1/Lsub - - rLsub = c1 / Lsub - - do n = 1, ncat - do j = 1, ny_block - do i = 1, nx_block - if (tmask(i,j) .and. aice(i,j) <= puny) then - fhocn(i,j) = fhocn(i,j) & - + fsurfn_f(i,j,n) + flatn_f(i,j,n) - fresh(i,j) = fresh(i,j) & - + flatn_f(i,j,n) * rLsub - endif - enddo ! i - enddo ! j - enddo ! n - -#endif - - end subroutine sfcflux_to_ocn - -!======================================================================= - - end module CICE_RunMod - -!======================================================================= diff --git a/cicecore/drivers/mct/cesm2/ice_comp_mct.F90 b/cicecore/drivers/mct/cesm2/ice_comp_mct.F90 deleted file mode 100644 index 678b94312..000000000 --- a/cicecore/drivers/mct/cesm2/ice_comp_mct.F90 +++ /dev/null @@ -1,1196 +0,0 @@ -module ice_comp_mct - -!--------------------------------------------------------------------------- -!BOP -! -! !MODULE: ice_comp_mct -! -! !DESCRIPTION: -! CICE interface routine for the ccsm cpl7 mct system -! -! !USES: - - use shr_kind_mod, only : r8 => shr_kind_r8 - use shr_sys_mod, only : shr_sys_abort, shr_sys_flush - use shr_file_mod, only : shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setloglevel, shr_file_setlogunit - use mct_mod -#ifdef USE_ESMF_LIB - use esmf -#else - use esmf, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet -#endif - - use seq_flds_mod - use seq_cdata_mod, only : seq_cdata, seq_cdata_setptrs - use seq_infodata_mod,only : seq_infodata_type, seq_infodata_getdata, & - seq_infodata_putdata, seq_infodata_start_type_cont, & - seq_infodata_start_type_brnch, seq_infodata_start_type_start - use seq_timemgr_mod, only : seq_timemgr_eclockgetdata, & - seq_timemgr_restartalarmison, & - seq_timemgr_eclockdateinsync, & - seq_timemgr_stopalarmison - use seq_comm_mct, only : seq_comm_suffix, seq_comm_inst, seq_comm_name - use perf_mod, only : t_startf, t_stopf, t_barrierf - - use ice_cpl_indices - use ice_import_export - use ice_state, only : aice - use ice_domain_size, only : nx_global, ny_global, block_size_x, block_size_y, max_blocks - use ice_domain, only : nblocks, blocks_ice, halo_info, distrb_info - use ice_blocks, only : block, get_block, nx_block, ny_block - use ice_grid, only : tlon, tlat, tarea, tmask, anglet, hm, & - grid_type, t2ugrid_vector, gridcpl_file, ocn_gridcell_frac - use ice_constants, only : c0, c1, spval_dbl, rad_to_deg, radius, secday - use ice_communicate, only : my_task, master_task, MPI_COMM_ICE - use ice_calendar, only : istep, istep1, force_restart_now, write_ic,& - idate, idate0, mday, time, month, daycal, & - sec, dt, dt_dyn, calendar, & - calendar_type, nextsw_cday, days_per_year, & - nyr, new_year, time2sec, year_init, & - use_leap_years, basis_seconds - use ice_orbital, only : eccen, obliqr, lambm0, mvelpp - use ice_ocean, only : tfrz_option - use ice_timers - - use ice_kinds_mod, only : int_kind, dbl_kind, char_len_long, log_kind - use ice_boundary, only : ice_HaloUpdate - use ice_scam, only : scmlat, scmlon, single_column - use ice_fileunits, only : nu_diag, inst_index, inst_name, inst_suffix, & - release_all_fileunits - use ice_therm_shared, only: ktherm - use ice_prescribed_mod - use ice_step_mod - use ice_global_reductions - use ice_broadcast - use CICE_RunMod - use ice_atmo, only : flux_convergence_tolerance, flux_convergence_max_iteration, use_coldair_outbreak_mod - -! !PUBLIC MEMBER FUNCTIONS: - implicit none - public :: ice_init_mct - public :: ice_run_mct - public :: ice_final_mct - SAVE - private ! By default make data private -! -! ! PUBLIC DATA: -! -! !REVISION HISTORY: -! Author: Jacob Sewall, Mariana Vertenstein -! -!EOP -! !PRIVATE MEMBER FUNCTIONS: - private :: ice_SetGSMap_mct - private :: ice_domain_mct - private :: ice_setdef_mct - private :: ice_coffset_mct - private :: ice_setcoupling_mct - -! -! !PRIVATE VARIABLES - - integer (kind=int_kind) :: ICEID - - !--- for coupling on other grid from gridcpl_file --- - type(mct_gsMap) :: gsMap_iloc ! local gsmaps - type(mct_gGrid) :: dom_iloc ! local domain - type(mct_aVect) :: x2i_iloc, i2x_iloc - type(mct_rearr) :: rearr_ice2iloc - type(mct_rearr) :: rearr_iloc2ice - integer :: nxcpl, nycpl ! size of coupling grid - logical :: other_cplgrid ! using different coupling grid -#ifdef COMPARE_TO_NUOPC - logical :: compare_to_nuopc = .true. -#else - logical :: compare_to_nuopc = .false. -#endif -!======================================================================= - -contains - -!======================================================================= -!BOP -! -! !IROUTINE: ice_init_mct -! -! !INTERFACE: - subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename ) -! -! !DESCRIPTION: -! Initialize thermodynamic ice model and obtain relevant atmospheric model -! arrays back from driver -! -! !USES: - - use CICE_InitMod - use ice_restart_shared, only: runid, runtype, restart_dir, restart_format - use ice_history, only: accum_hist - use ice_history_shared, only: history_dir, history_file, model_doi_url -! -! !ARGUMENTS: - type(ESMF_Clock) , intent(inout) :: EClock - type(seq_cdata) , intent(inout) :: cdata_i - type(mct_aVect) , intent(inout) :: x2i_i, i2x_i - character(len=*), optional , intent(in) :: NLFilename ! Namelist filename -! -! !LOCAL VARIABLES: -! - type(mct_gsMap) , pointer :: gsMap_ice - type(mct_gGrid) , pointer :: dom_i - type(seq_infodata_type) , pointer :: infodata ! Input init object - integer :: lsize,lsize_loc - integer :: xoff,yoff - integer :: nxg,nyg - integer :: k, iblk - - type(mct_gsMap) :: gsmap_extend ! local gsmaps - - character(len=256) :: drvarchdir ! driver archive directory - character(len=32) :: starttype ! infodata start type - integer :: start_ymd ! Start date (YYYYMMDD) - integer :: start_tod ! start time of day (s) - integer :: curr_ymd ! Current date (YYYYMMDD) - integer :: curr_tod ! Current time of day (s) - integer :: ref_ymd ! Reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (s) - integer :: iyear ! yyyy - integer :: nyrp ! yyyy - integer :: dtime ! time step - integer :: shrlogunit,shrloglev ! old values - integer :: iam,ierr - integer :: lbnum - integer :: daycal(13) !number of cumulative days per month - integer :: nleaps ! number of leap days before current year - integer :: mpicom_loc ! temporary mpicom - logical (kind=log_kind) :: atm_aero - real(r8) :: mrss, mrss0,msize,msize0 - type(ESMF_TIME) :: currTime - integer :: rc - character(len=*), parameter :: SubName = "ice_init_mct" -!EOP -!----------------------------------------------------------------------- - - call t_startf ('cice_init_total') - - !-------------------------------------------------------------------------- - ! Determine attribute vector indices - !-------------------------------------------------------------------------- - - call ice_cpl_indices_set() - - !--------------------------------------------------------------------------- - ! Set cdata pointers - !--------------------------------------------------------------------------- - - call seq_cdata_setptrs(cdata_i, ID=ICEID, mpicom=mpicom_loc, & - gsMap=gsMap_ice, dom=dom_i, infodata=infodata) - - ! Determine time of next atmospheric shortwave calculation - call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) - - ! Determine if aerosols are coming from the coupler - call seq_infodata_GetData(infodata, atm_aero=atm_aero ) - - ! Determine orbital parameters - call seq_infodata_GetData(infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & - orb_lambm0=lambm0, orb_obliqr=obliqr) - - ! Get model_doi_url - call seq_infodata_GetData(infodata, model_doi_url=model_doi_url) - - ! call shr_init_memusage() - - !--------------------------------------------------------------------------- - ! use infodata to determine type of run - !--------------------------------------------------------------------------- - - ! Preset single column values - - single_column = .false. - scmlat = -999. - scmlon = -999. - - call seq_infodata_GetData( infodata, case_name=runid , & - single_column=single_column ,scmlat=scmlat,scmlon=scmlon) - call seq_infodata_GetData( infodata, start_type=starttype) - - if ( trim(starttype) == trim(seq_infodata_start_type_start)) then - runtype = "initial" - else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then - runtype = "continue" - else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then - runtype = "continue" - else - write(nu_diag,*) trim(subname),' ERROR: unknown starttype' - call shr_sys_abort() - end if - - ! Set nextsw_cday to -1 for continue and branch runs. - - if (trim(runtype) /= 'initial') then - nextsw_cday = -1 - else - if (compare_to_nuopc) then - ! Note that in the mct version the atm was initialized first - ! so that nextsw_cday could be passed to the other - ! components - this assumed that cam or datm was ALWAYS - ! initialized first. In the nuopc version it will be easier - ! to assume that on startup - nextsw_cday is just the current time - - call ESMF_ClockGet( Eclock, currTime=currTime, rc=rc ) - call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) - end if - end if - - !============================================================= - ! Set ice dtime to ice coupling frequency - !============================================================= - - call seq_timemgr_EClockGetData(EClock, dtime=dtime, calendar=calendar_type) - dt = real(dtime) - - !============================================================= - ! Initialize cice because grid information is needed for - ! creation of GSMap_ice. cice_init also sets time manager info - !============================================================= - - inst_name = seq_comm_name(ICEID) - inst_index = seq_comm_inst(ICEID) - inst_suffix = seq_comm_suffix(ICEID) - call t_startf ('cice_init') - call cice_init( mpicom_loc ) - call t_stopf ('cice_init') - - call seq_infodata_GetData(infodata, tfreeze_option=tfrz_option ) - - if (my_task == master_task) then - write(nu_diag,*) trim(subname),' tfrz_option = ',trim(tfrz_option) - if (ktherm == 2 .and. trim(tfrz_option) /= 'mushy') then - write(nu_diag,*) trim(subname),' Warning: Using ktherm = 2 and tfrz_option = ', & - trim(tfrz_option) - endif - endif - - ! atmice flux calculation - call seq_infodata_GetData(infodata, & - coldair_outbreak_mod=use_coldair_outbreak_mod, & - flux_convergence=flux_convergence_tolerance, & - flux_max_iteration=flux_convergence_max_iteration) - - if (my_task == master_task) then - write(nu_diag,*) trim(subname),' inst_name = ',trim(inst_name) - write(nu_diag,*) trim(subname),' inst_index = ',inst_index - write(nu_diag,*) trim(subname),' inst_suffix = ',trim(inst_suffix) - write(nu_diag,*) trim(subname),' flux_convergence = ', flux_convergence_tolerance - write(nu_diag,*) trim(subname),' flux_convergence_max_iteration = ', flux_convergence_max_iteration - endif - - !--------------------------------------------------------------------------- - ! Reset shr logging to my log file - !--------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (nu_diag) - - !--------------------------------------------------------------------------- - ! use EClock to reset calendar information on initial start - !--------------------------------------------------------------------------- - - ! - on restart run - ! - istep0, time and time_forc are read from restart file - ! - istep1 is set to istep0 - ! - idate is determined from time via the call to calendar (see below) - ! - on initial run - ! - iyear, month and mday obtained from sync clock - ! - time determined from iyear, month and mday - ! - istep0 and istep1 are set to 0 - - call seq_timemgr_EClockGetData(EClock, & - start_ymd=start_ymd, start_tod=start_tod, & - curr_ymd=curr_ymd, curr_tod=curr_tod, & - ref_ymd=ref_ymd, ref_tod=ref_tod) - - if (runtype == 'initial') then - if (ref_ymd /= start_ymd .or. ref_tod /= start_tod) then - if (my_task == master_task) then - write(nu_diag,*) trim(subname),': ref_ymd ',ref_ymd, & - ' must equal start_ymd ',start_ymd - write(nu_diag,*) trim(subname),': ref_ymd ',ref_tod, & - ' must equal start_ymd ',start_tod - end if - end if - - if (my_task == master_task) then - write(nu_diag,*) trim(subname),' idate from sync clock = ', & - start_ymd - write(nu_diag,*) trim(subname),' tod from sync clock = ', & - start_tod - write(nu_diag,*) & - trim(subname),' resetting idate to match sync clock' - end if - - idate = curr_ymd - - if (idate < 0) then - write(nu_diag,*) trim(subname),' ERROR curr_ymd,year_init =',curr_ymd,year_init - write(nu_diag,*) trim(subname),' ERROR idate lt zero',idate - call shr_sys_abort(subname//' :: ERROR idate lt zero') - endif - iyear = (idate/10000) ! integer year of basedate - month = (idate-iyear*10000)/100 ! integer month of basedate - mday = idate-iyear*10000-month*100 ! day of month of basedate - - if (my_task == master_task) then - write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd - write(nu_diag,*) trim(subname),' cice year_init = ',year_init - write(nu_diag,*) trim(subname),' cice start date = ',idate - write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod - endif - - if (calendar_type /= "GREGORIAN") then - call time2sec(iyear-year_init,month,mday,time) - else - call time2sec(iyear-(year_init-1),month,mday,time) - endif - - time = time+start_tod - - call shr_sys_flush(nu_diag) - end if - - call calendar(time) ! update calendar info - if (write_ic) call accum_hist(dt) ! write initial conditions - - !--------------------------------------------------------------------------- - ! Initialize MCT attribute vectors and indices - !--------------------------------------------------------------------------- - - call t_startf ('cice_mct_init') - - ! Initialize ice gsMap - - if (trim(gridcpl_file) == 'unknown_gridcpl_file') then - call ice_SetGSMap_mct( MPI_COMM_ICE, ICEID, GSMap_ice ) - lsize = mct_gsMap_lsize(gsMap_ice, MPI_COMM_ICE) - call ice_domain_mct( lsize, gsMap_ice, dom_i ) - other_cplgrid = .false. - nxg = nx_global - nyg = ny_global - else - call ice_SetGSMap_mct( MPI_COMM_ICE, ICEID, GSMap_iloc ) - lsize_loc = mct_gsMap_lsize(gsMap_iloc, MPI_COMM_ICE) - call ice_domain_mct( lsize_loc, gsMap_iloc, dom_iloc ) - - call ice_setcoupling_mct(MPI_COMM_ICE, ICEID, gsmap_ice, dom_i) - lsize = mct_gsMap_lsize(gsMap_ice, MPI_COMM_ICE) - - call ice_coffset_mct(xoff,yoff,gsmap_iloc,dom_iloc,gsmap_ice,dom_i,MPI_COMM_ICE) - - call ice_SetGSMap_mct( MPI_COMM_ICE, ICEID, gsmap_extend, xoff, yoff, nxcpl, nycpl) - if (lsize_loc /= mct_gsmap_lsize(gsmap_extend,MPI_COMM_ICE)) then - write(nu_diag,*) subname,' :: gsmap_extend extended ',lsize_loc, & - mct_gsmap_lsize(gsmap_extend,MPI_COMM_ICE) - call shr_sys_abort(subname//' :: error in gsmap_extend extended') - endif - - call mct_rearr_init(gsmap_ice, gsmap_extend, MPI_COMM_ICE, rearr_ice2iloc) - call mct_rearr_init(gsmap_extend, gsmap_ice, MPI_COMM_ICE, rearr_iloc2ice) - call mct_aVect_init(x2i_iloc, rList=seq_flds_x2i_fields, lsize=lsize_loc) - call mct_aVect_zero(x2i_iloc) - call mct_aVect_init(i2x_iloc, rList=seq_flds_i2x_fields, lsize=lsize_loc) - call mct_aVect_zero(i2x_iloc) - call mct_gsmap_clean(gsmap_extend) - - other_cplgrid = .true. - nxg = nxcpl - nyg = nycpl - endif - - ! Inialize mct attribute vectors - - call mct_aVect_init(x2i_i, rList=seq_flds_x2i_fields, lsize=lsize) - call mct_aVect_zero(x2i_i) - - call mct_aVect_init(i2x_i, rList=seq_flds_i2x_fields, lsize=lsize) - call mct_aVect_zero(i2x_i) - - !----------------------------------------------------------------- - ! Prescribed ice initialization - !----------------------------------------------------------------- - - if (other_cplgrid) then - call ice_prescribed_init(ICEID, gsmap_iloc, dom_iloc) - else - call ice_prescribed_init(ICEID, gsmap_ice, dom_i) - endif - - !--------------------------------------------------------------------------- - ! Fill in export state for driver - !--------------------------------------------------------------------------- - - if (other_cplgrid) then - call ice_export (i2x_iloc%rattr) !Send initial state to driver - call ice_setdef_mct ( i2x_i ) - call mct_rearr_rearrange(i2x_iloc, i2x_i, rearr_iloc2ice) - else - call ice_export (i2x_i%rattr) !Send initial state to driver - endif - ! tcraig: iceberg_prognostic is false by default in cesm1.3 - ! not explicitly setting it here makes cice5 work in cesm1.1 - ! call seq_infodata_PutData( infodata, ice_prognostic=.true., & - ! iceberg_prognostic=.false., ice_nx = nxg, ice_ny = nyg ) - call seq_infodata_PutData( infodata, ice_prognostic=.true., & - ice_nx = nxg, ice_ny = nyg ) - call t_stopf ('cice_mct_init') - - ! Error check - if (tr_aero .and. .not. atm_aero) then - write(nu_diag,*) 'ice_import ERROR: atm_aero must be set for tr_aero' - call shr_sys_abort() - end if - - !--------------------------------------------------------------------------- - ! Reset shr logging to original values - !--------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - - call t_stopf ('cice_init_total') - - ! call ice_timer_stop(timer_total) ! time entire run - ! call shr_get_memusage(msize,mrss) - ! call shr_mpi_max(mrss, mrss0, MPI_COMM_ICE,trim(subname)//' mrss0') - ! call shr_mpi_max(msize,msize0,MPI_COMM_ICE,trim(subname)//' msize0') - ! if(my_task == 0) then - ! write(shrlogunit,105) trim(subname)//': memory_write: model date = ',start_ymd,start_tod, & - ! ' memory = ',msize0,' MB (highwater) ',mrss0,' MB (usage)' - ! endif - - 105 format( A, 2i8, A, f10.2, A, f10.2, A) - - end subroutine ice_init_mct - -!--------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ice_run_mct -! -! !INTERFACE: - subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i ) -! -! !DESCRIPTION: -! Run thermodynamic CICE -! -! !USES: - use ice_history - use ice_restart - use ice_diagnostics - use ice_restoring , only : restore_ice, ice_HaloRestore - use ice_shortwave , only : init_shortwave - -! !ARGUMENTS: - type(ESMF_Clock),intent(inout) :: EClock - type(seq_cdata), intent(inout) :: cdata_i - type(mct_aVect), intent(inout) :: x2i_i - type(mct_aVect), intent(inout) :: i2x_i - -! !LOCAL VARIABLES: - integer :: k ! index - logical :: stop_now ! .true. ==> stop at the end of this run phase - integer :: ymd ! Current date (YYYYMMDD) - integer :: tod ! Current time of day (sec) - integer :: yr_sync ! Sync current year - integer :: mon_sync ! Sync current month - integer :: day_sync ! Sync current day - integer :: tod_sync ! Sync current time of day (sec) - integer :: ymd_sync ! Current year of sync clock - integer :: curr_ymd ! Current date (YYYYMMDD) - integer :: curr_tod ! Current time of day (s) - integer :: shrlogunit,shrloglev ! old values - integer :: lbnum - integer :: n, nyrp - type(mct_gGrid) , pointer :: dom_i - type(seq_infodata_type), pointer :: infodata - type(mct_gsMap) , pointer :: gsMap_i - character(len=char_len_long) :: fname - character(len=char_len_long) :: string1, string2 - character(len=*), parameter :: SubName = "ice_run_mct" - - real(r8) :: mrss, mrss0,msize,msize0 - logical, save :: first_time = .true. - -! -! !REVISION HISTORY: -! Author: Jacob Sewall, Mariana Vertenstein -! -!EOP -!--------------------------------------------------------------------------- - - call ice_timer_start(timer_total) ! time entire run - call t_barrierf('cice_run_total_BARRIER',MPI_COMM_ICE) - call t_startf ('cice_run_total') - - !--------------------------------------------------------------------------- - ! Reset shr logging to my log file - !--------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (nu_diag) - - call seq_cdata_setptrs(cdata_i, infodata=infodata, dom=dom_i, & - gsMap=gsMap_i) - - ! Determine time of next atmospheric shortwave calculation - call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) - - if (my_task == master_task) then - write(nu_diag,*) trim(subname),' cice istep, nextsw_cday = ',istep, nextsw_cday - end if - - ! Determine orbital parameters - call seq_infodata_GetData(infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & - orb_lambm0=lambm0, orb_obliqr=obliqr) - - ! Get clock information - call seq_timemgr_EClockGetData(EClock, & - curr_ymd=curr_ymd, curr_tod=curr_tod) - - force_restart_now = seq_timemgr_RestartAlarmIsOn(EClock) - - !------------------------------------------------------------------- - ! get import state - !------------------------------------------------------------------- - - call t_barrierf('cice_run_import_BARRIER',MPI_COMM_ICE) - call t_startf ('cice_run_import') - call ice_timer_start(timer_cplrecv) - if (other_cplgrid) then - call mct_rearr_rearrange(x2i_i, x2i_iloc, rearr_ice2iloc) - call ice_import( x2i_iloc%rattr ) - else - call ice_import( x2i_i%rattr ) - endif - call ice_timer_stop(timer_cplrecv) - call t_stopf ('cice_run_import') - - !-------------------------------------------------------------------- - ! timestep update - !-------------------------------------------------------------------- - - call CICE_Run() - - !----------------------------------------------------------------- - ! send export state to driver - !----------------------------------------------------------------- - - call t_barrierf('cice_run_export_BARRIER',MPI_COMM_ICE) - call t_startf ('cice_run_export') - call ice_timer_start(timer_cplsend) - if (other_cplgrid) then - call ice_export ( i2x_iloc%rattr ) - call ice_setdef_mct ( i2x_i ) - call mct_rearr_rearrange(i2x_iloc, i2x_i, rearr_iloc2ice) - else - call ice_export ( i2x_i%rattr ) - endif - call ice_timer_stop(timer_cplsend) - call t_stopf ('cice_run_export') - - !-------------------------------------------------------------------- - ! check that internal clock is in sync with master clock - !-------------------------------------------------------------------- - - tod = sec - ymd = idate - if (.not. seq_timemgr_EClockDateInSync( EClock, ymd, tod )) then - call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, & - curr_tod=tod_sync ) - write(nu_diag,*)' cice ymd=',ymd ,' cice tod= ',tod - write(nu_diag,*)' sync ymd=',ymd_sync,' sync tod= ',tod_sync - call shr_sys_abort( SubName// & - ":: Internal sea-ice clock not in sync with Sync Clock") - end if - - ! reset shr logging to my original values - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - - !------------------------------------------------------------------- - ! stop timers and print timer info - !------------------------------------------------------------------- - ! Need to have this logic here instead of in ice_final_mct since - ! the ice_final_mct.F90 will still be called even in aqua-planet mode - ! Could put this logic in the driver - but it seems easier here - - ! Need to stop this at the end of every run phase in a coupled run. - call ice_timer_stop(timer_total) ! stop timing - - stop_now = seq_timemgr_StopAlarmIsOn( EClock ) - if (stop_now) then - call ice_timer_print_all(stats=.true.) ! print timing information - call release_all_fileunits - end if - -! if(tod == 0) then -! call shr_get_memusage(msize,mrss) -! call shr_mpi_max(mrss, mrss0, MPI_COMM_ICE,trim(subname)//' mrss0') -! call shr_mpi_max(msize,msize0,MPI_COMM_ICE,trim(subname)//' msize0') -! if(my_task == 0 ) then -! write(shrlogunit,105) trim(subname)//': memory_write: model date = ',ymd,tod, & -! ' memory = ',msize0,' MB (highwater) ',mrss0,' MB (usage)' -! endif -! endif - call t_stopf ('cice_run_total') - - 105 format( A, 2i8, A, f10.2, A, f10.2, A) - - end subroutine ice_run_mct - -!--------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ice_final_mct -! -! !INTERFACE: - subroutine ice_final_mct( EClock, cdata_i, x2i_i, i2x_i ) -! -! !DESCRIPTION: -! Finalize CICE -! -! !USES: -! -!------------------------------------------------------------------------------ -!BOP -! -! !ARGUMENTS: - - type(ESMF_Clock),intent(inout) :: EClock - type(seq_cdata), intent(inout) :: cdata_i - type(mct_aVect), intent(inout) :: x2i_i - type(mct_aVect), intent(inout) :: i2x_i -! -! !REVISION HISTORY: -! -!EOP -!--------------------------------------------------------------------------- - - - end subroutine ice_final_mct - -!=============================================================================== - - subroutine ice_SetGSMap_mct( mpicom, ID, gsMap_ice, xoff, yoff, nxgin, nygin ) - - !------------------------------------------------------------------- - ! - ! Arguments - ! - integer , intent(in) :: mpicom - integer , intent(in) :: ID - type(mct_gsMap), intent(inout) :: gsMap_ice - integer,optional, intent(in) :: xoff ! x offset - integer,optional, intent(in) :: yoff ! y offset - integer,optional, intent(in) :: nxgin ! global size - integer,optional, intent(in) :: nygin ! global size - ! - ! Local variables - ! - integer,allocatable :: gindex(:) - integer :: lat - integer :: lon - integer :: i, j, iblk, n, gi - integer :: lsize,gsize - integer :: lxoff,lyoff,nxg,nyg - integer :: ier - integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain - type(block) :: this_block ! block information for current block - !------------------------------------------------------------------- - - ! Build the CICE grid numbering for MCT - ! NOTE: Numbering scheme is: West to East and South to North - ! starting at south pole. Should be the same as what's used - ! in SCRIP - - lxoff = 1 - lyoff = 1 - if (present(xoff)) then - lxoff = xoff - endif - if (present(yoff)) then - lyoff = yoff - endif - - nxg = nx_global - nyg = ny_global - if (present(nxgin)) then - nxg = nxgin - endif - if (present(nygin)) then - nyg = nygin - endif - gsize = nxg*nyg - - ! number the local grid - - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - enddo !i - enddo !j - enddo !iblk - lsize = n - - allocate(gindex(lsize),stat=ier) - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - lon = this_block%i_glob(i) + lxoff - 1 - lat = this_block%j_glob(j) + lyoff - 1 - gi = (lat-1)*nxg + lon - gindex(n) = gi - enddo !i - enddo !j - enddo !iblk - - call mct_gsMap_init( gsMap_ice, gindex, mpicom, ID, lsize, gsize ) - - deallocate(gindex) - - end subroutine ice_SetGSMap_mct - - subroutine ice_domain_mct( lsize, gsMap_i, dom_i ) - - !------------------------------------------------------------------- - ! - ! Arguments - ! - integer , intent(in) :: lsize - type(mct_gsMap), intent(in) :: gsMap_i - type(mct_ggrid), intent(inout) :: dom_i - ! - ! Local Variables - ! - integer :: i, j, iblk, n, gi ! indices - integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain - real(dbl_kind), pointer :: work_dom(:) ! temporary - real(dbl_kind), pointer :: data(:) ! temporary - integer , pointer :: idata(:) ! temporary - type(block) :: this_block ! block information for current block - !------------------------------------------------------------------- - ! - ! Initialize mct domain type - ! lat/lon in degrees, area in radians^2, mask is 1 (ocean), 0 (non-ocean) - ! - call mct_gGrid_init(GGrid=dom_i, CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize ) - call mct_aVect_zero(dom_i%data) - ! - allocate(data(lsize)) - ! - ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT - ! - call mct_gsMap_orderedPoints(gsMap_i, my_task, idata) - call mct_gGrid_importIAttr(dom_i,'GlobGridNum',idata,lsize) - ! - ! Determine domain (numbering scheme is: West to East and South to North to South pole) - ! Initialize attribute vector with special value - ! - data(:) = -9999.0_R8 - call mct_gGrid_importRAttr(dom_i,"lat" ,data,lsize) - call mct_gGrid_importRAttr(dom_i,"lon" ,data,lsize) - call mct_gGrid_importRAttr(dom_i,"area" ,data,lsize) - call mct_gGrid_importRAttr(dom_i,"aream",data,lsize) - data(:) = 0.0_R8 - call mct_gGrid_importRAttr(dom_i,"mask",data,lsize) - call mct_gGrid_importRAttr(dom_i,"frac",data,lsize) - ! - ! Fill in correct values for domain components - ! - allocate(work_dom(lsize)) - work_dom(:) = 0.0_dbl_kind - - data(:) = -9999.0_R8 - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - data(n) = TLON(i,j,iblk)*rad_to_deg - enddo !i - enddo !j - enddo !iblk - call mct_gGrid_importRattr(dom_i,"lon",data,lsize) - - data(:) = -9999.0_R8 - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - data(n) = TLAT(i,j,iblk)*rad_to_deg - enddo !i - enddo !j - enddo !iblk - call mct_gGrid_importRattr(dom_i,"lat",data,lsize) - - data(:) = -9999.0_R8 - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - data(n) = tarea(i,j,iblk)/(radius*radius) - enddo !i - enddo !j - enddo !iblk - call mct_gGrid_importRattr(dom_i,"area",data,lsize) - - data(:) = 0.0_R8 - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - data(n) = real(nint(hm(i,j,iblk)),kind=dbl_kind) - enddo !i - enddo !j - enddo !iblk - call mct_gGrid_importRattr(dom_i,"mask",data,lsize) - - data(:) = 0.0_R8 - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - if (trim(grid_type) == 'latlon') then - data(n) = ocn_gridcell_frac(i,j,iblk) - else - data(n) = real(nint(hm(i,j,iblk)),kind=dbl_kind) - end if - enddo !i - enddo !j - enddo !iblk - call mct_gGrid_importRattr(dom_i,"frac",data,lsize) - - deallocate(data) - deallocate(idata) - deallocate(work_dom) - - end subroutine ice_domain_mct - - !======================================================================= - - subroutine ice_setdef_mct( i2x_i ) - - !----------------------------------------------------- - type(mct_aVect) , intent(inout) :: i2x_i - - !----------------------------------------------------- - - call mct_aVect_zero(i2x_i) - - ! tcraig : this is where observations could be read in - - end subroutine ice_setdef_mct - - !======================================================================= - - subroutine ice_coffset_mct(xoff,yoff,gsmap_a,dom_a,gsmap_b,dom_b,mpicom_i) - - integer , intent(out) :: xoff - integer , intent(out) :: yoff - type(mct_gsmap), intent(in) :: gsmap_a - type(mct_ggrid), intent(in) :: dom_a - type(mct_gsmap), intent(in) :: gsmap_b - type(mct_ggrid), intent(in) :: dom_b - integer , intent(in) :: mpicom_i - - type(mct_aVect) :: ava - type(mct_aVect) :: avag - integer :: k1,k2,k - integer :: npt - integer :: noff,noffg - real(dbl_kind) :: x1,y1,x2,y2 - real(dbl_kind) :: dist,distmin,distming - integer :: lsizea,lsizeb - integer :: iam,ierr - integer, pointer :: ipoints(:) - character(len=*),parameter :: subname = "ice_coffset_mct" - - call mpi_comm_rank(mpicom_i,iam,ierr) - - lsizea = mct_aVect_lsize(dom_a%data) - lsizeb = mct_aVect_lsize(dom_b%data) - - !--- compute lon/lat at dom_a (local) point (1,1) - - call mct_aVect_init(ava,rList='lon:lat',lsize=lsizea) - call mct_aVect_copy(dom_a%data,ava,'lon:lat') - call mct_aVect_gather(ava,avag,gsmap_a,0,mpicom_i) - - if (iam == 0) then - k1 = mct_aVect_indexRA(avag,'lon',dieWith=subname//'_avag') - k2 = mct_aVect_indexRA(avag,'lat',dieWith=subname//'_avag') - npt = 1 ! actual corner points screwed up by U average/wraparound - npt = nx_global + 2 ! use global point (2,2) - x1 = mod(avag%rAttr(k1,npt)+360.0_r8,360.0_r8) - y1 = avag%rAttr(k2,npt) - endif - - call mct_aVect_clean(avag) - call mct_aVect_clean(ava) - - call shr_mpi_bcast(x1,mpicom_i) - call shr_mpi_bcast(y1,mpicom_i) - - !--- find x1,y1 point in dom_b (extended grid) - - noff = -1 - noffg = -1 - - call mct_gsMap_orderedPoints(gsMap_b, iam, ipoints) - if (size(ipoints) /= lsizeb) then - write(nu_diag,*) subname,' size ipoints = ',size(ipoints),lsizeb - call shr_sys_abort(subname//' :: error size of ipoints') - endif - - k1 = mct_aVect_indexRA(dom_b%data,'lon',dieWith=subname//'_domb') - k2 = mct_aVect_indexRA(dom_b%data,'lat',dieWith=subname//'_domb') - distmin = 1.0e36 - do k = 1,lsizeb - x2 = mod(dom_b%data%rAttr(k1,k)+360.0_r8,360.0_r8) - y2 = dom_b%data%rAttr(k2,k) - dist = abs((x1-x2)*(x1-x2))+abs((y1-y2)*(y1-y2)) - if (dist < distmin) then - distmin = dist - noff = ipoints(k) - endif - dist = abs((x1-x2-360.0_r8)*(x1-x2-360.0_r8))+abs((y1-y2)*(y1-y2)) - if (dist < distmin) then - distmin = dist - noff = ipoints(k) - endif - dist = abs((x1-x2+360.0_r8)*(x1-x2+360.0_r8))+abs((y1-y2)*(y1-y2)) - if (dist < distmin) then - distmin = dist - noff = ipoints(k) - endif - enddo - - deallocate(ipoints) - - call shr_mpi_min(distmin,distming,mpicom_i,'distmin',all=.true.) - - if (distming /= distmin) then - noff = -1 - endif - - call shr_mpi_max(noff,noffg,mpicom_i,'noffg',all=.true.) - - ! subtract extra -1 and -nxcpl for point (2,2) - xoff = mod(noffg-1-1,nxcpl) + 1 - yoff = (noffg-1-nxcpl)/nxcpl + 1 - - if (iam == 0) then - write(nu_diag,*) subname,' :: x1,y1 = ',x1,y1 - write(nu_diag,*) subname,' :: offset = ',noffg,xoff,yoff - call shr_sys_flush(nu_diag) - endif - - if (noffg < 1) then - call shr_sys_abort(subname//' :: noffg lt 1') - endif - - end subroutine ice_coffset_mct - - !======================================================================= - - subroutine ice_setcoupling_mct(mpicom_i, ICEID, gsmap_i, dom_i) - - include 'netcdf.inc' - - integer , intent(in) :: mpicom_i - integer , intent(in) :: ICEID - type(mct_gsmap), intent(inout) :: gsmap_i - type(mct_ggrid), intent(inout) :: dom_i - - integer :: n ! counter - integer :: iam ! pe rank - integer :: npes ! number of pes - integer :: ierr ! error code - integer :: rcode ! error code - integer :: nx,ny ! grid size - integer :: gsize ! global size - integer :: lsize ! local size - integer, pointer :: start(:),length(:),pe_loc(:) - integer, pointer :: idata(:) - real(dbl_kind),pointer :: data(:) - type(mct_avect) :: avg, av1 - integer :: fid,did,vid - character(len=8) :: avfld,dofld - character(len=*), parameter :: SubName = "ice_setcoupling_mct" - - call MPI_comm_rank(mpicom_i,iam,ierr) - call MPI_comm_size(mpicom_i,npes,ierr) - - allocate(start(npes),length(npes),pe_loc(npes)) - - if (iam == 0) then - rcode = nf_open(gridcpl_file(1:len_trim(gridcpl_file)),NF_NOWRITE,fid) - rcode = nf_inq_dimid (fid, 'ni', did) - rcode = nf_inq_dimlen(fid, did, nx) - rcode = nf_inq_dimid (fid, 'nj', did) - rcode = nf_inq_dimlen(fid, did, ny) - gsize = nx*ny - nxcpl = nx - nycpl = ny - - length = gsize / npes - do n = 1,npes - if (n <= mod(gsize,npes)) length(n) = length(n) + 1 - enddo - - start(1) = 1 - pe_loc(1) = 0 - do n = 2,npes - pe_loc(n) = n-1 - start(n) = start(n-1) + length(n-1) - enddo - if ((start(npes) + length(npes) - 1) /= gsize) then - write(nu_diag,*) & - subname,' gsize, start, length = ',gsize,start(npes),length(npes) - call shr_sys_flush(nu_diag) - call shr_sys_abort( SubName//":: decomp inconsistent") - endif - - write(nu_diag,*) subname,' read ',trim(gridcpl_file) - write(nu_diag,*) subname,' size ',nx,ny,gsize - endif - - call shr_mpi_bcast(nxcpl,mpicom_i) - call shr_mpi_bcast(nycpl,mpicom_i) - call shr_mpi_bcast(gsize,mpicom_i) - call mct_gsmap_init(gsmap_i,npes,start,length,pe_loc,0,mpicom_i,ICEID,gsize) - deallocate(start,length,pe_loc) - - lsize = mct_gsmap_lsize(gsmap_i,mpicom_i) - call mct_gGrid_init(GGrid=dom_i, CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize ) - call mct_aVect_zero(dom_i%data) - - ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT - - call mct_gsMap_orderedPoints(gsMap_i, my_task, idata) - call mct_gGrid_importIAttr(dom_i,'GlobGridNum',idata,lsize) - deallocate(idata) - - ! Initialize attribute vector with special value - - allocate(data(lsize)) - data(:) = -9999.0_R8 - call mct_gGrid_importRAttr(dom_i,"lat" ,data,lsize) - call mct_gGrid_importRAttr(dom_i,"lon" ,data,lsize) - call mct_gGrid_importRAttr(dom_i,"area" ,data,lsize) - call mct_gGrid_importRAttr(dom_i,"aream",data,lsize) - data(:) = 0.0_R8 - call mct_gGrid_importRAttr(dom_i,"mask",data,lsize) - call mct_gGrid_importRAttr(dom_i,"frac",data,lsize) - deallocate(data) - - ! Read domain arrays - - if (iam == 0) then - call mct_avect_init(avg,rList='fld',lsize=gsize) - endif - - do n = 1,5 - - if (n == 1) avfld = 'lat' - if (n == 1) dofld = 'yc' - if (n == 2) avfld = 'lon' - if (n == 2) dofld = 'xc' - if (n == 3) avfld = 'area' - if (n == 3) dofld = 'area' - if (n == 4) avfld = 'frac' - if (n == 4) dofld = 'frac' - if (n == 5) avfld = 'mask' - if (n == 5) dofld = 'mask' - if (iam == 0) then - rcode = nf_inq_varid(fid,trim(dofld),vid) - if (n == 5) then - allocate(idata(gsize)) - rcode = nf_get_var_int(fid,vid,idata) - avg%rAttr(1,:) = idata - deallocate(idata) - else - rcode = nf_get_var_double(fid,vid,avg%rAttr(1,:)) - endif - endif - - call mct_aVect_scatter(avg,av1,gsmap_i,0,mpicom_i) - call mct_aVect_copy(av1,dom_i%data,'fld',avfld) - - if (iam == 0) then - call mct_avect_clean(av1) - endif - - enddo - - if (iam == 0) then - call mct_avect_clean(avg) - endif - - end subroutine ice_setcoupling_mct -!======================================================================= - -end module ice_comp_mct diff --git a/cicecore/drivers/mct/cesm2/ice_constants.F90 b/cicecore/drivers/mct/cesm2/ice_constants.F90 deleted file mode 100644 index 06584c537..000000000 --- a/cicecore/drivers/mct/cesm2/ice_constants.F90 +++ /dev/null @@ -1,234 +0,0 @@ -!======================================================================= -!BOP -! -! !MODULE: ice_constants - sets physical constants -! -! !DESCRIPTION: -! -! This module defines a variety of physical and numerical constants -! used throughout the ice model \\ -! -! Code originally based on constants.F in POP -! -! !REVISION HISTORY: -! SVN:$Id: ice_constants.F90 37 2006-11-29 18:06:44Z eclare $ -! -! author Elizabeth C. Hunke, LANL -! -! !INTERFACE: - - module ice_constants -! -! !USES: -! - use shr_const_mod - use ice_kinds_mod -! -!EOP -! - implicit none - save - - public - - !----------------------------------------------------------------- - ! physical constants - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter :: & - rhos = 330.0_dbl_kind ,&! density of snow (kg/m^3) - rhoi = SHR_CONST_RHOICE ,&! density of ice (kg/m^3) - rhow = SHR_CONST_RHOSW ,&! density of seawater (kg/m^3) - cp_air = SHR_CONST_CPDAIR ,&! specific heat of air (J/kg/K) - ! (Briegleb JGR 97 11475-11485 July 1992) - emissivity = 0.95_dbl_kind ,&! emissivity of snow and ice - cp_ice = SHR_CONST_CPICE ,&! specific heat of fresh ice (J/kg/K) - cp_ocn = SHR_CONST_CPSW ,&! specific heat of ocn (J/kg/K) - depressT = 0.054_dbl_kind ,&! Tf:brine salinity ratio (C/ppt) - dragio = 0.00536_dbl_kind ,&! ice-ocn drag coefficient - albocn = 0.06_dbl_kind ! ocean albedo - - real (kind=dbl_kind), parameter :: & - gravit = SHR_CONST_G ,&! gravitational acceleration (m/s^2) - omega = SHR_CONST_OMEGA ,&! angular velocity of earth (rad/sec) - radius = SHR_CONST_REARTH ! earth radius (m) - - real (kind=dbl_kind), parameter :: & - secday = SHR_CONST_CDAY ,&! seconds in calendar day - viscosity_dyn = 1.79e-3_dbl_kind,&! dynamic viscosity of brine (kg/m/s) - Tocnfrz= -34.0_dbl_kind*depressT,&! freezing temp of seawater (C), - ! used as Tsfcn for open water - rhofresh = SHR_CONST_RHOFW ,&! density of fresh water (kg/m^3) - zvir = SHR_CONST_ZVIR ,&! rh2o/rair - 1.0 - vonkar = SHR_CONST_KARMAN,&! von Karman constant - cp_wv = SHR_CONST_CPWV ,&! specific heat of water vapor (J/kg/K) - stefan_boltzmann = SHR_CONST_STEBOL,&! W/m^2/K^4 - Tffresh = SHR_CONST_TKFRZ ,&! freezing temp of fresh ice (K) - Lsub = SHR_CONST_LATSUB,&! latent heat, sublimation freshwater (J/kg) - Lvap = SHR_CONST_LATVAP,&! latent heat, vaporization freshwater (J/kg) - Lfresh = SHR_CONST_LATICE,&! latent heat of melting of fresh ice (J/kg) - Timelt = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ,&! melting temp. ice top surface (C) - Tsmelt = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ,&! melting temp. snow top surface (C) - ice_ref_salinity = SHR_CONST_ICE_REF_SAL ,&! (psu) -! ocn_ref_salinity = SHR_CONST_OCN_REF_SAL ,&! (psu) -! rho_air = SHR_CONST_RHODAIR,&! ambient air density (kg/m^3) - spval_dbl = SHR_CONST_SPVAL ! special value - - real (kind=real_kind), parameter :: & - spval = 1.0e30_real_kind ! special value for netCDF output - - real (kind=dbl_kind), parameter :: & - iceruf = 0.0005_dbl_kind ,&! default ice surface roughness (m) - - ! (Ebert, Schramm and Curry JGR 100 15965-15975 Aug 1995) - kappav = 1.4_dbl_kind ,&! vis extnctn coef in ice, wvlngth<700nm (1/m) - !kappan = 17.6_dbl_kind,&! vis extnctn coef in ice, wvlngth<700nm (1/m) - - kice = 2.03_dbl_kind ,&! thermal conductivity of fresh ice(W/m/deg) - kseaice= 2.00_dbl_kind ,&! thermal conductivity of sea ice (W/m/deg) - ! (used in zero layer thermodynamics option) - ksno = 0.30_dbl_kind ,&! thermal conductivity of snow (W/m/deg) - zref = 10._dbl_kind ,&! reference height for stability (m) -! hs0 = 0.03_dbl_kind, &! parameter for delta-Eddington snow frac -! hsmin = 0.0001_dbl_kind, &! minimum snow thickness for dEdd - hs_min = 1.e-4_dbl_kind ,&! min snow thickness for computing zTsn (m) - snowpatch = 0.005_dbl_kind ! parameter for fractional snow area (m) -!tcx note cice snowpatch = 0.02 - - ! weights for albedos - ! 4 Jan 2007 BPB Following are appropriate for complete cloud - ! in a summer polar atmosphere with 1.5m bare sea ice surface: - ! .636/.364 vis/nir with only 0.5% direct for each band. - real (kind=dbl_kind), parameter :: & ! currently used only - awtvdr = 0.00318_dbl_kind, &! visible, direct ! for history and - awtidr = 0.00182_dbl_kind, &! near IR, direct ! diagnostics - awtvdf = 0.63282_dbl_kind, &! visible, diffuse - awtidf = 0.36218_dbl_kind ! near IR, diffuse - - real (kind=dbl_kind), parameter :: & - qqqice = 11637800._dbl_kind ,&! for qsat over ice - TTTice = 5897.8_dbl_kind ,&! for qsat over ice - qqqocn = 627572.4_dbl_kind ,&! for qsat over ocn - TTTocn = 5107.4_dbl_kind ! for qsat over ocn - - ! these are currently set so as to have no effect on the decomposition - real (kind=dbl_kind), parameter :: & - shlat = 30.0_dbl_kind ,&! artificial masking edge (deg) - nhlat = -30.0_dbl_kind ! artificial masking edge (deg) - - !----------------------------------------------------------------- - ! numbers - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter :: & - c0 = 0.0_dbl_kind, & - c1 = 1.0_dbl_kind, & - c1p5 = 1.5_dbl_kind, & - c2 = 2.0_dbl_kind, & - c3 = 3.0_dbl_kind, & - c4 = 4.0_dbl_kind, & - c5 = 5.0_dbl_kind, & - c6 = 6.0_dbl_kind, & - c7 = 7.0_dbl_kind, & - c8 = 8.0_dbl_kind, & - c9 = 9.0_dbl_kind, & - c10 = 10.0_dbl_kind, & - c12 = 12.0_dbl_kind, & - c15 = 15.0_dbl_kind, & - c16 = 16.0_dbl_kind, & - c20 = 20.0_dbl_kind, & - c25 = 25.0_dbl_kind, & - c30 = 30.0_dbl_kind, & - c90 = 90.0_dbl_kind, & - c100 = 100.0_dbl_kind, & - c180 = 180.0_dbl_kind, & - c360 = 360.0_dbl_kind, & - c365 = 365.0_dbl_kind, & - c400 = 400.0_dbl_kind, & - c3600= 3600.0_dbl_kind, & - c1000= 1000.0_dbl_kind, & - p001 = 0.001_dbl_kind, & - p01 = 0.01_dbl_kind, & - p025 = 0.025_dbl_kind, & - p1 = 0.1_dbl_kind, & - p2 = 0.2_dbl_kind, & - p4 = 0.4_dbl_kind, & - p5 = 0.5_dbl_kind, & - p6 = 0.6_dbl_kind, & - p05 = 0.05_dbl_kind, & - p15 = 0.15_dbl_kind, & - p25 = 0.25_dbl_kind, & - p75 = 0.75_dbl_kind, & - p166 = c1/c6, & - p333 = c1/c3, & - p666 = c2/c3, & - p111 = c1/c9, & - p055 = p111*p5, & - p027 = p055*p5, & - p222 = c2/c9, & - eps04 = 1.0e-4_dbl_kind, & - eps11 = 1.0e-11_dbl_kind, & - eps12 = 1.0e-12_dbl_kind, & - eps13 = 1.0e-13_dbl_kind, & - eps15 = 1.0e-15_dbl_kind, & - eps16 = 1.0e-16_dbl_kind, & - puny = eps11, & - bignum = 1.0e+30_dbl_kind, & - pi = SHR_CONST_PI ,&! pi - pih = p5*pi, & - piq = p5*pih, & - pi2 = c2*pi - - !----------------------------------------------------------------- - ! location of fields for staggered grids - !----------------------------------------------------------------- - - integer (int_kind), parameter :: & - field_loc_unknown = 0, & - field_loc_noupdate = -1, & - field_loc_center = 1, & - field_loc_NEcorner = 2, & - field_loc_Nface = 3, & - field_loc_Eface = 4, & - field_loc_Wface = 5 - - - !----------------------------------------------------------------- - ! field type attribute - necessary for handling - ! changes of direction across tripole boundary - !----------------------------------------------------------------- - - integer (int_kind), parameter :: & - field_type_unknown = 0, & - field_type_noupdate = -1, & - field_type_scalar = 1, & - field_type_vector = 2, & - field_type_angle = 3 - - !----------------------------------------------------------------- - ! conversion factors - !----------------------------------------------------------------- - - real (kind=dbl_kind), parameter :: & - cm_to_m = 0.01_dbl_kind ,&! cm to meters - m_to_cm = 100._dbl_kind ,&! meters to cm - m2_to_km2 = 1.e-6_dbl_kind ,&! m^2 to km^2 - kg_to_g = 1000._dbl_kind ,&! kilograms to grams - mps_to_cmpdy = 8.64e6_dbl_kind ,&! m per s to cm per day - rad_to_deg = 180._dbl_kind/pi ! degree-radian conversion - -#ifndef USE_ESMF - integer (kind=int_kind), parameter :: & - ESMF_SUCCESS = 0 ! otherwise ESMF defines this parameter -#endif - - ! useful for debugging - integer (kind=int_kind), parameter :: & - mtest = -999, itest = 1, jtest = 1, ntest = 1, btest = 1 -! mtest = 2, itest = 50, jtest = 53, ntest = 1, btest = 1 - -!======================================================================= - - end module ice_constants - -!======================================================================= diff --git a/cicecore/drivers/mct/cesm2/ice_cpl_indices.F90 b/cicecore/drivers/mct/cesm2/ice_cpl_indices.F90 deleted file mode 100644 index 08a86cc42..000000000 --- a/cicecore/drivers/mct/cesm2/ice_cpl_indices.F90 +++ /dev/null @@ -1,256 +0,0 @@ -module ice_cpl_indices - - use seq_flds_mod - use mct_mod - use ice_domain_size, only: ncat - use ice_flux, only: send_i2x_per_cat - - implicit none - - SAVE - public ! By default make data private - - ! ice -> drv - - integer :: index_i2x_Si_ifrac ! fractional ice coverage wrt ocean - integer :: index_i2x_Si_snowh ! snow height (m) - integer :: index_i2x_Si_t ! temperature - integer :: index_i2x_Si_tref ! 2m reference temperature - integer :: index_i2x_Si_qref ! 2m reference specific humidity - integer :: index_i2x_Si_logz0 ! surface roughness length (m) - integer :: index_i2x_Si_avsdr ! albedo: visible, direct - integer :: index_i2x_Si_avsdf ! albedo: near ir, direct - integer :: index_i2x_Si_anidr ! albedo: visible, diffuse - integer :: index_i2x_Si_anidf ! albedo: near ir, diffuse - integer :: index_i2x_Si_u10 ! 10m wind - integer :: index_i2x_Faii_lwup ! upward longwave heat flux - integer :: index_i2x_Faii_lat ! latent heat flux - integer :: index_i2x_Faii_sen ! sensible heat flux - integer :: index_i2x_Faii_evap ! evaporation water flux - integer :: index_i2x_Faii_taux ! wind stress, zonal - integer :: index_i2x_Faii_tauy ! wind stress, meridional - integer :: index_i2x_Faii_swnet ! sw: net - integer :: index_i2x_Fioi_swpen ! sw: net penetrating ice - integer :: index_i2x_Fioi_melth ! heat flux from melting ice (<0) - integer :: index_i2x_Fioi_meltw ! water flux from melting ice - integer :: index_i2x_Fioi_salt ! salt flux from meting ice - integer :: index_i2x_Fioi_taux ! ice/ocn stress, zonal - integer :: index_i2x_Fioi_tauy ! ice/ocn stress, zonal - integer :: index_i2x_Fioi_bcphi ! flux: Black Carbon hydrophilic deposition - integer :: index_i2x_Fioi_bcpho ! flux: Black Carbon hydrophobic deposition - integer :: index_i2x_Fioi_flxdst ! flux: Dust - - integer :: index_i2x_Si_ifrac_n(ncat) ! fractional ice coverage wrt ocean per thickness category - integer :: index_i2x_PFioi_swpen_ifrac_n(ncat) ! sw: net penetrating ice per thickness category - - integer :: index_i2x_Si_qref_HDO ! 2m reference specific humidity - integer :: index_i2x_Si_qref_16O ! 2m reference specific humidity - integer :: index_i2x_Si_qref_18O ! 2m reference specific humidity - integer :: index_i2x_Fioi_meltw_HDO ! isotope melt water flux - integer :: index_i2x_Fioi_meltw_16O ! isotope melt water flux - integer :: index_i2x_Fioi_meltw_18O ! isotope melt water flux - integer :: index_i2x_Faii_evap_HDO ! isotope evaporation water flux - integer :: index_i2x_Faii_evap_16O ! isotope evaporation water flux - integer :: index_i2x_Faii_evap_18O ! isotope evaporation water flux - - ! drv -> ice - - integer :: index_x2i_So_t ! ocn layer temperature - integer :: index_x2i_So_s ! ocn salinity - integer :: index_x2i_So_u ! ocn u velocity - integer :: index_x2i_So_v ! ocn v velocity - integer :: index_x2i_Sa_z ! bottom atm level height - integer :: index_x2i_Sa_u ! bottom atm level zon wind - integer :: index_x2i_Sa_v ! bottom atm level mer wind - integer :: index_x2i_Sa_tbot ! bottom atm level temp - integer :: index_x2i_Sa_pbot ! bottom atm level pressure - integer :: index_x2i_Sa_ptem ! bottom atm level pot temp - integer :: index_x2i_Sa_shum ! bottom atm level spec hum - integer :: index_x2i_Sa_dens ! bottom atm level air den - integer :: index_x2i_So_dhdx ! ocn surface slope, zonal - integer :: index_x2i_So_dhdy ! ocn surface slope, meridional - integer :: index_x2i_Faxa_lwdn ! downward lw heat flux - integer :: index_x2i_Faxa_rain ! prec: liquid - integer :: index_x2i_Faxa_snow ! prec: frozen - integer :: index_x2i_Faxa_swndr ! sw: nir direct downward - integer :: index_x2i_Faxa_swvdr ! sw: vis direct downward - integer :: index_x2i_Faxa_swndf ! sw: nir diffuse downward - integer :: index_x2i_Faxa_swvdf ! sw: vis diffuse downward - integer :: index_x2i_Faxa_swnet ! sw: net - integer :: index_x2i_Fioo_q ! ocn freeze or melt heat - integer :: index_x2i_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition - integer :: index_x2i_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition - integer :: index_x2i_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition - integer :: index_x2i_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition - integer :: index_x2i_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition - integer :: index_x2i_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition - integer :: index_x2i_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition - integer :: index_x2i_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition - integer :: index_x2i_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition - integer :: index_x2i_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition - integer :: index_x2i_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition - integer :: index_x2i_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition - integer :: index_x2i_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition - integer :: index_x2i_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition - - integer :: index_x2i_So_roce_HDO ! ocn: HDO - integer :: index_x2i_So_roce_16O ! ocn: H2_16O - integer :: index_x2i_So_roce_18O ! ocn: H2_18O - integer :: index_x2i_Sa_shum_16O ! bottom atm level spec hum - integer :: index_x2i_Sa_shum_18O ! bottom atm level spec hum - integer :: index_x2i_Sa_shum_HDO ! bottom atm level spec hum - integer :: index_x2i_Faxa_rain_16O ! flux: H2_16O - integer :: index_x2i_Faxa_rain_18O ! flux: H2_18O - integer :: index_x2i_Faxa_rain_HDO ! flux: HDO - integer :: index_x2i_Faxa_snow_16O ! flux: H2_16O - integer :: index_x2i_Faxa_snow_18O ! flux: H2_18O - integer :: index_x2i_Faxa_snow_HDO ! flux: HDO - - -contains - - subroutine ice_cpl_indices_set( ) - - type(mct_aVect) :: i2x ! temporary - type(mct_aVect) :: x2i ! temporary - - integer :: n ! thickness category index - character(len=2) :: cn ! character version of n - - ! Determine attribute vector indices - - ! create temporary attribute vectors - call mct_aVect_init(x2i, rList=seq_flds_x2i_fields, lsize=1) - call mct_aVect_init(i2x, rList=seq_flds_i2x_fields, lsize=1) - - index_i2x_Si_t = mct_avect_indexra(i2x,'Si_t') - index_i2x_Si_tref = mct_avect_indexra(i2x,'Si_tref') - index_i2x_Si_qref = mct_avect_indexra(i2x,'Si_qref') - index_i2x_Si_logz0 = mct_avect_indexra(i2x,'Si_logz0',perrWith='quiet') ! optional - index_i2x_Si_ifrac = mct_avect_indexra(i2x,'Si_ifrac') - index_i2x_Si_avsdr = mct_avect_indexra(i2x,'Si_avsdr') - index_i2x_Si_anidr = mct_avect_indexra(i2x,'Si_anidr') - index_i2x_Si_avsdf = mct_avect_indexra(i2x,'Si_avsdf') - index_i2x_Si_anidf = mct_avect_indexra(i2x,'Si_anidf') - index_i2x_Si_snowh = mct_avect_indexra(i2x,'Si_snowh') - index_i2x_Si_u10 = mct_avect_indexra(i2x,'Si_u10') - index_i2x_Faii_taux = mct_avect_indexra(i2x,'Faii_taux') - index_i2x_Faii_tauy = mct_avect_indexra(i2x,'Faii_tauy') - index_i2x_Faii_lat = mct_avect_indexra(i2x,'Faii_lat') - index_i2x_Faii_sen = mct_avect_indexra(i2x,'Faii_sen') - index_i2x_Faii_lwup = mct_avect_indexra(i2x,'Faii_lwup') - index_i2x_Faii_evap = mct_avect_indexra(i2x,'Faii_evap') - index_i2x_Faii_swnet = mct_avect_indexra(i2x,'Faii_swnet') - index_i2x_Fioi_swpen = mct_avect_indexra(i2x,'Fioi_swpen') - index_i2x_Fioi_melth = mct_avect_indexra(i2x,'Fioi_melth') - index_i2x_Fioi_meltw = mct_avect_indexra(i2x,'Fioi_meltw') - index_i2x_Fioi_salt = mct_avect_indexra(i2x,'Fioi_salt') - index_i2x_Fioi_taux = mct_avect_indexra(i2x,'Fioi_taux') - index_i2x_Fioi_tauy = mct_avect_indexra(i2x,'Fioi_tauy') - index_i2x_Fioi_bcphi = mct_avect_indexra(i2x,'Fioi_bcphi',perrWith='quiet') - index_i2x_Fioi_bcpho = mct_avect_indexra(i2x,'Fioi_bcpho',perrWith='quiet') - index_i2x_Fioi_flxdst = mct_avect_indexra(i2x,'Fioi_flxdst',perrWith='quiet') - -! Needed for ISOTOPES. - - index_i2x_Fioi_meltw_HDO = 0 - index_i2x_Fioi_meltw_16O = 0 - index_i2x_Fioi_meltw_18O = 0 - index_i2x_Faii_evap_HDO = 0 - index_i2x_Faii_evap_16O = 0 - index_i2x_Faii_evap_18O = 0 - index_i2x_Si_qref_HDO = 0 - index_i2x_Si_qref_16O = 0 - index_i2x_Si_qref_18O = 0 -! index_i2x_Fioi_meltw_HDO = mct_avect_indexra(i2x,'Fioi_meltw_HDO') -! index_i2x_Fioi_meltw_16O = mct_avect_indexra(i2x,'Fioi_meltw_16O') -! index_i2x_Fioi_meltw_18O = mct_avect_indexra(i2x,'Fioi_meltw_18O') -! index_i2x_Faii_evap_HDO = mct_avect_indexra(i2x,'Faii_evap_HDO') -! index_i2x_Faii_evap_16O = mct_avect_indexra(i2x,'Faii_evap_16O') -! index_i2x_Faii_evap_18O = mct_avect_indexra(i2x,'Faii_evap_18O') -! index_i2x_Si_qref_HDO = mct_avect_indexra(i2x,'Si_qref_HDO') -! index_i2x_Si_qref_16O = mct_avect_indexra(i2x,'Si_qref_16O') -! index_i2x_Si_qref_18O = mct_avect_indexra(i2x,'Si_qref_18O') - - ! optional per thickness category fields - - send_i2x_per_cat = seq_flds_i2o_per_cat - - if (send_i2x_per_cat) then - do n = 1, ncat - write(cn,'(i2.2)') n - index_i2x_Si_ifrac_n(n) = mct_avect_indexra(i2x,'Si_ifrac_'//cn) - index_i2x_PFioi_swpen_ifrac_n(n) = mct_avect_indexra(i2x,'PFioi_swpen_ifrac_'//cn) - end do - end if - - index_x2i_So_t = mct_avect_indexra(x2i,'So_t') - index_x2i_So_s = mct_avect_indexra(x2i,'So_s') - index_x2i_So_u = mct_avect_indexra(x2i,'So_u') - index_x2i_So_v = mct_avect_indexra(x2i,'So_v') - index_x2i_Sa_z = mct_avect_indexra(x2i,'Sa_z') - index_x2i_Sa_u = mct_avect_indexra(x2i,'Sa_u') - index_x2i_Sa_v = mct_avect_indexra(x2i,'Sa_v') - index_x2i_Sa_tbot = mct_avect_indexra(x2i,'Sa_tbot') - index_x2i_Sa_ptem = mct_avect_indexra(x2i,'Sa_ptem') - index_x2i_Sa_pbot = mct_avect_indexra(x2i,'Sa_pbot') - index_x2i_Sa_shum = mct_avect_indexra(x2i,'Sa_shum') - index_x2i_Sa_dens = mct_avect_indexra(x2i,'Sa_dens') - index_x2i_So_dhdx = mct_avect_indexra(x2i,'So_dhdx') - index_x2i_So_dhdy = mct_avect_indexra(x2i,'So_dhdy') - index_x2i_Faxa_lwdn = mct_avect_indexra(x2i,'Faxa_lwdn') - index_x2i_Faxa_rain = mct_avect_indexra(x2i,'Faxa_rain') - index_x2i_Faxa_snow = mct_avect_indexra(x2i,'Faxa_snow') - index_x2i_Faxa_swndr = mct_avect_indexra(x2i,'Faxa_swndr') - index_x2i_Faxa_swvdr = mct_avect_indexra(x2i,'Faxa_swvdr') - index_x2i_Faxa_swndf = mct_avect_indexra(x2i,'Faxa_swndf') - index_x2i_Faxa_swvdf = mct_avect_indexra(x2i,'Faxa_swvdf') - index_x2i_Fioo_q = mct_avect_indexra(x2i,'Fioo_q') - index_x2i_Faxa_bcphidry = mct_avect_indexra(x2i,'Faxa_bcphidry') - index_x2i_Faxa_bcphodry = mct_avect_indexra(x2i,'Faxa_bcphodry') - index_x2i_Faxa_bcphiwet = mct_avect_indexra(x2i,'Faxa_bcphiwet') - index_x2i_Faxa_ocphidry = mct_avect_indexra(x2i,'Faxa_ocphidry') - index_x2i_Faxa_ocphodry = mct_avect_indexra(x2i,'Faxa_ocphodry') - index_x2i_Faxa_ocphiwet = mct_avect_indexra(x2i,'Faxa_ocphiwet') - index_x2i_Faxa_dstdry1 = mct_avect_indexra(x2i,'Faxa_dstdry1') - index_x2i_Faxa_dstdry2 = mct_avect_indexra(x2i,'Faxa_dstdry2') - index_x2i_Faxa_dstdry3 = mct_avect_indexra(x2i,'Faxa_dstdry3') - index_x2i_Faxa_dstdry4 = mct_avect_indexra(x2i,'Faxa_dstdry4') - index_x2i_Faxa_dstwet1 = mct_avect_indexra(x2i,'Faxa_dstwet1') - index_x2i_Faxa_dstwet2 = mct_avect_indexra(x2i,'Faxa_dstwet2') - index_x2i_Faxa_dstwet3 = mct_avect_indexra(x2i,'Faxa_dstwet3') - index_x2i_Faxa_dstwet4 = mct_avect_indexra(x2i,'Faxa_dstwet4') - -! Needed for ISOTOPES. - - index_x2i_Sa_shum_16O = 0 - index_x2i_Sa_shum_18O = 0 - index_x2i_Sa_shum_HDO = 0 - index_x2i_Faxa_rain_16O = 0 - index_x2i_Faxa_rain_18O = 0 - index_x2i_Faxa_rain_HDO = 0 - index_x2i_Faxa_snow_16O = 0 - index_x2i_Faxa_snow_18O = 0 - index_x2i_Faxa_snow_HDO = 0 - index_x2i_So_roce_16O = 0 - index_x2i_So_roce_18O = 0 - index_x2i_So_roce_HDO = 0 -! index_x2i_Sa_shum_16O = mct_avect_indexra(x2i,'Sa_shum_16O') -! index_x2i_Sa_shum_18O = mct_avect_indexra(x2i,'Sa_shum_18O') -! index_x2i_Sa_shum_HDO = mct_avect_indexra(x2i,'Sa_shum_HDO') -! index_x2i_Faxa_rain_16O = mct_avect_indexra(x2i,'Faxa_rain_16O') -! index_x2i_Faxa_rain_18O = mct_avect_indexra(x2i,'Faxa_rain_18O') -! index_x2i_Faxa_rain_HDO = mct_avect_indexra(x2i,'Faxa_rain_HDO') -! index_x2i_Faxa_snow_16O = mct_avect_indexra(x2i,'Faxa_snow_16O') -! index_x2i_Faxa_snow_18O = mct_avect_indexra(x2i,'Faxa_snow_18O') -! index_x2i_Faxa_snow_HDO = mct_avect_indexra(x2i,'Faxa_snow_HDO') -! index_x2i_So_roce_16O = mct_avect_indexra(x2i,'So_roce_16O') -! index_x2i_So_roce_18O = mct_avect_indexra(x2i,'So_roce_18O') -! index_x2i_So_roce_HDO = mct_avect_indexra(x2i,'So_roce_HDO') - - call mct_aVect_clean(x2i) - call mct_aVect_clean(i2x) - - end subroutine ice_cpl_indices_set - -end module ice_cpl_indices diff --git a/cicecore/drivers/mct/cesm2/ice_import_export.F90 b/cicecore/drivers/mct/cesm2/ice_import_export.F90 deleted file mode 100644 index 056b27485..000000000 --- a/cicecore/drivers/mct/cesm2/ice_import_export.F90 +++ /dev/null @@ -1,767 +0,0 @@ -module ice_import_export - - use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl - use shr_sys_mod , only: shr_sys_abort, shr_sys_flush - use shr_frz_mod - use ice_kinds_mod , only: int_kind, dbl_kind, char_len_long, log_kind - use ice_constants , only: c0, c1, puny, tffresh, spval_dbl - use ice_constants , only: field_loc_center, field_type_scalar - use ice_constants , only: field_type_vector, c100 - use ice_constants , only: vonkar, zref, iceruf - use ice_constants , only: p001 - use ice_blocks , only: block, get_block, nx_block, ny_block - use ice_flux , only: strairxt, strairyt, strocnxt, strocnyt - use ice_flux , only: alvdr, alidr, alvdf, alidf, Tref, Qref, Uref - use ice_flux , only: flat, fsens, flwout, evap, fswabs, fhocn, fswthru - use ice_flux , only: fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa - use ice_flux , only: rhoa, swvdr, swvdf, swidr, swidf, flw, frain - use ice_flux , only: fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt - use ice_flux , only: sss, tf, wind, fsw, init_flux_atm, init_flux_ocn - use ice_flux , only: faero_atm, faero_ocn - use ice_flux , only: fiso_atm, fiso_ocn, fiso_rain, fiso_evap, & - Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn - use ice_flux , only: send_i2x_per_cat, fswthrun_ai - use ice_init , only: atm2ice_fmap_is_pos_def, atm2ice_smap_is_pos_def - use ice_ocean , only: tfrz_option - use ice_atmo , only: Cdn_atm - use ice_state , only: vice, vsno, aice, aicen_init, trcr - use ice_state , only: tr_aero, tr_iso, tr_iage, tr_FY, tr_pond, tr_lvl - use ice_domain , only: nblocks, blocks_ice, halo_info, distrb_info - use ice_domain_size , only: nx_global, ny_global, block_size_x, block_size_y, max_blocks, ncat - use ice_grid , only: tlon, tlat, tarea, tmask, anglet, hm - use ice_grid , only: grid_type, t2ugrid_vector - use ice_boundary , only: ice_HaloUpdate - use ice_fileunits , only: nu_diag - use ice_prescribed_mod - use ice_cpl_indices - use ice_communicate , only: my_task, master_task, MPI_COMM_ICE - use ice_calendar , only: idate, sec - use perf_mod , only: t_startf, t_stopf, t_barrierf - - implicit none - public - -#ifdef RASM_MODS -! (1) Andrew Roberts: Added artificial correction to snow and rain division -! This is to be consistent with VIC in the Regional Arctic System Model - logical, parameter :: rasm_snowrain_split = .true. -#else - logical, parameter :: rasm_snowrain_split = .false. -#endif - integer ,parameter :: debug = 0 ! internal debug level - character(*),parameter :: F01 = "('(ice_import_export) ',a,3(i8,2x),d21.14)" - -!============================================================================== -contains -!============================================================================== - - subroutine ice_import( x2i ) - - !----------------------------------------------------- - ! Arguments - real(r8), intent(inout) :: x2i(:,:) - ! - ! Local variables - integer :: i, j, iblk, n - integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain - type(block) :: this_block ! block information for current block - integer,parameter :: nflds=15,nfldv=6 - real (kind=dbl_kind),allocatable :: aflds(:,:,:,:) - real (kind=dbl_kind) :: workx, worky - real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP - logical (kind=log_kind) :: first_call = .true. - character(len=*),parameter :: subname = 'ice_import' - !----------------------------------------------------- - - ! Note that the precipitation fluxes received from the coupler - ! are in units of kg/s/m^2 which is what CICE requires. - ! Note also that the read in below includes only values needed - ! by the thermodynamic component of CICE. Variables uocn, vocn, - ! ss_tltx, and ss_tlty are excluded. Also, because the SOM and - ! DOM don't compute SSS. SSS is not read in and is left at - ! the initilized value (see ice_flux.F init_coupler_flux) of - ! 34 ppt - - ! Use aflds to gather the halo updates of multiple fields - ! Need to separate the scalar from the vector halo updates - - allocate(aflds(nx_block,ny_block,nflds,nblocks)) - aflds = c0 - - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - - n = n+1 - aflds(i,j, 1,iblk) = x2i(index_x2i_So_t,n) - aflds(i,j, 2,iblk) = x2i(index_x2i_So_s,n) - aflds(i,j, 3,iblk) = x2i(index_x2i_Sa_z,n) - aflds(i,j, 4,iblk) = x2i(index_x2i_Sa_ptem,n) - aflds(i,j, 5,iblk) = x2i(index_x2i_Sa_tbot,n) - aflds(i,j, 6,iblk) = x2i(index_x2i_Sa_shum,n) - aflds(i,j, 7,iblk) = x2i(index_x2i_Sa_dens,n) - aflds(i,j, 8,iblk) = x2i(index_x2i_Fioo_q,n) - aflds(i,j, 9,iblk) = x2i(index_x2i_Faxa_swvdr,n) - aflds(i,j,10,iblk) = x2i(index_x2i_Faxa_swndr,n) - aflds(i,j,11,iblk) = x2i(index_x2i_Faxa_swvdf,n) - aflds(i,j,12,iblk) = x2i(index_x2i_Faxa_swndf,n) - aflds(i,j,13,iblk) = x2i(index_x2i_Faxa_lwdn,n) - aflds(i,j,14,iblk) = x2i(index_x2i_Faxa_rain,n) - aflds(i,j,15,iblk) = x2i(index_x2i_Faxa_snow,n) - - enddo !i - enddo !j - enddo !iblk - - if (.not.prescribed_ice) then - call t_startf ('cice_imp_halo') - call ice_HaloUpdate(aflds, halo_info, field_loc_center, & - field_type_scalar) - call t_stopf ('cice_imp_halo') - endif - - if (rasm_snowrain_split) then - MIN_RAIN_TEMP = Tffresh-c1 - MAX_SNOW_TEMP = Tffresh+c0 - endif - - !$OMP PARALLEL DO PRIVATE(iblk,i,j) - do iblk = 1, nblocks - do j = 1,ny_block - do i = 1,nx_block - sst (i,j,iblk) = aflds(i,j, 1,iblk) - sss (i,j,iblk) = aflds(i,j, 2,iblk) - zlvl (i,j,iblk) = aflds(i,j, 3,iblk) - potT (i,j,iblk) = aflds(i,j, 4,iblk) - Tair (i,j,iblk) = aflds(i,j, 5,iblk) - Qa (i,j,iblk) = aflds(i,j, 6,iblk) - rhoa (i,j,iblk) = aflds(i,j, 7,iblk) - frzmlt (i,j,iblk) = aflds(i,j, 8,iblk) - swvdr(i,j,iblk) = aflds(i,j, 9,iblk) - swidr(i,j,iblk) = aflds(i,j,10,iblk) - swvdf(i,j,iblk) = aflds(i,j,11,iblk) - swidf(i,j,iblk) = aflds(i,j,12,iblk) - flw (i,j,iblk) = aflds(i,j,13,iblk) - frain(i,j,iblk) = aflds(i,j,14,iblk) - fsnow(i,j,iblk) = aflds(i,j,15,iblk) - enddo !i - enddo !j - enddo !iblk - !$OMP END PARALLEL DO - - if (.not. atm2ice_smap_is_pos_def) then - Qa = max(Qa , c0) - rhoa = max(rhoa, c0) - end if - if (.not. atm2ice_fmap_is_pos_def) then - swvdr = max(swvdr, c0) - swidr = max(swidr, c0) - swvdf = max(swvdf, c0) - swidf = max(swidf, c0) - frain = max(frain, c0) - fsnow = max(fsnow, c0) - end if - - if (rasm_snowrain_split) then - !$OMP PARALLEL DO PRIVATE(iblk,i,j) - do iblk = 1, nblocks - do j = 1,ny_block - do i = 1,nx_block - !--- Artificial correction to snow and rain for RASM - if (Tair(i,j,iblk)MAX_SNOW_TEMP) then - frain(i,j,iblk)=fsnow(i,j,iblk)+frain(i,j,iblk) - fsnow(i,j,iblk)=0 - else - frain(i,j,iblk)=fsnow(i,j,iblk)+frain(i,j,iblk) - fsnow(i,j,iblk)=frain(i,j,iblk) - frain(i,j,iblk)=frain(i,j,iblk)*(Tair(i,j,iblk)-MIN_RAIN_TEMP) / & - (MAX_SNOW_TEMP-MIN_RAIN_TEMP) - fsnow(i,j,iblk)=fsnow(i,j,iblk)-frain(i,j,iblk) - endif - !--- end artificial RASM correction - enddo !i - enddo !j - enddo !iblk - !$OMP END PARALLEL DO - endif ! rasm_snowrain_split - - - deallocate(aflds) - allocate(aflds(nx_block,ny_block,nfldv,nblocks)) - aflds = c0 - - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - aflds(i,j, 1,iblk) = x2i(index_x2i_So_u,n) - aflds(i,j, 2,iblk) = x2i(index_x2i_So_v,n) - aflds(i,j, 3,iblk) = x2i(index_x2i_Sa_u,n) - aflds(i,j, 4,iblk) = x2i(index_x2i_Sa_v,n) - aflds(i,j, 5,iblk) = x2i(index_x2i_So_dhdx,n) - aflds(i,j, 6,iblk) = x2i(index_x2i_So_dhdy,n) - enddo - enddo - enddo - - if (.not.prescribed_ice) then - call t_startf ('cice_imp_halo') - call ice_HaloUpdate(aflds, halo_info, field_loc_center, & - field_type_vector) - call t_stopf ('cice_imp_halo') - endif - - !$OMP PARALLEL DO PRIVATE(iblk,i,j) - do iblk = 1, nblocks - do j = 1,ny_block - do i = 1,nx_block - uocn (i,j,iblk) = aflds(i,j, 1,iblk) - vocn (i,j,iblk) = aflds(i,j, 2,iblk) - uatm (i,j,iblk) = aflds(i,j, 3,iblk) - vatm (i,j,iblk) = aflds(i,j, 4,iblk) - ss_tltx(i,j,iblk) = aflds(i,j, 5,iblk) - ss_tlty(i,j,iblk) = aflds(i,j, 6,iblk) - enddo !i - enddo !j - enddo !iblk - !$OMP END PARALLEL DO - - deallocate(aflds) - - !------------------------------------------------------- - ! Set aerosols from coupler - !------------------------------------------------------- - - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - - n = n+1 - faero_atm(i,j,1,iblk) = x2i(index_x2i_Faxa_bcphodry,n) - - faero_atm(i,j,2,iblk) = x2i(index_x2i_Faxa_bcphidry,n) & - + x2i(index_x2i_Faxa_bcphiwet,n) - ! Combine all of the dust into one category - faero_atm(i,j,3,iblk) = x2i(index_x2i_Faxa_dstwet1,n) & - + x2i(index_x2i_Faxa_dstdry1,n) & - + x2i(index_x2i_Faxa_dstwet2,n) & - + x2i(index_x2i_Faxa_dstdry2,n) & - + x2i(index_x2i_Faxa_dstwet3,n) & - + x2i(index_x2i_Faxa_dstdry3,n) & - + x2i(index_x2i_Faxa_dstwet4,n) & - + x2i(index_x2i_Faxa_dstdry4,n) - - if (index_x2i_Sa_shum_HDO > 0) then - - Qa_iso(i,j,1,iblk) = x2i(index_x2i_Sa_shum_HDO,n) - Qa_iso(i,j,2,iblk) = x2i(index_x2i_Sa_shum_16O,n) - Qa_iso(i,j,3,iblk) = x2i(index_x2i_Sa_shum_18O,n) - - fiso_rain(i,j,1,iblk) = x2i(index_x2i_Faxa_rain_HDO,n) - fiso_rain(i,j,2,iblk) = x2i(index_x2i_Faxa_rain_16O,n) - fiso_rain(i,j,3,iblk) = x2i(index_x2i_Faxa_rain_18O,n) - - fiso_atm(i,j,1,iblk) = x2i(index_x2i_Faxa_snow_HDO,n) - fiso_atm(i,j,2,iblk) = x2i(index_x2i_Faxa_snow_16O,n) - fiso_atm(i,j,3,iblk) = x2i(index_x2i_Faxa_snow_18O,n) - - HDO_ocn(i,j,iblk) = x2i(index_x2i_So_roce_HDO,n) - H2_16O_ocn(i,j,iblk) = x2i(index_x2i_So_roce_16O,n) - H2_18O_ocn(i,j,iblk) = x2i(index_x2i_So_roce_18O,n) - - endif - enddo !i - enddo !j - - enddo !iblk - - - !----------------------------------------------------------------- - ! rotate zonal/meridional vectors to local coordinates - ! compute data derived quantities - !----------------------------------------------------------------- - - ! Vector fields come in on T grid, but are oriented geographically - ! need to rotate to pop-grid FIRST using ANGLET - ! then interpolate to the U-cell centers (otherwise we - ! interpolate across the pole) - ! use ANGLET which is on the T grid ! - - call t_startf ('cice_imp_ocn') - !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) - do iblk = 1, nblocks - - do j = 1,ny_block - do i = 1,nx_block - - ! ocean - workx = uocn (i,j,iblk) ! currents, m/s - worky = vocn (i,j,iblk) - uocn(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid - + worky*sin(ANGLET(i,j,iblk)) - vocn(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & - - workx*sin(ANGLET(i,j,iblk)) - - workx = ss_tltx (i,j,iblk) ! sea sfc tilt, m/m - worky = ss_tlty (i,j,iblk) - ss_tltx(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid - + worky*sin(ANGLET(i,j,iblk)) - ss_tlty(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & - - workx*sin(ANGLET(i,j,iblk)) - - sst(i,j,iblk) = sst(i,j,iblk) - Tffresh ! sea sfc temp (C) - - sss(i,j,iblk)=max(sss(i,j,iblk),c0) - - enddo - enddo - -! Use shr_frz_mod for this - Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) - - enddo - !$OMP END PARALLEL DO - call t_stopf ('cice_imp_ocn') - - ! Interpolate ocean dynamics variables from T-cell centers to - ! U-cell centers. - - if (.not.prescribed_ice) then - call t_startf ('cice_imp_t2u') - call t2ugrid_vector(uocn) - call t2ugrid_vector(vocn) - call t2ugrid_vector(ss_tltx) - call t2ugrid_vector(ss_tlty) - call t_stopf ('cice_imp_t2u') - end if - - ! Atmosphere variables are needed in T cell centers in - ! subroutine stability and are interpolated to the U grid - ! later as necessary. - - call t_startf ('cice_imp_atm') - !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) - do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - - ! atmosphere - workx = uatm(i,j,iblk) ! wind velocity, m/s - worky = vatm(i,j,iblk) - uatm (i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid - + worky*sin(ANGLET(i,j,iblk)) ! note uatm, vatm, wind - vatm (i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & ! are on the T-grid here - - workx*sin(ANGLET(i,j,iblk)) - - wind (i,j,iblk) = sqrt(uatm(i,j,iblk)**2 + vatm(i,j,iblk)**2) - fsw (i,j,iblk) = swvdr(i,j,iblk) + swvdf(i,j,iblk) & - + swidr(i,j,iblk) + swidf(i,j,iblk) - enddo - enddo - enddo - !$OMP END PARALLEL DO - call t_stopf ('cice_imp_atm') - - !----------------------------------------------------------------- - ! debug output - !----------------------------------------------------------------- - - if (debug > 0 .and. my_task==master_task) then - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo; ihi = this_block%ihi - jlo = this_block%jlo; jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - write(nu_diag,F01)'import: date, sec, n, So_dhdx = ',idate,sec,n,x2i(index_x2i_So_dhdx,n) - write(nu_diag,F01)'import: date, sec, n, So_dhdxy = ',idate,sec,n,x2i(index_x2i_So_dhdy,n) - write(nu_diag,F01)'import: date, sec, n, So_t = ',idate,sec,n,x2i(index_x2i_So_t,n) - write(nu_diag,F01)'import: date, sec, n, So_s = ',idate,sec,n,x2i(index_x2i_So_s,n) - write(nu_diag,F01)'import: date, sec, n, So_u = ',idate,sec,n,x2i(index_x2i_So_u,n) - write(nu_diag,F01)'import: date, sec, n, So_v = ',idate,sec,n,x2i(index_x2i_So_v,n) - write(nu_diag,F01)'import: date, sec, n, Sa_u = ',idate,sec,n,x2i(index_x2i_Sa_u,n) - write(nu_diag,F01)'import: date, sec, n, Sa_v = ',idate,sec,n,x2i(index_x2i_Sa_v,n) - write(nu_diag,F01)'import: date, sec, n, Sa_z = ',idate,sec,n,x2i(index_x2i_Sa_z,n) - write(nu_diag,F01)'import: date, sec, n, So_ptem = ',idate,sec,n,x2i(index_x2i_Sa_ptem,n) - write(nu_diag,F01)'import: date, sec, n, So_tbot = ',idate,sec,n,x2i(index_x2i_Sa_tbot,n) - write(nu_diag,F01)'import: date, sec, n, So_shum = ',idate,sec,n,x2i(index_x2i_Sa_shum,n) - write(nu_diag,F01)'import: date, sec, n, Sa_dens = ',idate,sec,n,x2i(index_x2i_Sa_dens,n) - write(nu_diag,F01)'import: date, sec, n, Fioo_q = ',idate,sec,n,x2i(index_x2i_Fioo_q,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_swvdr = ',idate,sec,n,x2i(index_x2i_Faxa_swvdr,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_swndr = ',idate,sec,n,x2i(index_x2i_Faxa_swndr,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_swvdf = ',idate,sec,n,x2i(index_x2i_Faxa_swvdf,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_swndf = ',idate,sec,n,x2i(index_x2i_Faxa_swndf,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_lwdn = ',idate,sec,n,x2i(index_x2i_Faxa_lwdn,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_rain = ',idate,sec,n,x2i(index_x2i_Faxa_rain,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_snow = ',idate,sec,n,x2i(index_x2i_Faxa_snow,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_bcphodry = ',idate,sec,n,x2i(index_x2i_Faxa_bcphodry,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_bcphidry = ',idate,sec,n,x2i(index_x2i_Faxa_bcphidry,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_bcphiwet = ',idate,sec,n,x2i(index_x2i_Faxa_bcphiwet,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_dstwet1 = ',idate,sec,n,x2i(index_x2i_Faxa_dstwet1,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_dstdry1 = ',idate,sec,n,x2i(index_x2i_Faxa_dstdry1,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_dstwet2 = ',idate,sec,n,x2i(index_x2i_Faxa_dstwet2,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_dstdry2 = ',idate,sec,n,x2i(index_x2i_Faxa_dstdry2,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_dstwet3 = ',idate,sec,n,x2i(index_x2i_Faxa_dstwet3,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_dstdry3 = ',idate,sec,n,x2i(index_x2i_Faxa_dstdry3,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_dstwet4 = ',idate,sec,n,x2i(index_x2i_Faxa_dstwet4,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_dstdry4 = ',idate,sec,n,x2i(index_x2i_Faxa_dstdry4,n) - if (index_x2i_Sa_shum_HDO > 0) then - write(nu_diag,F01)'import: date, sec, n, Sa_shum_HDO = ',idate,sec,n,x2i(index_x2i_Sa_shum_HDO,n) - write(nu_diag,F01)'import: date, sec, n, Sa_shum_16O = ',idate,sec,n,x2i(index_x2i_Sa_shum_16O,n) - write(nu_diag,F01)'import: date, sec, n, Sa_shum_18O = ',idate,sec,n,x2i(index_x2i_Sa_shum_18O,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_rain_HDO = ',idate,sec,n,x2i(index_x2i_Faxa_rain_HDO,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_rain_16O = ',idate,sec,n,x2i(index_x2i_Faxa_rain_16O,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_rain_18O = ',idate,sec,n,x2i(index_x2i_Faxa_rain_18O,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_snow_HDO = ',idate,sec,n,x2i(index_x2i_Faxa_snow_HDO,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_snow_16O = ',idate,sec,n,x2i(index_x2i_Faxa_snow_16O,n) - write(nu_diag,F01)'import: date, sec, n, Faxa_snow_18O = ',idate,sec,n,x2i(index_x2i_Faxa_snow_18O,n) - write(nu_diag,F01)'import: date, sec, n, So_roce_HDO = ',idate,sec,n,x2i(index_x2i_So_roce_HDO,n) - write(nu_diag,F01)'import: date, sec, n, So_roce_16O = ',idate,sec,n,x2i(index_x2i_So_roce_16O,n) - write(nu_diag,F01)'import: date, sec, n, So_roce_18O = ',idate,sec,n,x2i(index_x2i_So_roce_18O,n) - end if - end do - end do - end do - end if - - end subroutine ice_import - - !=============================================================================== - - subroutine ice_export( i2x ) - - !----------------------------------------------------- - ! - ! Arguments - real(r8), intent(inout) :: i2x(:,:) - ! - ! Local Variables - integer :: i, j, iblk, n, ij - integer :: n2 ! thickness category index - integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain - integer (kind=int_kind) :: icells ! number of ocean/ice cells - integer (kind=int_kind), dimension (nx_block*ny_block) :: indxi ! compressed indices in i - integer (kind=int_kind), dimension (nx_block*ny_block) :: indxj ! compressed indices in i - - real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: & - Tsrf & ! surface temperature - , tauxa & ! atmo/ice stress - , tauya & - , tauxo & ! ice/ocean stress - , tauyo & - , ailohi ! fractional ice area - - real (kind=dbl_kind) :: & - workx, worky ! tmps for converting grid - - type(block) :: this_block ! block information for current block - logical :: flag - character(len=*),parameter :: subname = 'ice_export' - !----------------------------------------------------- - - flag=.false. - - !calculate ice thickness from aice and vice. Also - !create Tsrf from the first tracer (trcr) in ice_state.F - - ailohi(:,:,:) = c0 - Tsrf(:,:,:) = c0 - tauxa(:,:,:) = c0 - tauya(:,:,:) = c0 - tauxo(:,:,:) = c0 - tauyo(:,:,:) = c0 - - !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky, this_block, ilo, ihi, jlo, jhi) - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo,jhi - do i = ilo,ihi - - ! ice fraction - ailohi(i,j,iblk) = min(aice(i,j,iblk), c1) - - ! surface temperature - Tsrf(i,j,iblk) = Tffresh + trcr(i,j,1,iblk) !Kelvin (original ???) - - ! wind stress (on POP T-grid: convert to lat-lon) - workx = strairxT(i,j,iblk) ! N/m^2 - worky = strairyT(i,j,iblk) ! N/m^2 - tauxa(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & - - worky*sin(ANGLET(i,j,iblk)) - tauya(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & - + workx*sin(ANGLET(i,j,iblk)) - - ! ice/ocean stress (on POP T-grid: convert to lat-lon) - workx = -strocnxT(i,j,iblk) ! N/m^2 - worky = -strocnyT(i,j,iblk) ! N/m^2 - tauxo(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & - - worky*sin(ANGLET(i,j,iblk)) - tauyo(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & - + workx*sin(ANGLET(i,j,iblk)) - - enddo - enddo - enddo - !$OMP END PARALLEL DO - - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo,jhi - do i = ilo,ihi - if (tmask(i,j,iblk) .and. ailohi(i,j,iblk) < c0 ) then - flag = .true. - endif - end do - end do - end do - if (flag) then - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo,jhi - do i = ilo,ihi - if (tmask(i,j,iblk) .and. ailohi(i,j,iblk) < c0 ) then - write(nu_diag,*) & - ' (ice) send: ERROR ailohi < 0.0 ',i,j,ailohi(i,j,iblk) - call shr_sys_flush(nu_diag) - endif - end do - end do - end do - endif - - ! Fill export state i2x_i - - i2x(:,:) = spval_dbl - - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - - n = n+1 - - !--- zero out fields with tmask for proper coupler accumulation in ice free areas - - if ( tmask(i,j,iblk)) i2x(:,n) = c0 - - !-------states-------------------- - i2x(index_i2x_Si_ifrac ,n) = ailohi(i,j,iblk) - - if ( tmask(i,j,iblk) .and. ailohi(i,j,iblk) > c0 ) then - !-------states-------------------- - i2x(index_i2x_Si_t ,n) = Tsrf(i,j,iblk) - i2x(index_i2x_Si_avsdr ,n) = alvdr(i,j,iblk) - i2x(index_i2x_Si_anidr ,n) = alidr(i,j,iblk) - i2x(index_i2x_Si_avsdf ,n) = alvdf(i,j,iblk) - i2x(index_i2x_Si_anidf ,n) = alidf(i,j,iblk) - i2x(index_i2x_Si_u10 ,n) = Uref(i,j,iblk) - i2x(index_i2x_Si_tref ,n) = Tref(i,j,iblk) - i2x(index_i2x_Si_qref ,n) = Qref(i,j,iblk) - i2x(index_i2x_Si_snowh ,n) = vsno(i,j,iblk) / ailohi(i,j,iblk) - - if (index_i2x_Si_logz0 > 0) then - if (Cdn_atm(i,j,iblk) > c0) then - i2x(index_i2x_Si_logz0 ,n) = log(zref)-(vonkar/sqrt(Cdn_atm(i,j,iblk))) - else - !--- tcraig, this should not happen but if it does, continue gracefully - write(nu_diag,*) trim(subname), ' WARNING: Cdn_atm error ',Cdn_atm(i,j,iblk),i,j,iblk - i2x(index_i2x_Si_logz0 ,n) = log(iceruf) - endif - endif - - !--- a/i fluxes computed by ice - i2x(index_i2x_Faii_taux ,n) = tauxa(i,j,iblk) - i2x(index_i2x_Faii_tauy ,n) = tauya(i,j,iblk) - i2x(index_i2x_Faii_lat ,n) = flat(i,j,iblk) - i2x(index_i2x_Faii_sen ,n) = fsens(i,j,iblk) - i2x(index_i2x_Faii_lwup ,n) = flwout(i,j,iblk) - i2x(index_i2x_Faii_evap ,n) = evap(i,j,iblk) - i2x(index_i2x_Faii_swnet,n) = fswabs(i,j,iblk) - - !--- i/o fluxes computed by ice - i2x(index_i2x_Fioi_melth,n) = fhocn(i,j,iblk) - i2x(index_i2x_Fioi_swpen,n) = fswthru(i,j,iblk) ! hf from melting - i2x(index_i2x_Fioi_meltw,n) = fresh(i,j,iblk) ! h2o flux from melting ??? - i2x(index_i2x_Fioi_salt ,n) = fsalt(i,j,iblk) ! salt flux from melting ??? - i2x(index_i2x_Fioi_taux ,n) = tauxo(i,j,iblk) ! stress : i/o zonal ??? - i2x(index_i2x_Fioi_tauy ,n) = tauyo(i,j,iblk) ! stress : i/o meridional ??? - - if (index_i2x_Fioi_bcpho > 0) then - i2x(index_i2x_Fioi_bcpho ,n) = faero_ocn(i,j,1,iblk) ! hydrophobic bc - end if - if (index_i2x_Fioi_bcphi > 0) then - i2x(index_i2x_Fioi_bcphi ,n) = faero_ocn(i,j,2,iblk) ! hydrophilic bc - end if - if (index_i2x_Fioi_flxdst > 0) then - i2x(index_i2x_Fioi_flxdst,n) = faero_ocn(i,j,3,iblk) ! dust - end if - if (index_i2x_Fioi_meltw_HDO > 0) then - i2x(index_i2x_Fioi_meltw_HDO,n) = fiso_ocn (i,j,1,iblk) ! Isotopes to ocean - i2x(index_i2x_Fioi_meltw_16O,n) = fiso_ocn (i,j,2,iblk) ! Isotopes to ocean - i2x(index_i2x_Fioi_meltw_18O,n) = fiso_ocn (i,j,3,iblk) ! Isotopes to ocean - i2x(index_i2x_Faii_evap_HDO ,n) = fiso_evap(i,j,1,iblk) ! Isotope evap to atm - i2x(index_i2x_Faii_evap_16O ,n) = fiso_evap(i,j,2,iblk) ! Isotope evap to atm - i2x(index_i2x_Faii_evap_18O ,n) = fiso_evap(i,j,3,iblk) ! Isotope evap to atm - i2x(index_i2x_Si_qref_HDO ,n) = Qref_iso(i,j,1,iblk) ! Isotope qref to atm - i2x(index_i2x_Si_qref_16O ,n) = Qref_iso(i,j,2,iblk) ! Isotope qref to atm - i2x(index_i2x_Si_qref_18O ,n) = Qref_iso(i,j,3,iblk) ! Isotope qref to atm - endif - end if - enddo !i - enddo !j - enddo !iblk - - if (send_i2x_per_cat) then - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - - n = n+1 - - ! ice fraction - do n2 = 1, ncat - i2x(index_i2x_Si_ifrac_n(n2),n) = aicen_init(i,j,n2,iblk) - enddo - - if ( tmask(i,j,iblk) .and. ailohi(i,j,iblk) > c0 ) then - ! penetrative shortwave - do n2 = 1, ncat - i2x(index_i2x_PFioi_swpen_ifrac_n(n2),n) = fswthrun_ai(i,j,n2,iblk) - enddo - else - !--- zero out pass-through fields over land for benefit of x2oacc fields in cpl hist files - do n2 = 1, ncat - i2x(index_i2x_PFioi_swpen_ifrac_n(n2),n) = c0 - enddo - end if - enddo !i - enddo !j - enddo !iblk - end if ! send_i2x_per_cat - - !----------------------------------------------------------------- - ! Debug output - !----------------------------------------------------------------- - - if (debug > 0 .and. my_task==master_task) then - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo; ihi = this_block%ihi - jlo = this_block%jlo; jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - - !--- ice states - write(nu_diag,F01)'export: date, sec, n, Si_ifrac = ',idate,sec,n,i2x(index_i2x_Si_ifrac ,n) - write(nu_diag,F01)'export: date, sec, n, Si_t = ',idate,sec,n,i2x(index_i2x_Si_t ,n) - write(nu_diag,F01)'export: date, sec, n, Si_avsdr = ',idate,sec,n,i2x(index_i2x_Si_avsdr ,n) - write(nu_diag,F01)'export: date, sec, n, Si_anidr = ',idate,sec,n,i2x(index_i2x_Si_anidr ,n) - write(nu_diag,F01)'export: date, sec, n, Si_avsdf = ',idate,sec,n,i2x(index_i2x_Si_avsdf ,n) - write(nu_diag,F01)'export: date, sec, n, Si_anidf = ',idate,sec,n,i2x(index_i2x_Si_anidf ,n) - write(nu_diag,F01)'export: date, sec, n, Si_u10 = ',idate,sec,n,i2x(index_i2x_Si_u10 ,n) - write(nu_diag,F01)'export: date, sec, n, Si_tref = ',idate,sec,n,i2x(index_i2x_Si_tref ,n) - write(nu_diag,F01)'export: date, sec, n, Si_qref = ',idate,sec,n,i2x(index_i2x_Si_qref ,n) - write(nu_diag,F01)'export: date, sec, n, Si_snowh = ',idate,sec,n,i2x(index_i2x_Si_snowh ,n) - if (index_i2x_Si_logz0 > 0) then - write(nu_diag,F01)'export: date, sec, n, Si_logz0= ',idate,sec,n, i2x(index_i2x_Si_logz0 ,n) - end if - - !--- a/i fluxes computed by ice - write(nu_diag,F01)'export: date, sec, n, Faii_taux = ',idate,sec,n,i2x(index_i2x_Faii_taux ,n) - write(nu_diag,F01)'export: date, sec, n, Faii_tauy = ',idate,sec,n,i2x(index_i2x_Faii_tauy ,n) - write(nu_diag,F01)'export: date, sec, n, Faii_lat = ',idate,sec,n,i2x(index_i2x_Faii_lat ,n) - write(nu_diag,F01)'export: date, sec, n, Faii_sen = ',idate,sec,n,i2x(index_i2x_Faii_sen ,n) - write(nu_diag,F01)'export: date, sec, n, Faii_lwup = ',idate,sec,n,i2x(index_i2x_Faii_lwup ,n) - write(nu_diag,F01)'export: date, sec, n, Faii_evap = ',idate,sec,n,i2x(index_i2x_Faii_evap ,n) - write(nu_diag,F01)'export: date, sec, n, Faii_swnet = ',idate,sec,n,i2x(index_i2x_Faii_swnet,n) - - !--- i/o fluxes computed by ice - write(nu_diag,F01)'export: date, sec, n, Fioi_melth = ',idate,sec,n,i2x(index_i2x_Fioi_melth,n) - write(nu_diag,F01)'export: date, sec, n, Fioi_swpen = ',idate,sec,n,i2x(index_i2x_Fioi_swpen,n) - write(nu_diag,F01)'export: date, sec, n, Fioi_meltw = ',idate,sec,n,i2x(index_i2x_Fioi_meltw,n) - write(nu_diag,F01)'export: date, sec, n, Fioi_salt = ',idate,sec,n,i2x(index_i2x_Fioi_salt ,n) - write(nu_diag,F01)'export: date, sec, n, Fioi_taux = ',idate,sec,n,i2x(index_i2x_Fioi_taux ,n) - write(nu_diag,F01)'export: date, sec, n, Fioi_tauy = ',idate,sec,n,i2x(index_i2x_Fioi_tauy ,n) - if (index_i2x_Fioi_bcpho > 0) then - write(nu_diag,F01)'export: date, sec, n, Fioi_bcpho = ',idate,sec,n,i2x(index_i2x_Fioi_bcpho ,n) - end if - if (index_i2x_Fioi_bcphi > 0) then - write(nu_diag,F01)'export: date, sec, n, Fioi_bcphi = ',idate,sec,n,i2x(index_i2x_Fioi_bcpho ,n) - end if - if (index_i2x_Fioi_flxdst > 0) then - write(nu_diag,F01)'export: date, sec, n, Fioi_flxdst = ',idate,sec,n,i2x(index_i2x_Fioi_flxdst,n) - end if - if (index_i2x_Fioi_meltw_HDO > 0) then - write(nu_diag,F01)'export: date, sec, n, Fioi_HDO = ',idate,sec,n,i2x(index_i2x_Fioi_meltw_HDO,n) - write(nu_diag,F01)'export: date, sec, n, Fioi_16O = ',idate,sec,n,i2x(index_i2x_Fioi_meltw_16O,n) - write(nu_diag,F01)'export: date, sec, n, Fioi_18O = ',idate,sec,n,i2x(index_i2x_Fioi_meltw_18O,n) - write(nu_diag,F01)'export: date, sec, n, Faii_evap_HDO = ',idate,sec,n,i2x(index_i2x_Faii_evap_HDO ,n) - write(nu_diag,F01)'export: date, sec, n, Faii_evap_16O = ',idate,sec,n,i2x(index_i2x_Faii_evap_16O ,n) - write(nu_diag,F01)'export: date, sec, n, Faii_evap_18O = ',idate,sec,n,i2x(index_i2x_Faii_evap_18O ,n) - write(nu_diag,F01)'export: date, sec, n, Si_qref_HDO = ',idate,sec,n,i2x(index_i2x_Si_qref_HDO ,n) - write(nu_diag,F01)'export: date, sec, n, Si_qref_16O = ',idate,sec,n,i2x(index_i2x_Si_qref_16O ,n) - write(nu_diag,F01)'export: date, sec, n, Si_qref_18O = ',idate,sec,n,i2x(index_i2x_Si_qref_18O ,n) - end if - end do - end do - end do - end if - - end subroutine ice_export - -end module ice_import_export diff --git a/cicecore/drivers/mct/cesm2/ice_prescribed_mod.F90 b/cicecore/drivers/mct/cesm2/ice_prescribed_mod.F90 deleted file mode 100644 index 4d95be1d3..000000000 --- a/cicecore/drivers/mct/cesm2/ice_prescribed_mod.F90 +++ /dev/null @@ -1,561 +0,0 @@ -!=================================================================== -!BOP -! -! !MODULE: ice_prescribed_mod - Prescribed Ice Model -! -! !DESCRIPTION: -! -! The prescribed ice model reads in ice concentration data from a netCDF -! file. Ice thickness, temperature, the ice temperature profile are -! prescribed. Air/ice fluxes are computed to get surface temperature, -! Ice/ocean fluxes are set to zero, and ice dynamics are not calculated. -! Regridding and data cycling capabilities are included. -! -! !REVISION HISTORY: -! SVN:$Id: ice_prescribed_mod.F90 40 2006-12-01 19:09:30Z eclare $ -! -! 2010-May-15 - Tony Craig and Mariana Vertenstein - updated to latest streams -! 2006-Aug-22 - D. Bailey, E. Hunke, modified to fit with CICE -! 2005-May-19 - J. Schramm - first version -! 2005-Apr-19 - B. Kauffman, J. Schramm, M. Vertenstein, NCAR - design -! -! !INTERFACE: ---------------------------------------------------------- - -module ice_prescribed_mod - -! !USES: - - use shr_nl_mod, only : shr_nl_find_group_name - use shr_strdata_mod - use shr_dmodel_mod - use shr_string_mod - use shr_ncread_mod - use shr_sys_mod - use shr_mct_mod - use mct_mod - use pio - - use ice_broadcast - use ice_communicate, only : my_task, master_task, MPI_COMM_ICE - use ice_kinds_mod - use ice_fileunits - use ice_exit, only : abort_ice - use ice_domain_size, only : nx_global, ny_global, ncat, nilyr, nslyr, max_blocks - use ice_constants - use ice_blocks, only : nx_block, ny_block, block, get_block - use ice_domain, only : nblocks, distrb_info, blocks_ice - use ice_grid, only : TLAT,TLON,hm,tmask - use ice_calendar, only : idate, sec, calendar_type - use ice_itd, only : hin_max - use ice_read_write - - implicit none - - private ! except - - -! !PUBLIC TYPES: - -! !PUBLIC MEMBER FUNCTIONS: - - public :: ice_prescribed_init ! initialize input data stream - public :: ice_prescribed_run ! get time slices and time interp - public :: ice_prescribed_phys ! set prescribed ice state and fluxes - -! !PUBLIC DATA MEMBERS: - - logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice - -!EOP - - integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files - integer(kind=int_kind) :: stream_year_first ! first year in stream to use - integer(kind=int_kind) :: stream_year_last ! last year in stream to use - integer(kind=int_kind) :: model_year_align ! align stream_year_first - ! with this model year - - character(len=char_len_long) :: stream_fldVarName - character(len=char_len_long) :: stream_fldFileName(nFilesMaximum) - character(len=char_len_long) :: stream_domTvarName - character(len=char_len_long) :: stream_domXvarName - character(len=char_len_long) :: stream_domYvarName - character(len=char_len_long) :: stream_domAreaName - character(len=char_len_long) :: stream_domMaskName - character(len=char_len_long) :: stream_domFileName - character(len=char_len_long) :: stream_mapread - logical(kind=log_kind) :: prescribed_ice_fill ! true if data fill required - - type(shr_strdata_type) :: sdat ! prescribed data stream - character(len=char_len_long) :: fldList ! list of fields in data stream - real(kind=dbl_kind) :: ice_cov(nx_block,ny_block,max_blocks) ! ice cover - - real (kind=dbl_kind), parameter :: & - cp_sno = 0.0_dbl_kind & ! specific heat of snow (J/kg/K) - , rLfi = Lfresh*rhoi & ! latent heat of fusion ice (J/m^3) - , rLfs = Lfresh*rhos & ! latent heat of fusion snow (J/m^3) - , rLvi = Lvap*rhoi & ! latent heat of vapor*rhoice (J/m^3) - , rLvs = Lvap*rhos & ! latent heat of vapor*rhosno (J/m^3) - , rcpi = cp_ice*rhoi & ! heat capacity of fresh ice (J/m^3) - , rcps = cp_sno*rhos & ! heat capacity of snow (J/m^3) - , rcpidepressT = rcpi*depressT & ! param for finding T(z) from q (J/m^3) - , rLfidepressT = rLfi*depressT ! param for heat capacity (J deg/m^3) - ! heat capacity of sea ice, rhoi*C=rcpi+rLfidepressT*salinity/T^2 - -!======================================================================= -contains -!=============================================================================== -!BOP -! -! !IROUTINE: ice_prescribed_init - prescribed ice initialization -! -! !INTERFACE: - subroutine ice_prescribed_init(compid, gsmap, dom) - use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat -! !DESCRIPTION: -! Prescribed ice initialization - needed to -! work with new shr_strdata module derived type -! -! !REVISION HISTORY: -! 2009-Oct-12 - M. Vertenstein -! -! !INPUT/OUTPUT PARAMETERS: -! - implicit none - include 'mpif.h' - integer(kind=int_kind), intent(in) :: compid - type(mct_gsMap) :: gsmap - type(mct_gGrid) :: dom - -!EOP - !----- Local ------ - integer(kind=int_kind) :: nml_error ! namelist i/o error flag - integer(kind=int_kind) :: n, nFile, ierr - character(len=8) :: fillalgo - character(*),parameter :: subName = "('ice_prescribed_init2')" - character(*),parameter :: F00 = "('(ice_prescribed_init2) ',4a)" - - namelist /ice_prescribed_nml/ & - prescribed_ice, & - model_year_align, & - stream_year_first , & - stream_year_last , & - stream_fldVarName , & - stream_fldFileName, & - stream_domTvarName, & - stream_domXvarName, & - stream_domYvarName, & - stream_domAreaName, & - stream_domMaskName, & - stream_domFileName, & - stream_mapread, & - prescribed_ice_fill - - ! default values for namelist - prescribed_ice = .false. ! if true, prescribe ice - stream_year_first = 1 ! first year in pice stream to use - stream_year_last = 1 ! last year in pice stream to use - model_year_align = 1 ! align stream_year_first with this model year - stream_fldVarName = 'ice_cov' - stream_fldFileName(:) = ' ' - stream_domTvarName = 'time' - stream_domXvarName = 'lon' - stream_domYvarName = 'lat' - stream_domAreaName = 'area' - stream_domMaskName = 'mask' - stream_domFileName = ' ' - stream_mapread = 'NOT_SET' - prescribed_ice_fill = .false. ! true if pice data fill required - - ! read from input file - call get_fileunit(nu_nml) - if (my_task == master_task) then - open (nu_nml, file=nml_filename, status='old',iostat=nml_error) - call shr_nl_find_group_name(nu_nml, 'ice_prescribed_nml', status=nml_error) - if (nml_error == 0) then - read(nu_nml, ice_prescribed_nml, iostat=nml_error) - if (nml_error > 0) then - call shr_sys_abort( 'problem on read of ice_prescribed namelist in ice_prescribed_mod' ) - endif - endif - end if - call release_fileunit(nu_nml) - call broadcast_scalar(prescribed_ice, master_task) - - ! *** If not prescribed ice then return *** - if (.not. prescribed_ice) RETURN - - call broadcast_scalar(model_year_align,master_task) - call broadcast_scalar(stream_year_first,master_task) - call broadcast_scalar(stream_year_last,master_task) - call broadcast_scalar(stream_fldVarName,master_task) - call broadcast_scalar(stream_domTvarName,master_task) - call broadcast_scalar(stream_domXvarName,master_task) - call broadcast_scalar(stream_domYvarName,master_task) - call broadcast_scalar(stream_domAreaName,master_task) - call broadcast_scalar(stream_domMaskName,master_task) - call broadcast_scalar(stream_domFileName,master_task) - call broadcast_scalar(stream_mapread,master_task) - call broadcast_scalar(prescribed_ice_fill,master_task) - call mpi_bcast(stream_fldFileName, len(stream_fldFileName(1))*NFilesMaximum, & - MPI_CHARACTER, 0, MPI_COMM_ICE, ierr) - - nFile = 0 - do n=1,nFilesMaximum - if (stream_fldFileName(n) /= ' ') nFile = nFile + 1 - end do - - ! Read shr_strdata_nml namelist - if (prescribed_ice_fill) then - fillalgo='nn' - else - fillalgo='none' - endif - - if (my_task == master_task) then - write(nu_diag,*) ' ' - write(nu_diag,*) 'This is the prescribed ice coverage option.' - write(nu_diag,*) ' stream_year_first = ',stream_year_first - write(nu_diag,*) ' stream_year_last = ',stream_year_last - write(nu_diag,*) ' model_year_align = ',model_year_align - write(nu_diag,*) ' stream_fldVarName = ',trim(stream_fldVarName) - do n = 1,nFile - write(nu_diag,*) ' stream_fldFileName = ',trim(stream_fldFileName(n)),n - end do - write(nu_diag,*) ' stream_domTvarName = ',trim(stream_domTvarName) - write(nu_diag,*) ' stream_domXvarName = ',trim(stream_domXvarName) - write(nu_diag,*) ' stream_domYvarName = ',trim(stream_domYvarName) - write(nu_diag,*) ' stream_domFileName = ',trim(stream_domFileName) - write(nu_diag,*) ' stream_mapread = ',trim(stream_mapread) - write(nu_diag,*) ' stream_fillalgo = ',trim(fillalgo) - write(nu_diag,*) ' ' - endif - - call shr_strdata_create(sdat,name="prescribed_ice", & - mpicom=MPI_COMM_ICE, compid=compid, & - gsmap=gsmap, ggrid=dom, & - nxg=nx_global,nyg=ny_global, & - yearFirst=stream_year_first, & - yearLast=stream_year_last, & - yearAlign=model_year_align, & - offset=0, & - domFilePath='', & - domFileName=trim(stream_domFileName), & - domTvarName=stream_domTvarName, & - domXvarName=stream_domXvarName, & - domYvarName=stream_domYvarName, & - domAreaName=stream_domAreaName, & - domMaskName=stream_domMaskName, & - filePath='', & - filename=stream_fldFileName(1:nFile), & - fldListFile=stream_fldVarName, & - fldListModel=stream_fldVarName, & - fillalgo=trim(fillalgo), & - calendar=trim(calendar_type), & - mapread=trim(stream_mapread)) - - if (my_task == master_task) then - call shr_strdata_print(sdat,'SPRESICE data') - endif - - !----------------------------------------------------------------- - ! For one ice category, set hin_max(1) to something big - !----------------------------------------------------------------- - if (ncat == 1) then - hin_max(1) = 999._dbl_kind - end if -end subroutine ice_prescribed_init - -!======================================================================= -!BOP =================================================================== -! -! !IROUTINE: ice_prescribed_run -- Update ice coverage -! -! !DESCRIPTION: -! -! Finds two time slices bounding current model time, remaps if necessary -! -! !REVISION HISTORY: -! 2005-May-19 - J. Schramm - first version -! 2009-Oct-15 - M. Vertenstein - update to new data model changes -! -! !INTERFACE: ----------------------------------------------------------- - -subroutine ice_prescribed_run(mDateIn, secIn) - -! !USES: - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - - integer(kind=int_kind), intent(in) :: mDateIn ! Current model date (yyyymmdd) - integer(kind=int_kind), intent(in) :: secIn ! Elapsed seconds on model date - -!EOP - - integer(kind=int_kind) :: i,j,n,iblk ! loop indices and counter - integer(kind=int_kind) :: ilo,ihi,jlo,jhi ! beginning and end of physical domain - type (block) :: this_block - real(kind=dbl_kind) :: aice_max ! maximun ice concentration - logical, save :: first_time = .true. - character(*),parameter :: subName = "('ice_prescribed_run')" - character(*),parameter :: F00 = "('(ice_prescribed_run) ',a,2g20.13)" - - !------------------------------------------------------------------------ - ! Interpolate to new ice coverage - !------------------------------------------------------------------------ - - call shr_strdata_advance(sdat,mDateIn,SecIn,MPI_COMM_ICE,'cice_pice') - - ice_cov(:,:,:) = c0 ! This initializes ghost cells as well - - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - ice_cov(i,j,iblk) = sdat%avs(1)%rAttr(1,n) - end do - end do - end do - - !-------------------------------------------------------------------- - ! Check to see that ice concentration is in fraction, not percent - !-------------------------------------------------------------------- - if (first_time) then - aice_max = maxval(ice_cov) - - if (aice_max > c10) then - write(nu_diag,F00) "ERROR: Ice conc data must be in fraction, aice_max= ",& - aice_max - call abort_ice(subName) - end if - first_time = .false. - end if - - !----------------------------------------------------------------- - ! Set prescribed ice state and fluxes - !----------------------------------------------------------------- - - call ice_prescribed_phys() - -end subroutine ice_prescribed_run - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_prescribed_phys -- set prescribed ice state and fluxes -! -! !DESCRIPTION: -! -! Set prescribed ice state using input ice concentration; -! set surface ice temperature to atmospheric value; use -! linear temperature gradient in ice to ocean temperature. -! -! !REVISION HISTORY: -! 2005-May-23 - J. Schramm - Updated with data models -! 2004-July - J. Schramm - Modified to allow variable snow cover -! 2001-May - B. P. Briegleb - Original version -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_prescribed_phys - -! !USES: - - use ice_flux -! use ice_grid, only : bound - use ice_state - use ice_itd, only : aggregate - use ice_dyn_evp - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - -!EOP - - !----- Local ------ - integer(kind=int_kind) :: layer ! level index - integer(kind=int_kind) :: nc ! ice category index - integer(kind=int_kind) :: i,j,k ! longitude, latitude and level indices - integer(kind=int_kind) :: iblk - - real(kind=dbl_kind) :: slope ! diff in underlying ocean tmp and ice surface tmp - real(kind=dbl_kind) :: Ti ! ice level temperature - real(kind=dbl_kind) :: Tmlt ! ice level melt temperature - real(kind=dbl_kind) :: qin_save(nilyr) - real(kind=dbl_kind) :: qsn_save(nslyr) - real(kind=dbl_kind) :: hi ! ice prescribed (hemispheric) ice thickness - real(kind=dbl_kind) :: hs ! snow thickness - real(kind=dbl_kind) :: zn ! normalized ice thickness - real(kind=dbl_kind) :: salin(nilyr) ! salinity (ppt) - - real(kind=dbl_kind), parameter :: nsal = 0.407_dbl_kind - real(kind=dbl_kind), parameter :: msal = 0.573_dbl_kind - real(kind=dbl_kind), parameter :: saltmax = 3.2_dbl_kind ! max salinity at ice base (ppm) - - !----------------------------------------------------------------- - ! Initialize ice state - !----------------------------------------------------------------- - - ! TODO - can we now get rid of the following??? - - ! aicen(:,:,:,:) = c0 - ! vicen(:,:,:,:) = c0 - ! eicen(:,:,:,:) = c0 - - ! do nc=1,ncat - ! trcrn(:,:,nt_Tsfc,nc,:) = Tf(:,:,:) - ! enddo - - !----------------------------------------------------------------- - ! Set ice cover over land to zero, not sure if this should be - ! be done earier, before time/spatial interp?????? - !----------------------------------------------------------------- - do iblk = 1,nblocks - do j = 1,ny_block - do i = 1,nx_block - if (tmask(i,j,iblk)) then - if (ice_cov(i,j,iblk) .lt. eps04) ice_cov(i,j,iblk) = c0 - if (ice_cov(i,j,iblk) .gt. c1) ice_cov(i,j,iblk) = c1 - else - ice_cov(i,j,iblk) = c0 - end if - enddo - enddo - enddo - - do iblk = 1,nblocks - do j = 1,ny_block - do i = 1,nx_block - - if (tmask(i,j,iblk)) then ! Over ocean points - - !-------------------------------------------------------------- - ! Place ice where ice concentration > .0001 - !-------------------------------------------------------------- - - if (ice_cov(i,j,iblk) >= eps04) then - - hi = 0.0_dbl_kind - !---------------------------------------------------------- - ! Set ice thickness in each hemisphere - !---------------------------------------------------------- - if(TLAT(i,j,iblk)*rad_to_deg > 40.0_dbl_kind) then - hi = 2.0_dbl_kind - else if(TLAT(i,j,iblk)*rad_to_deg < -40.0_dbl_kind) then - hi = 1.0_dbl_kind - end if - - !---------------------------------------------------------- - ! All ice in appropriate thickness category - !---------------------------------------------------------- - do nc = 1,ncat - - if(hin_max(nc-1) < hi .and. hi < hin_max(nc)) then - - if (aicen(i,j,nc,iblk) > c0) then - hs = vsnon(i,j,nc,iblk) / aicen(i,j,nc,iblk) - else - hs = c0 - endif - - aicen(i,j,nc,iblk) = ice_cov(i,j,iblk) - vicen(i,j,nc,iblk) = hi*aicen(i,j,nc,iblk) - vsnon(i,j,nc,iblk) = hs*aicen(i,j,nc,iblk) - - !--------------------------------------------------------- - ! make linear temp profile and compute enthalpy - !--------------------------------------------------------- - - if (abs(trcrn(i,j,nt_qice,nc,iblk)) < puny) then - - if (aice(i,j,iblk) < puny) & - trcrn(i,j,nt_Tsfc,nc,iblk) = Tf(i,j,iblk) - - slope = Tf(i,j,iblk) - trcrn(i,j,nt_Tsfc,nc,iblk) - do k = 1, nilyr - zn = (real(k,kind=dbl_kind)-p5) / real(nilyr,kind=dbl_kind) - Ti = trcrn(i,j,nt_Tsfc,nc,iblk) + slope*zn - salin(k) = (saltmax/c2)*(c1-cos(pi*zn**(nsal/(msal+zn)))) - Tmlt = -salin(k)*depressT - trcrn(i,j,nt_sice+k-1,nc,iblk) = salin(k) - trcrn(i,j,nt_qice+k-1,nc,iblk) = & - -(rhoi * (cp_ice*(Tmlt-Ti) & - + Lfresh*(c1-Tmlt/Ti) - cp_ocn*Tmlt)) - enddo - - do k=1,nslyr - trcrn(i,j,nt_qsno+k-1,nc,iblk) = & - -rhos*(Lfresh - cp_ice*trcrn(i,j,nt_Tsfc,nc,iblk)) - enddo - - endif ! aice < puny - end if ! hin_max - enddo ! ncat - else - trcrn(i,j,nt_Tsfc,:,iblk) = Tf(i,j,iblk) - aicen(i,j,:,iblk) = c0 - vicen(i,j,:,iblk) = c0 - vsnon(i,j,:,iblk) = c0 - trcrn(i,j,nt_sice:nt_sice+nilyr-1,:,iblk) = c0 - trcrn(i,j,nt_qice:nt_qice+nilyr-1,:,iblk) = c0 - trcrn(i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk) = c0 - end if ! ice_cov >= eps04 - end if ! tmask - enddo ! i - enddo ! j - - !-------------------------------------------------------------------- - ! compute aggregate ice state and open water area - !-------------------------------------------------------------------- - call aggregate (nx_block, ny_block, & - aicen(:,:,:,iblk), & - trcrn(:,:,1:ntrcr,:,iblk), & - vicen(:,:,:,iblk), vsnon(:,:, :,iblk), & - aice (:,:, iblk), & - trcr (:,:,1:ntrcr, iblk), & - vice (:,:, iblk), vsno (:,:, iblk), & - aice0(:,:, iblk), tmask(:,:, iblk), & - ntrcr, trcr_depend(1:ntrcr)) - - enddo ! iblk - - do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - aice_init(i,j,iblk) = aice(i,j,iblk) - enddo - enddo - enddo - - !-------------------------------------------------------------------- - ! set non-computed fluxes, ice velocities, ice-ocn stresses to zero - !-------------------------------------------------------------------- - - frzmlt (:,:,:) = c0 - uvel (:,:,:) = c0 - vvel (:,:,:) = c0 - strocnxT (:,:,:) = c0 - strocnyT (:,:,:) = c0 - - !----------------------------------------------------------------- - ! other atm and ocn fluxes - !----------------------------------------------------------------- - call init_flux_atm - call init_flux_ocn - -end subroutine ice_prescribed_phys - -!============================================================================== - -end module ice_prescribed_mod - -!============================================================================== diff --git a/cicecore/drivers/mct/cesm2/ice_scam.F90 b/cicecore/drivers/mct/cesm2/ice_scam.F90 deleted file mode 100644 index 86a56d19c..000000000 --- a/cicecore/drivers/mct/cesm2/ice_scam.F90 +++ /dev/null @@ -1,15 +0,0 @@ -module ice_scam - - use ice_kinds_mod - - implicit none - - ! single column control variables (only used for latlon grid) - - logical :: single_column ! true => single column mode - real (kind=dbl_kind) scmlat ! single column latitude (degrees) - real (kind=dbl_kind) scmlon ! single column longitude (degrees) - -end module ice_scam - - diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 7645c43f3..a10ebd23e 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -356,7 +356,9 @@ subroutine coupling_prep (iblk) albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_ai, fhocn, & + fswthru, fswthruvdr, fswthruvdf, fswthruidr, fswthruidf, & + scale_factor, snowfrac, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt @@ -550,7 +552,12 @@ subroutine coupling_prep (iblk) evap (:,:,iblk), & Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), fswthru (:,:,iblk), & + fhocn (:,:,iblk), & + fswthru (:,:,iblk), & + fswthruvdr (:,:,iblk), & + fswthruvdf (:,:,iblk), & + fswthruidr (:,:,iblk), & + fswthruidf (:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index 64c4de612..1113adf98 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -106,6 +106,10 @@ module ice_arrays_column public :: & fswsfcn , & ! SW absorbed at ice/snow surface (W m-2) fswthrun , & ! SW through ice to ocean (W/m^2) + fswthrunvdr , & ! vis dir SW through ice to ocean (W/m^2) + fswthrunvdf , & ! vis dif SW through ice to ocean (W/m^2) + fswthrunidr , & ! nir dir SW through ice to ocean (W/m^2) + fswthrunidf , & ! nir dif SW through ice to ocean (W/m^2) fswintn ! SW absorbed in ice interior, below surface (W m-2) real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, & @@ -359,6 +363,10 @@ subroutine alloc_arrays_column snowfracn (nx_block,ny_block,ncat,max_blocks), & ! Category snow fraction used in radiation fswsfcn (nx_block,ny_block,ncat,max_blocks), & ! SW absorbed at ice/snow surface (W m-2) fswthrun (nx_block,ny_block,ncat,max_blocks), & ! SW through ice to ocean (W/m^2) + fswthrunvdr (nx_block,ny_block,ncat,max_blocks), & ! vis dir SW through ice to ocean (W/m^2) + fswthrunvdf (nx_block,ny_block,ncat,max_blocks), & ! vis dif SW through ice to ocean (W/m^2) + fswthrunidr (nx_block,ny_block,ncat,max_blocks), & ! nir dir SW through ice to ocean (W/m^2) + fswthrunidf (nx_block,ny_block,ncat,max_blocks), & ! nir dif SW through ice to ocean (W/m^2) fswintn (nx_block,ny_block,ncat,max_blocks), & ! SW absorbed in ice interior, below surface (W m-2) first_ice_real & (nx_block,ny_block,ncat,max_blocks), & ! .true. = c1, .false. = c0 diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index fbcc8413b..03f5e8c4c 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -181,7 +181,8 @@ end subroutine init_thermo_vertical subroutine init_shortwave use ice_arrays_column, only: fswpenln, Iswabsn, Sswabsn, albicen, & - albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, fswthrun, & + albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, & + fswthrun, fswthrunvdr, fswthrunvdf, fswthrunidr, fswthrunidf, & fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, & kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, gaer_bc_tab, bcenh, & swgrid, igrid @@ -304,6 +305,10 @@ subroutine init_shortwave fswsfcn(i,j,n,iblk) = c0 fswintn(i,j,n,iblk) = c0 fswthrun(i,j,n,iblk) = c0 + fswthrunvdr(i,j,n,iblk) = c0 + fswthrunvdf(i,j,n,iblk) = c0 + fswthrunidr(i,j,n,iblk) = c0 + fswthrunidf(i,j,n,iblk) = c0 enddo ! ncat enddo @@ -363,7 +368,12 @@ subroutine init_shortwave alvdrn=alvdrn(i,j,:,iblk), alvdfn=alvdfn(i,j,:,iblk), & alidrn=alidrn(i,j,:,iblk), alidfn=alidfn(i,j,:,iblk), & fswsfcn=fswsfcn(i,j,:,iblk), fswintn=fswintn(i,j,:,iblk), & - fswthrun=fswthrun(i,j,:,iblk), fswpenln=fswpenln(i,j,:,:,iblk), & + fswthrun=fswthrun(i,j,:,iblk), & + fswthrunvdr=fswthrunvdr(i,j,:,iblk), & + fswthrunvdf=fswthrunvdf(i,j,:,iblk), & + fswthrunidr=fswthrunidr(i,j,:,iblk), & + fswthrunidf=fswthrunidf(i,j,:,iblk), & + fswpenln=fswpenln(i,j,:,:,iblk), & Sswabsn=Sswabsn(i,j,:,:,iblk), Iswabsn=Iswabsn(i,j,:,:,iblk), & albicen=albicen(i,j,:,iblk), albsnon=albsnon(i,j,:,iblk), & albpndn=albpndn(i,j,:,iblk), apeffn=apeffn(i,j,:,iblk), & diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index b78ac356d..823782042 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -250,6 +250,10 @@ either Celsius or Kelvin units). "fswint", "shortwave absorbed in ice interior", "W/m\ :math:`^2`" "fswpenl", "shortwave penetrating through ice layers", "W/m\ :math:`^2`" "fswthru", "shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthruvdr", "vis dir shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthruvdf", "vis dif shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthruidr", "nir dir shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthruidf", "nir dif shortwave penetrating to ocean", "W/m\ :math:`^2`" "fswthru_ai", "grid-box-mean shortwave penetrating to ocean (fswthru)", "W/m\ :math:`^2`" "fyear", "current data year", "" "fyear_final", "last data year", "" diff --git a/icepack b/icepack index 09a5e19f0..779d9faca 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 09a5e19f006f62f60f6b940a4385feb47451368e +Subproject commit 779d9facaf33e5ef494cc4c03361bc31f9056b13 From ca18a374a047238dca1090f585bef1afb82059c7 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Wed, 24 Jun 2020 09:44:19 -0600 Subject: [PATCH 3/4] Updated fswthru by components --- cicecore/cicedynB/general/ice_flux.F90 | 60 +++++++++---------- cicecore/cicedynB/general/ice_step_mod.F90 | 40 ++++++------- .../drivers/nuopc/cmeps/ice_import_export.F90 | 10 ++-- .../drivers/standalone/cice/CICE_RunMod.F90 | 10 ++-- cicecore/shared/ice_arrays_column.F90 | 16 ++--- cicecore/shared/ice_init_column.F90 | 18 +++--- doc/source/cice_index.rst | 8 +-- icepack | 2 +- 8 files changed, 82 insertions(+), 82 deletions(-) diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 206c44808..16abbe162 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -218,10 +218,10 @@ module ice_flux fsalt , & ! salt flux to ocean (kg/m^2/s) fhocn , & ! net heat flux to ocean (W/m^2) fswthru , & ! shortwave penetrating to ocean (W/m^2) - fswthruvdr , & ! vis dir shortwave penetrating to ocean (W/m^2) - fswthruvdf , & ! vis dif shortwave penetrating to ocean (W/m^2) - fswthruidr , & ! nir dir shortwave penetrating to ocean (W/m^2) - fswthruidf ! nir dif shortwave penetrating to ocean (W/m^2) + fswthru_vdr , & ! vis dir shortwave penetrating to ocean (W/m^2) + fswthru_vdf , & ! vis dif shortwave penetrating to ocean (W/m^2) + fswthru_idr , & ! nir dir shortwave penetrating to ocean (W/m^2) + fswthru_idf ! nir dif shortwave penetrating to ocean (W/m^2) ! internal @@ -442,10 +442,10 @@ subroutine alloc_flux fsalt (nx_block,ny_block,max_blocks), & ! salt flux to ocean (kg/m^2/s) fhocn (nx_block,ny_block,max_blocks), & ! net heat flux to ocean (W/m^2) fswthru (nx_block,ny_block,max_blocks), & ! shortwave penetrating to ocean (W/m^2) - fswthruvdr (nx_block,ny_block,max_blocks), & ! vis dir shortwave penetrating to ocean (W/m^2) - fswthruvdf (nx_block,ny_block,max_blocks), & ! vis dif shortwave penetrating to ocean (W/m^2) - fswthruidr (nx_block,ny_block,max_blocks), & ! nir dir shortwave penetrating to ocean (W/m^2) - fswthruidf (nx_block,ny_block,max_blocks), & ! nir dif shortwave penetrating to ocean (W/m^2) + fswthru_vdr (nx_block,ny_block,max_blocks), & ! vis dir shortwave penetrating to ocean (W/m^2) + fswthru_vdf (nx_block,ny_block,max_blocks), & ! vis dif shortwave penetrating to ocean (W/m^2) + fswthru_idr (nx_block,ny_block,max_blocks), & ! nir dir shortwave penetrating to ocean (W/m^2) + fswthru_idf (nx_block,ny_block,max_blocks), & ! nir dif shortwave penetrating to ocean (W/m^2) scale_factor (nx_block,ny_block,max_blocks), & ! scaling factor for shortwave components strairx_ocn(nx_block,ny_block,max_blocks), & ! stress on ocean by air, x-direction strairy_ocn(nx_block,ny_block,max_blocks), & ! stress on ocean by air, y-direction @@ -692,10 +692,10 @@ subroutine init_coupler_flux fpond (:,:,:) = c0 fhocn (:,:,:) = c0 fswthru (:,:,:) = c0 - fswthruvdr (:,:,:) = c0 - fswthruvdf (:,:,:) = c0 - fswthruidr (:,:,:) = c0 - fswthruidf (:,:,:) = c0 + fswthru_vdr (:,:,:) = c0 + fswthru_vdf (:,:,:) = c0 + fswthru_idr (:,:,:) = c0 + fswthru_idf (:,:,:) = c0 fresh_da(:,:,:) = c0 ! data assimilation fsalt_da(:,:,:) = c0 flux_bio (:,:,:,:) = c0 ! bgc @@ -795,10 +795,10 @@ subroutine init_flux_ocn fpond (:,:,:) = c0 fhocn (:,:,:) = c0 fswthru (:,:,:) = c0 - fswthruvdr (:,:,:) = c0 - fswthruvdf (:,:,:) = c0 - fswthruidr (:,:,:) = c0 - fswthruidf (:,:,:) = c0 + fswthru_vdr (:,:,:) = c0 + fswthru_vdf (:,:,:) = c0 + fswthru_idr (:,:,:) = c0 + fswthru_idf (:,:,:) = c0 faero_ocn (:,:,:,:) = c0 fiso_ocn (:,:,:,:) = c0 @@ -994,8 +994,8 @@ subroutine scale_fluxes (nx_block, ny_block, & Tref, Qref, & fresh, fsalt, & fhocn, fswthru, & - fswthruvdr, fswthruvdf, & - fswthruidr, fswthruidf, & + fswthru_vdr, fswthru_vdf, & + fswthru_idr, fswthru_idf, & faero_ocn, & alvdr, alidr, & alvdf, alidf, & @@ -1040,10 +1040,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt , & ! salt flux to ocean (kg/m2/s) fhocn , & ! actual ocn/ice heat flx (W/m**2) fswthru , & ! sw radiation through ice bot (W/m**2) - fswthruvdr , & ! vis dir sw radiation through ice bot (W/m**2) - fswthruvdf , & ! vis dif sw radiation through ice bot (W/m**2) - fswthruidr , & ! nir dir sw radiation through ice bot (W/m**2) - fswthruidf , & ! nir dif sw radiation through ice bot (W/m**2) + fswthru_vdr , & ! vis dir sw radiation through ice bot (W/m**2) + fswthru_vdf , & ! vis dif sw radiation through ice bot (W/m**2) + fswthru_idr , & ! nir dir sw radiation through ice bot (W/m**2) + fswthru_idf , & ! nir dif sw radiation through ice bot (W/m**2) alvdr , & ! visible, direct (fraction) alidr , & ! near-ir, direct (fraction) alvdf , & ! visible, diffuse (fraction) @@ -1112,10 +1112,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt (i,j) = fsalt (i,j) * ar fhocn (i,j) = fhocn (i,j) * ar fswthru (i,j) = fswthru (i,j) * ar - fswthruvdr (i,j) = fswthruvdr (i,j) * ar - fswthruvdf (i,j) = fswthruvdf (i,j) * ar - fswthruidr (i,j) = fswthruidr (i,j) * ar - fswthruidf (i,j) = fswthruidf (i,j) * ar + fswthru_vdr (i,j) = fswthru_vdr (i,j) * ar + fswthru_vdf (i,j) = fswthru_vdf (i,j) * ar + fswthru_idr (i,j) = fswthru_idr (i,j) * ar + fswthru_idf (i,j) = fswthru_idf (i,j) * ar alvdr (i,j) = alvdr (i,j) * ar alidr (i,j) = alidr (i,j) * ar alvdf (i,j) = alvdf (i,j) * ar @@ -1144,10 +1144,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt (i,j) = c0 fhocn (i,j) = c0 fswthru (i,j) = c0 - fswthruvdr (i,j) = c0 - fswthruvdf (i,j) = c0 - fswthruidr (i,j) = c0 - fswthruidf (i,j) = c0 + fswthru_vdr (i,j) = c0 + fswthru_vdf (i,j) = c0 + fswthru_idr (i,j) = c0 + fswthru_idf (i,j) = c0 alvdr (i,j) = c0 ! zero out albedo where ice is absent alidr (i,j) = c0 alvdf (i,j) = c0 diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 0e05a0e60..a8d823f1a 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -79,7 +79,7 @@ subroutine prep_radiation (iblk) alvdr_ai, alvdf_ai, alidr_ai, alidf_ai, & alvdr_init, alvdf_init, alidr_init, alidf_init use ice_arrays_column, only: fswsfcn, fswintn, & - fswthrun, fswthrunvdr, fswthrunvdf, fswthrunidr, fswthrunidf, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & fswpenln, Sswabsn, Iswabsn use ice_state, only: aice, aicen use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw @@ -132,10 +132,10 @@ subroutine prep_radiation (iblk) alidr_ai = alidr_ai(i,j, iblk), alidf_ai = alidf_ai(i,j, iblk), & fswsfcn = fswsfcn (i,j, :,iblk), fswintn = fswintn (i,j, :,iblk), & fswthrun = fswthrun(i,j, :,iblk), & - fswthrunvdr = fswthrunvdr(i,j, :,iblk), & - fswthrunvdf = fswthrunvdf(i,j, :,iblk), & - fswthrunidr = fswthrunidr(i,j, :,iblk), & - fswthrunidf = fswthrunidf(i,j, :,iblk), & + fswthrun_vdr = fswthrun_vdr(i,j, :,iblk), & + fswthrun_vdf = fswthrun_vdf(i,j, :,iblk), & + fswthrun_idr = fswthrun_idr(i,j, :,iblk), & + fswthrun_idf = fswthrun_idf(i,j, :,iblk), & fswpenln = fswpenln(i,j,:,:,iblk), & Sswabsn = Sswabsn (i,j,:,:,iblk), Iswabsn = Iswabsn (i,j,:,:,iblk)) @@ -164,7 +164,7 @@ subroutine step_therm1 (dt, iblk) Cdn_atm, Cdn_atm_skin, Cdn_atm_floe, Cdn_atm_rdg, Cdn_atm_pond, & hfreebd, hdraft, hridge, distrdg, hkeel, dkeel, lfloe, dfloe, & fswsfcn, fswintn, Sswabsn, Iswabsn, & - fswthrun, fswthrunvdr, fswthrunvdf, fswthrunidr, fswthrunidf + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf use ice_blocks, only: block, get_block, nx_block, ny_block use ice_calendar, only: yday use ice_domain, only: blocks_ice @@ -175,7 +175,7 @@ subroutine step_therm1 (dt, iblk) flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, & frain, Tair, strairxT, strairyT, fsurf, fcondtop, fsens, & flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & - fswthru, fswthruvdr, fswthruvdf, fswthruidr, fswthruidf, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & meltt, melts, meltb, congel, snoice, & flatn_f, fsensn_f, fsurfn_f, fcondtopn_f use ice_flux_bgc, only: dsnown, faero_atm, faero_ocn, fiso_atm, fiso_ocn, & @@ -395,10 +395,10 @@ subroutine step_therm1 (dt, iblk) fswsfcn = fswsfcn (i,j,:,iblk), & fswintn = fswintn (i,j,:,iblk), & fswthrun = fswthrun (i,j,:,iblk), & - fswthrunvdr = fswthrunvdr (i,j,:,iblk), & - fswthrunvdf = fswthrunvdf (i,j,:,iblk), & - fswthrunidr = fswthrunidr (i,j,:,iblk), & - fswthrunidf = fswthrunidf (i,j,:,iblk), & + fswthrun_vdr = fswthrun_vdr (i,j,:,iblk),& + fswthrun_vdf = fswthrun_vdf (i,j,:,iblk),& + fswthrun_idr = fswthrun_idr (i,j,:,iblk),& + fswthrun_idf = fswthrun_idf (i,j,:,iblk),& fswabs = fswabs (i,j, iblk), & flwout = flwout (i,j, iblk), & Sswabsn = Sswabsn (i,j,:,:,iblk), & @@ -415,10 +415,10 @@ subroutine step_therm1 (dt, iblk) fsalt = fsalt (i,j, iblk), & fhocn = fhocn (i,j, iblk), & fswthru = fswthru (i,j, iblk), & - fswthruvdr = fswthruvdr (i,j, iblk), & - fswthruvdf = fswthruvdf (i,j, iblk), & - fswthruidr = fswthruidr (i,j, iblk), & - fswthruidf = fswthruidf (i,j, iblk), & + fswthru_vdr = fswthru_vdr (i,j, iblk),& + fswthru_vdf = fswthru_vdf (i,j, iblk),& + fswthru_idr = fswthru_idr (i,j, iblk),& + fswthru_idf = fswthru_idf (i,j, iblk),& flatn_f = flatn_f (i,j,:,iblk), & fsensn_f = fsensn_f (i,j,:,iblk), & fsurfn_f = fsurfn_f (i,j,:,iblk), & @@ -1000,7 +1000,7 @@ subroutine step_radiation (dt, iblk) use ice_arrays_column, only: ffracn, dhsn, & fswsfcn, fswintn, fswpenln, Sswabsn, Iswabsn, & - fswthrun, fswthrunvdr, fswthrunvdf, fswthrunidr, fswthrunidf, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & albicen, albsnon, albpndn, & alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, & kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & @@ -1138,10 +1138,10 @@ subroutine step_radiation (dt, iblk) alidrn =alidrn (i,j,: ,iblk), alidfn =alidfn (i,j,: ,iblk), & fswsfcn =fswsfcn (i,j,: ,iblk), fswintn =fswintn (i,j,: ,iblk), & fswthrun =fswthrun (i,j,: ,iblk), & - fswthrunvdr =fswthrunvdr (i,j,: ,iblk), & - fswthrunvdf =fswthrunvdf (i,j,: ,iblk), & - fswthrunidr =fswthrunidr (i,j,: ,iblk), & - fswthrunidf =fswthrunidf (i,j,: ,iblk), & + fswthrun_vdr =fswthrun_vdr (i,j,: ,iblk), & + fswthrun_vdf =fswthrun_vdf (i,j,: ,iblk), & + fswthrun_idr =fswthrun_idr (i,j,: ,iblk), & + fswthrun_idf =fswthrun_idf (i,j,: ,iblk), & fswpenln=fswpenln(i,j,:,:,iblk), & Sswabsn =Sswabsn (i,j,:,:,iblk), Iswabsn =Iswabsn (i,j,:,:,iblk), & albicen =albicen (i,j,: ,iblk), albsnon =albsnon (i,j,: ,iblk), & diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 0fe2510aa..9a1456eef 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -17,7 +17,7 @@ module ice_import_export use ice_flux , only : alvdr, alidr, alvdf, alidf, Tref, Qref, Uref use ice_flux , only : flat, fsens, flwout, evap, fswabs, fhocn, fswthru #if (defined NEWCODE) - use ice_flux , only : fswthruvdr, fswthruvdf, fswthruidr, fswthruidf + use ice_flux , only : fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf use ice_flux , only : send_i2x_per_cat, fswthrun_ai #endif use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa @@ -933,19 +933,19 @@ subroutine ice_export( exportState, rc ) #if (defined NEWCODE) ! flux of vis dir shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dir_flx' , input=fswthruvdr, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dir_flx' , input=fswthru_vdr, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of vis dif shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dif_flx' , input=fswthruvdf, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dif_flx' , input=fswthru_vdf, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of ir dir shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dir_flx' , input=fswthruidr, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dir_flx' , input=fswthru_idr, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of ir dif shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dif_flx' , input=fswthruidf, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dif_flx' , input=fswthru_idf, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #endif diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index a10ebd23e..363749e8f 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -357,7 +357,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, & - fswthru, fswthruvdr, fswthruvdf, fswthruidr, fswthruidf, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & scale_factor, snowfrac, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & @@ -554,10 +554,10 @@ subroutine coupling_prep (iblk) fresh (:,:,iblk), fsalt (:,:,iblk), & fhocn (:,:,iblk), & fswthru (:,:,iblk), & - fswthruvdr (:,:,iblk), & - fswthruvdf (:,:,iblk), & - fswthruidr (:,:,iblk), & - fswthruidf (:,:,iblk), & + fswthru_vdr (:,:,iblk), & + fswthru_vdf (:,:,iblk), & + fswthru_idr (:,:,iblk), & + fswthru_idf (:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index 1113adf98..06efd6e94 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -106,10 +106,10 @@ module ice_arrays_column public :: & fswsfcn , & ! SW absorbed at ice/snow surface (W m-2) fswthrun , & ! SW through ice to ocean (W/m^2) - fswthrunvdr , & ! vis dir SW through ice to ocean (W/m^2) - fswthrunvdf , & ! vis dif SW through ice to ocean (W/m^2) - fswthrunidr , & ! nir dir SW through ice to ocean (W/m^2) - fswthrunidf , & ! nir dif SW through ice to ocean (W/m^2) + fswthrun_vdr , & ! vis dir SW through ice to ocean (W/m^2) + fswthrun_vdf , & ! vis dif SW through ice to ocean (W/m^2) + fswthrun_idr , & ! nir dir SW through ice to ocean (W/m^2) + fswthrun_idf , & ! nir dif SW through ice to ocean (W/m^2) fswintn ! SW absorbed in ice interior, below surface (W m-2) real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, & @@ -363,10 +363,10 @@ subroutine alloc_arrays_column snowfracn (nx_block,ny_block,ncat,max_blocks), & ! Category snow fraction used in radiation fswsfcn (nx_block,ny_block,ncat,max_blocks), & ! SW absorbed at ice/snow surface (W m-2) fswthrun (nx_block,ny_block,ncat,max_blocks), & ! SW through ice to ocean (W/m^2) - fswthrunvdr (nx_block,ny_block,ncat,max_blocks), & ! vis dir SW through ice to ocean (W/m^2) - fswthrunvdf (nx_block,ny_block,ncat,max_blocks), & ! vis dif SW through ice to ocean (W/m^2) - fswthrunidr (nx_block,ny_block,ncat,max_blocks), & ! nir dir SW through ice to ocean (W/m^2) - fswthrunidf (nx_block,ny_block,ncat,max_blocks), & ! nir dif SW through ice to ocean (W/m^2) + fswthrun_vdr (nx_block,ny_block,ncat,max_blocks), & ! vis dir SW through ice to ocean (W/m^2) + fswthrun_vdf (nx_block,ny_block,ncat,max_blocks), & ! vis dif SW through ice to ocean (W/m^2) + fswthrun_idr (nx_block,ny_block,ncat,max_blocks), & ! nir dir SW through ice to ocean (W/m^2) + fswthrun_idf (nx_block,ny_block,ncat,max_blocks), & ! nir dif SW through ice to ocean (W/m^2) fswintn (nx_block,ny_block,ncat,max_blocks), & ! SW absorbed in ice interior, below surface (W m-2) first_ice_real & (nx_block,ny_block,ncat,max_blocks), & ! .true. = c1, .false. = c0 diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 815b97615..dc8bda226 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -182,7 +182,7 @@ subroutine init_shortwave use ice_arrays_column, only: fswpenln, Iswabsn, Sswabsn, albicen, & albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, & - fswthrun, fswthrunvdr, fswthrunvdf, fswthrunidr, fswthrunidf, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, & kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, gaer_bc_tab, bcenh, & swgrid, igrid @@ -305,10 +305,10 @@ subroutine init_shortwave fswsfcn(i,j,n,iblk) = c0 fswintn(i,j,n,iblk) = c0 fswthrun(i,j,n,iblk) = c0 - fswthrunvdr(i,j,n,iblk) = c0 - fswthrunvdf(i,j,n,iblk) = c0 - fswthrunidr(i,j,n,iblk) = c0 - fswthrunidf(i,j,n,iblk) = c0 + fswthrun_vdr(i,j,n,iblk) = c0 + fswthrun_vdf(i,j,n,iblk) = c0 + fswthrun_idr(i,j,n,iblk) = c0 + fswthrun_idf(i,j,n,iblk) = c0 enddo ! ncat enddo @@ -369,10 +369,10 @@ subroutine init_shortwave alidrn=alidrn(i,j,:,iblk), alidfn=alidfn(i,j,:,iblk), & fswsfcn=fswsfcn(i,j,:,iblk), fswintn=fswintn(i,j,:,iblk), & fswthrun=fswthrun(i,j,:,iblk), & - fswthrunvdr=fswthrunvdr(i,j,:,iblk), & - fswthrunvdf=fswthrunvdf(i,j,:,iblk), & - fswthrunidr=fswthrunidr(i,j,:,iblk), & - fswthrunidf=fswthrunidf(i,j,:,iblk), & + fswthrun_vdr=fswthrun_vdr(i,j,:,iblk), & + fswthrun_vdf=fswthrun_vdf(i,j,:,iblk), & + fswthrun_idr=fswthrun_idr(i,j,:,iblk), & + fswthrun_idf=fswthrun_idf(i,j,:,iblk), & fswpenln=fswpenln(i,j,:,:,iblk), & Sswabsn=Sswabsn(i,j,:,:,iblk), Iswabsn=Iswabsn(i,j,:,:,iblk), & albicen=albicen(i,j,:,iblk), albsnon=albsnon(i,j,:,iblk), & diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index fb01fff0d..ec36a209e 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -251,10 +251,10 @@ either Celsius or Kelvin units). "fswint", "shortwave absorbed in ice interior", "W/m\ :math:`^2`" "fswpenl", "shortwave penetrating through ice layers", "W/m\ :math:`^2`" "fswthru", "shortwave penetrating to ocean", "W/m\ :math:`^2`" - "fswthruvdr", "vis dir shortwave penetrating to ocean", "W/m\ :math:`^2`" - "fswthruvdf", "vis dif shortwave penetrating to ocean", "W/m\ :math:`^2`" - "fswthruidr", "nir dir shortwave penetrating to ocean", "W/m\ :math:`^2`" - "fswthruidf", "nir dif shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_vdr", "vis dir shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_vdf", "vis dif shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_idr", "nir dir shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_idf", "nir dif shortwave penetrating to ocean", "W/m\ :math:`^2`" "fswthru_ai", "grid-box-mean shortwave penetrating to ocean (fswthru)", "W/m\ :math:`^2`" "fyear", "current data year", "" "fyear_final", "last data year", "" diff --git a/icepack b/icepack index 407b8832b..2b27a78aa 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 407b8832b2b9d0d9ac1db2bc94a652cc72ee8dba +Subproject commit 2b27a78aaecb3635d14b94464d918a67df750ff0 From 89bc762bf9c2e0340815be7f140815791fb3c63f Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 6 Jul 2020 16:37:47 -0600 Subject: [PATCH 4/4] Update documentation --- doc/source/cice_index.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 13b154e8a..8cadc5073 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -252,10 +252,10 @@ either Celsius or Kelvin units). "fswint", "shortwave absorbed in ice interior", "W/m\ :math:`^2`" "fswpenl", "shortwave penetrating through ice layers", "W/m\ :math:`^2`" "fswthru", "shortwave penetrating to ocean", "W/m\ :math:`^2`" - "fswthru_vdr", "vis dir shortwave penetrating to ocean", "W/m\ :math:`^2`" - "fswthru_vdf", "vis dif shortwave penetrating to ocean", "W/m\ :math:`^2`" - "fswthru_idr", "nir dir shortwave penetrating to ocean", "W/m\ :math:`^2`" - "fswthru_idf", "nir dif shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_vdr", "visible direct shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_vdf", "visible diffuse shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_idr", "near IR direct shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_idf", "near IR diffuse shortwave penetrating to ocean", "W/m\ :math:`^2`" "fswthru_ai", "grid-box-mean shortwave penetrating to ocean (fswthru)", "W/m\ :math:`^2`" "fyear", "current data year", "" "fyear_final", "last data year", ""