From 21c9bcd96c1dbeb725db221f30d2d20c40de7a2a Mon Sep 17 00:00:00 2001 From: apcraig Date: Sun, 16 Mar 2025 12:48:37 -0600 Subject: [PATCH 01/11] Add GEOS heatflux and massflux updates. This allows coupling to the GEOS coupled system where a semi-implicit thermodynamic coupling scheme is introduced. Similar to the explicit case, the fields fsurfn are provided by the coupler, along with their derivatives with respect to surface temperature dfsurfn_dTs. In this case, calc_Tsfc is still set to true, allowing ice surface and internal temperature to be updated implicitly. The resultant surface temperature change is passed back to the atmosphere model via coupler to complete the full update of its temperature profiles. This middle-ground approach, enabled by geos_heatflux=true, does not sacrifice accuracy because it does not need limiting effective conductivity as in the explicit case. In addition, in GEOS, the atmsophere model assumes vapor deposits or sublimates at 0 degC. In this case, mass conservation is enforced and the resulting discrepancy in energy is resolved by another term sblx and passed to ocean. This option is only on when geos_massflux=true. - Add GEOS heatflux and massflux coupling capability. Includes addition of four new shortwave terms, uvrdr, uvrdf, pardr, pardf to the coupling. These terms represent a breakdown of the direct and diffuse visible shortwave terms into two components, par = photosynthetical active radiation and uvr = rest of the visible shortwave term. The current visible shortwave is exactly represented by these two components. Includes adding atm forcing and terms associated with radiation passthru to the ocean. - Add calculation of GEOS heatflux. In GEOS, surface and latent heat flux is computed in the atmosphere at 0degC. The sea ice model has to respect that calculation, but then computes the d(dh)/dTs terms to correct the heatflux for the sea ice temperature which is then applied conservatively in the coupled system. Implementation includes turning off some of the heat flux calculations in Icepack. - Add calculation of GEOS massflux term. An equivalent correction is needed to the mass and enthalpy terms to take into account the GEOS coupling. - Add geos_heatflux and geos_massflux to namelist input - Add mapl/geos coupling directory and coupling files - Add opmask (orphan mask) for points that are NOT ocean/ice in the ocean/ice model but are ocean/ice in the atmosphere model. This allows for thermodyanamic calculations on the orphan points while not being involved in any sea ice dynamics. opmask determined by ocn_gridcell_frac which should be set by coupling layer at initialization. - Add geosmom grid_type to read GEOS MOM grid files - Add discover port - Update documentation - Change use of grid_type='tripole' where ns_boundary_type='tripole' is more appropriate. - Add distribution_wght=blockfull option to move away from CPP in init_domain_blocks. This option turns off land block elimination and sets all blocks to maximum weight for distribution. - Clean up some declarations in ice_flux.F90 and ice_state.F90 - Add some new initialization output for new GEOS options and to clean up grid_type output --- cicecore/cicedyn/dynamics/ice_dyn_eap.F90 | 6 +- cicecore/cicedyn/dynamics/ice_dyn_evp.F90 | 9 +- cicecore/cicedyn/dynamics/ice_dyn_shared.F90 | 10 +- cicecore/cicedyn/dynamics/ice_dyn_vp.F90 | 8 +- cicecore/cicedyn/general/ice_flux.F90 | 59 +- cicecore/cicedyn/general/ice_init.F90 | 33 +- cicecore/cicedyn/general/ice_state.F90 | 28 +- cicecore/cicedyn/general/ice_step_mod.F90 | 47 +- .../cicedyn/infrastructure/ice_domain.F90 | 17 +- cicecore/cicedyn/infrastructure/ice_grid.F90 | 213 ++- .../infrastructure/ice_restart_driver.F90 | 21 +- .../io/io_binary/ice_restart.F90 | 2 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 2 +- cicecore/drivers/mapl/geos/CICE_FinalMod.F90 | 150 ++ cicecore/drivers/mapl/geos/CICE_InitMod.F90 | 529 +++++++ cicecore/drivers/mapl/geos/CICE_RunMod.F90 | 1304 +++++++++++++++++ cicecore/drivers/mapl/geos/CICE_copyright.txt | 17 + .../drivers/mapl/geos/ice_import_export.F90 | 1034 +++++++++++++ .../drivers/mapl/geos/ice_prescribed_mod.F90 | 489 +++++++ cicecore/drivers/mapl/geos/ice_record_mod.F90 | 165 +++ .../drivers/mapl/geos/ice_shr_methods.F90 | 33 + cicecore/shared/ice_arrays_column.F90 | 10 +- cicecore/shared/ice_calendar.F90 | 6 +- cicecore/shared/ice_init_column.F90 | 18 +- configuration/scripts/cice.batch.csh | 13 + configuration/scripts/cice.launch.csh | 12 + configuration/scripts/ice_in | 2 + .../scripts/machines/Macros.discover_intel | 42 + .../scripts/machines/env.discover_intel | 54 + doc/source/cice_index.rst | 2 +- doc/source/user_guide/ug_case_settings.rst | 10 +- doc/source/user_guide/ug_implementation.rst | 6 +- 32 files changed, 4249 insertions(+), 102 deletions(-) create mode 100644 cicecore/drivers/mapl/geos/CICE_FinalMod.F90 create mode 100644 cicecore/drivers/mapl/geos/CICE_InitMod.F90 create mode 100644 cicecore/drivers/mapl/geos/CICE_RunMod.F90 create mode 100644 cicecore/drivers/mapl/geos/CICE_copyright.txt create mode 100644 cicecore/drivers/mapl/geos/ice_import_export.F90 create mode 100644 cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 create mode 100644 cicecore/drivers/mapl/geos/ice_record_mod.F90 create mode 100644 cicecore/drivers/mapl/geos/ice_shr_methods.F90 create mode 100644 configuration/scripts/machines/Macros.discover_intel create mode 100755 configuration/scripts/machines/env.discover_intel diff --git a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 index 8249e3068..852a897f6 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 @@ -2090,8 +2090,7 @@ subroutine read_restart_eap() use ice_boundary, only: ice_HaloUpdate_stress use ice_constants, only: & field_loc_center, field_type_scalar - use ice_domain, only: nblocks, halo_info - use ice_grid, only: grid_type + use ice_domain, only: nblocks, halo_info, ns_boundary_type use ice_restart, only: read_restart_field ! local variables @@ -2131,7 +2130,8 @@ subroutine read_restart_eap() call read_restart_field(nu_restart_eap,0,a12_4,'ruf8', & 'a12_4',1,diag,field_loc_center,field_type_scalar) ! a12_4 - if (trim(grid_type) == 'tripole') then + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then call ice_HaloUpdate_stress(a11_1, a11_3, halo_info, & field_loc_center, field_type_scalar) diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 index c858de1c8..39d5a8e20 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 @@ -259,7 +259,8 @@ subroutine evp (dt) use ice_boundary, only: ice_halo, ice_HaloMask, ice_HaloUpdate, & ice_HaloDestroy, ice_HaloUpdate_stress use ice_blocks, only: block, get_block, nx_block, ny_block, nghost - use ice_domain, only: nblocks, blocks_ice, halo_info, maskhalo_dyn + use ice_domain, only: nblocks, blocks_ice, halo_info, maskhalo_dyn, & + ns_boundary_type use ice_domain_size, only: max_blocks, ncat use ice_flux, only: rdg_conv, rdg_shear, strairxT, strairyT, & strairxU, strairyU, uocn, vocn, ss_tltx, ss_tlty, fmU, & @@ -280,8 +281,7 @@ subroutine evp (dt) use ice_grid, only: tmask, umask, umaskCD, nmask, emask, uvm, epm, npm, & dxE, dxN, dxT, dxU, dyE, dyN, dyT, dyU, & tarear, uarear, earear, narear, grid_average_X2Y, uarea, & - grid_type, grid_ice, & - grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv + grid_ice, grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, uvelN, vvelN, & uvelE, vvelE, divu, shear, vort, & aice_init, aice0, aicen, vicen, strength @@ -1313,7 +1313,8 @@ subroutine evp (dt) endif ! Force symmetry across the tripole seam - if (trim(grid_type) == 'tripole') then + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then ! TODO: C/CD-grid if (maskhalo_dyn) then !------------------------------------------------------- diff --git a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 index 660423910..40f49877d 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 @@ -240,7 +240,8 @@ subroutine init_dyn_shared (dt) use ice_blocks, only: block, get_block use ice_boundary, only: ice_halo, ice_haloUpdate - use ice_domain, only: nblocks, halo_dynbundle, blocks_ice, halo_info + use ice_domain, only: nblocks, halo_dynbundle, blocks_ice, halo_info, & + ns_boundary_type use ice_domain_size, only: max_blocks use ice_flux, only: & stressp_1, stressp_2, stressp_3, stressp_4, & @@ -268,6 +269,13 @@ subroutine init_dyn_shared (dt) character(len=*), parameter :: subname = '(init_dyn_shared)' + ! checks + if (kdyn == 1 .and. evp_algorithm == 'shared_mem_1d' .and. & + (ns_boundary_type == 'tripole' .or. ns_boundary_type == 'tripoleT')) then + call abort_ice(subname//' ERROR: evp_alg shared mem 1d not supported with tripole', & + file=__FILE__, line=__LINE__) + endif + call set_evp_parameters (dt) ! allocate dyn shared (init_uvel,init_vvel) call alloc_dyn_shared diff --git a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 index 22a53bc59..23f260d65 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 @@ -155,7 +155,8 @@ subroutine implicit_solver (dt) use ice_boundary, only: ice_HaloMask, ice_HaloUpdate, & ice_HaloDestroy, ice_HaloUpdate_stress use ice_blocks, only: block, get_block, nx_block, ny_block - use ice_domain, only: blocks_ice, halo_info, maskhalo_dyn + use ice_domain, only: blocks_ice, halo_info, maskhalo_dyn, & + ns_boundary_type use ice_domain_size, only: max_blocks, ncat use ice_dyn_shared, only: deformations, iceTmask, iceUmask, & cxp, cyp, cxm, cym @@ -168,7 +169,7 @@ subroutine implicit_solver (dt) stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 use ice_grid, only: tmask, umask, dxT, dyT, dxU, dyU, & - tarear, grid_type, grid_average_X2Y, & + tarear, grid_average_X2Y, & grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, divu, shear, vort, & aice_init, aice0, aicen, vicen, strength @@ -546,7 +547,8 @@ subroutine implicit_solver (dt) endif ! Force symmetry across the tripole seam - if (trim(grid_type) == 'tripole') then + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then if (maskhalo_dyn) then !------------------------------------------------------- ! set halomask to zero because ice_HaloMask always keeps diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index 6378db6eb..bdce9d7d0 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -114,8 +114,7 @@ module ice_flux dvirdgdt, & ! rate of ice volume ridged (m/s) opening ! rate of opening due to divergence/shear (1/s) - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & ! ridging diagnostics in categories dardg1ndt, & ! rate of area loss by ridging ice (1/s) dardg2ndt, & ! rate of area gain by new ridges (1/s) @@ -177,13 +176,26 @@ module ice_flux ! NOTE: when in CICE_IN_NEMO mode, these are gridbox mean fields, ! not per ice area. When in standalone mode, these are per ice area. - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & fsurfn_f , & ! net flux to top surface, excluding fcondtop fcondtopn_f, & ! downward cond flux at top surface (W m-2) fsensn_f , & ! sensible heat flux (W m-2) flatn_f ! latent heat flux (W m-2) + ! in from atmosphere + ! required for coupling in GEOS + + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & + evapn_f, & ! evaporation/sublimation (kg m-2 s-1) + dflatndTs_f, & ! derivative of latent flux w.r.t. Ts + dfsurfndTs_f ! derivative of surface flux w.r.t. Ts + + real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & + swuvrdr , & ! vis uvr flux, direct (W m-2) + swuvrdf , & ! vis uvr flux, diffuse (W m-2) + swpardr , & ! vis par flux, direct (W m-2) + swpardf ! vis par flux, diffuse (W m-2) + ! in from atmosphere real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & @@ -258,7 +270,11 @@ module ice_flux 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) + fswthru_idf , & ! nir dif shortwave penetrating to ocean (W/m^2) + fswthru_uvrdr,& ! vis dir uvr SW penetrating to ocean (W/m^2) + fswthru_uvrdf,& ! vis dif uvr SW penetrating to ocean (W/m^2) + fswthru_pardr,& ! nir dir par SW penetrating to ocean (W/m^2) + fswthru_pardf ! nir dif par SW penetrating to ocean (W/m^2) ! internal @@ -326,16 +342,14 @@ module ice_flux frz_onset, &! day of year that freezing begins (congel or frazil) frazil_diag ! frazil ice growth diagnostic (m/step-->cm/day) - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & fsurfn, & ! category fsurf fcondtopn,& ! category fcondtop fcondbotn,& ! category fcondbot fsensn, & ! category sensible heat flux flatn ! category latent heat flux - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & snwcnt ! counter for presence of snow ! As above but these remain grid box mean values i.e. they are not @@ -453,6 +467,10 @@ subroutine alloc_flux swvdf (nx_block,ny_block,max_blocks), & ! sw down, visible, diffuse (W/m^2) swidr (nx_block,ny_block,max_blocks), & ! sw down, near IR, direct (W/m^2) swidf (nx_block,ny_block,max_blocks), & ! sw down, near IR, diffuse (W/m^2) + swuvrdr (nx_block,ny_block,max_blocks), & ! vis uvr flux, direct (W m-2) + swuvrdf (nx_block,ny_block,max_blocks), & ! vis uvr flux, diffuse (W m-2) + swpardr (nx_block,ny_block,max_blocks), & ! vis par flux, direct (W m-2) + swpardf (nx_block,ny_block,max_blocks), & ! vis par flux, diffuse (W m-2) flw (nx_block,ny_block,max_blocks), & ! incoming longwave radiation (W/m^2) frain (nx_block,ny_block,max_blocks), & ! rainfall rate (kg/m^2 s) fsnow (nx_block,ny_block,max_blocks), & ! snowfall rate (kg/m^2 s) @@ -499,11 +517,15 @@ subroutine alloc_flux fhocn (nx_block,ny_block,max_blocks), & ! net heat flux to ocean (W/m^2) fsloss (nx_block,ny_block,max_blocks), & ! rate of snow loss to leads (kg/m^2/s) fswthru (nx_block,ny_block,max_blocks), & ! 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 + 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) + fswthru_uvrdr (nx_block,ny_block,max_blocks), & ! vis dir uvr SW penetrating to ocean (W/m^2) + fswthru_uvrdf (nx_block,ny_block,max_blocks), & ! vis dir uvr SW penetrating to ocean (W/m^2) + fswthru_pardr (nx_block,ny_block,max_blocks), & ! vis dir par SW penetrating to ocean (W/m^2) + fswthru_pardf (nx_block,ny_block,max_blocks), & ! vis dir par SW 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 fsens_ocn (nx_block,ny_block,max_blocks), & ! sensible heat flux (W/m^2) @@ -566,6 +588,9 @@ subroutine alloc_flux fcondtopn_f(nx_block,ny_block,ncat,max_blocks), & ! downward cond flux at top surface (W m-2) fsensn_f (nx_block,ny_block,ncat,max_blocks), & ! sensible heat flux (W m-2) flatn_f (nx_block,ny_block,ncat,max_blocks), & ! latent heat flux (W m-2) + evapn_f (nx_block,ny_block,ncat,max_blocks), & ! evaporative water flux (kg/m^2/s) by atmosphere model + dflatndTs_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of flatn with respect to Ts + dfsurfndTs_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of fsurfn with respect to Ts meltsn (nx_block,ny_block,ncat,max_blocks), & ! snow melt in category n (m) melttn (nx_block,ny_block,ncat,max_blocks), & ! top melt in category n (m) meltbn (nx_block,ny_block,ncat,max_blocks), & ! bottom melt in category n (m) @@ -792,6 +817,10 @@ subroutine init_coupler_flux fswthru_vdf (:,:,:) = c0 fswthru_idr (:,:,:) = c0 fswthru_idf (:,:,:) = c0 + fswthru_uvrdr (:,:,:) = c0 + fswthru_uvrdf (:,:,:) = c0 + fswthru_pardr (:,:,:) = c0 + fswthru_pardf (:,:,:) = c0 fresh_da(:,:,:) = c0 ! data assimilation fsalt_da(:,:,:) = c0 flux_bio (:,:,:,:) = c0 ! bgc @@ -853,6 +882,8 @@ subroutine init_flux_atm ! strairxT(:,:,:) = 0.15_dbl_kind ! strairyT(:,:,:) = 0.15_dbl_kind + fsurf (:,:,:) = c0 + fcondtop(:,:,:) = c0 fsens (:,:,:) = c0 flat (:,:,:) = c0 fswabs (:,:,:) = c0 diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 2de682794..fbad53ea6 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -167,7 +167,7 @@ subroutine input_data congel_freeze, capping_method, snw_ssp_table logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec, & - sw_redist, calc_dragio, use_smliq_pnd, snwgrain + sw_redist, calc_dragio, use_smliq_pnd, snwgrain, geos_heatflux, geos_massflux logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd, tr_snow @@ -290,7 +290,7 @@ subroutine input_data fyear_init, ycycle, wave_spec_file,restart_coszen, & atm_data_dir, ocn_data_dir, bgc_data_dir, & atm_data_format, ocn_data_format, rotate_wind, & - oceanmixed_file, atm_data_version + oceanmixed_file, atm_data_version,geos_heatflux,geos_massflux !----------------------------------------------------------------- ! default values @@ -477,6 +477,8 @@ subroutine input_data kridge = 1 ! -1 = off, 1 = on ktransport = 1 ! -1 = off, 1 = on calc_Tsfc = .true. ! calculate surface temperature + geos_heatflux = .false. ! geos heatflux coupling + geos_massflux = .false. ! geos massflux coupling update_ocn_f = .false. ! include fresh water and salt fluxes for frazil cpl_frazil = 'fresh_ice_correction' ! type of coupling for frazil ice ustar_min = 0.005 ! minimum friction velocity for ocean heat flux (m/s) @@ -1120,6 +1122,8 @@ subroutine input_data call broadcast_scalar(rotate_wind, master_task) call broadcast_scalar(calc_strair, master_task) call broadcast_scalar(calc_Tsfc, master_task) + call broadcast_scalar(geos_heatflux, master_task) + call broadcast_scalar(geos_massflux, master_task) call broadcast_scalar(formdrag, master_task) call broadcast_scalar(highfreq, master_task) call broadcast_scalar(natmiter, master_task) @@ -1453,15 +1457,6 @@ subroutine input_data endif endif - if (evp_algorithm == 'shared_mem_1d' .and. & - grid_type == 'tripole') then - if (my_task == master_task) then - write(nu_diag,*) subname//' ERROR: evp_algorithm=shared_mem_1d is not tested for gridtype=tripole' - write(nu_diag,*) subname//' ERROR: change evp_algorithm to standard_2d' - endif - abort_list = trim(abort_list)//":49" - endif - capping = -9.99e30 if (kdyn == 1 .or. kdyn == 3) then if (capping_method == 'max') then @@ -1961,9 +1956,11 @@ subroutine input_data write(nu_diag,1030) ' grid_format = ',trim(grid_format) tmpstr2 = ' ' if (trim(grid_type) == 'rectangular') tmpstr2 = ' : internally defined, rectangular grid' - if (trim(grid_type) == 'regional') tmpstr2 = ' : user-defined, regional grid' - if (trim(grid_type) == 'displaced_pole') tmpstr2 = ' : user-defined grid with rotated north pole' - if (trim(grid_type) == 'tripole') tmpstr2 = ' : user-defined grid with northern hemisphere zipper' + if (trim(grid_type) == 'regional') tmpstr2 = ' : pop grid file, regional grid' + if (trim(grid_type) == 'displaced_pole') tmpstr2 = ' : pop grid file with rotated north pole' + if (trim(grid_type) == 'tripole') tmpstr2 = ' : pop grid file with northern hemisphere zipper' + if (trim(grid_type) == 'geosmom') tmpstr2 = ' : geos mom grid file' + if (trim(grid_type) == 'latlon') tmpstr2 = ' : cesm latlon domain file' write(nu_diag,1030) ' grid_type = ',trim(grid_type),trim(tmpstr2) write(nu_diag,1030) ' grid_ice = ',trim(grid_ice) write(nu_diag,1030) ' grid_ice_thrm = ',trim(grid_ice_thrm) @@ -2294,6 +2291,8 @@ subroutine input_data write(nu_diag,1010) ' rotate_wind = ', rotate_wind,' : rotate wind/stress to computational grid' write(nu_diag,1010) ' formdrag = ', formdrag,' : use form drag parameterization' write(nu_diag,1000) ' iceruf = ', iceruf, ' : ice surface roughness at atmosphere interface (m)' + write(nu_diag,1010) ' geos_heatflux = ', geos_heatflux,' : GEOS heatflux calc based on d(hf)/dTs' + write(nu_diag,1010) ' geos_massflux = ', geos_massflux,' : GEOS mass/enthalpy adjustment' if (trim(atmbndy) == 'constant') then tmpstr2 = ' : constant-based boundary layer' elseif (trim(atmbndy) == 'similarity' .or. & @@ -2703,8 +2702,8 @@ subroutine input_data grid_type /= 'tripole' .and. & grid_type /= 'column' .and. & grid_type /= 'rectangular' .and. & - grid_type /= 'cpom_grid' .and. & grid_type /= 'regional' .and. & + grid_type /= 'geosmom' .and. & grid_type /= 'latlon') then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: unknown grid_type=',trim(grid_type) abort_list = trim(abort_list)//":20" @@ -2763,8 +2762,8 @@ subroutine input_data atmbndy_in=atmbndy, calc_strair_in=calc_strair, formdrag_in=formdrag, highfreq_in=highfreq, & kitd_in=kitd, kcatbound_in=kcatbound, hs0_in=hs0, dpscale_in=dpscale, frzpnd_in=frzpnd, & rfracmin_in=rfracmin, rfracmax_in=rfracmax, pndaspect_in=pndaspect, hs1_in=hs1, hp1_in=hp1, & - ktherm_in=ktherm, calc_Tsfc_in=calc_Tsfc, conduct_in=conduct, & - a_rapid_mode_in=a_rapid_mode, Rac_rapid_mode_in=Rac_rapid_mode, & + ktherm_in=ktherm, calc_Tsfc_in=calc_Tsfc, conduct_in=conduct, geos_heatflux_in=geos_heatflux, & + a_rapid_mode_in=a_rapid_mode, Rac_rapid_mode_in=Rac_rapid_mode, geos_massflux_in=geos_massflux, & floediam_in=floediam, hfrazilmin_in=hfrazilmin, Tliquidus_max_in=Tliquidus_max, & aspect_rapid_mode_in=aspect_rapid_mode, dSdt_slow_mode_in=dSdt_slow_mode, & phi_c_slow_mode_in=phi_c_slow_mode, phi_i_mushy_in=phi_i_mushy, conserv_check_in=conserv_check, & diff --git a/cicecore/cicedyn/general/ice_state.F90 b/cicecore/cicedyn/general/ice_state.F90 index 21ddf562c..82b03f2cb 100644 --- a/cicecore/cicedyn/general/ice_state.F90 +++ b/cicecore/cicedyn/general/ice_state.F90 @@ -52,15 +52,13 @@ module ice_state ! state of the ice aggregated over all categories !----------------------------------------------------------------- - real (kind=dbl_kind), dimension(:,:,:), allocatable, & - public :: & + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & aice , & ! concentration of ice on T grid aiU , & ! concentration of ice on U grid vice , & ! volume per unit area of ice (m) vsno ! volume per unit area of snow (m) - real (kind=dbl_kind), & - dimension(:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension(:,:,:,:), allocatable, public :: & trcr ! ice tracers ! 1: surface temperature of ice/snow (C) @@ -68,18 +66,15 @@ module ice_state ! state of the ice for each category !----------------------------------------------------------------- - real (kind=dbl_kind), dimension (:,:,:), allocatable, & - public:: & + real (kind=dbl_kind), dimension (:,:,:), allocatable, public:: & aice0 ! concentration of open water - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & aicen , & ! concentration of ice vicen , & ! volume per unit area of ice (m) vsnon ! volume per unit area of snow (m) - real (kind=dbl_kind), public, & - dimension (:,:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & trcrn ! tracers ! 1: surface temperature of ice/snow (C) @@ -106,8 +101,7 @@ module ice_state ! dynamic variables closely related to the state of the ice !----------------------------------------------------------------- - real (kind=dbl_kind), dimension(:,:,:), allocatable, & - public :: & + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & uvel , & ! x-component of velocity on U grid (m/s) vvel , & ! y-component of velocity on U grid (m/s) uvelE , & ! x-component of velocity on E grid (m/s) @@ -123,15 +117,14 @@ module ice_state ! ice state at start of time step, saved for later in the step !----------------------------------------------------------------- - real (kind=dbl_kind), dimension(:,:,:), allocatable, & - public :: & + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & aice_init ! initial concentration of ice, for diagnostics - real (kind=dbl_kind), & - dimension(:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension(:,:,:,:), allocatable, public :: & aicen_init , & ! initial ice concentration, for linear ITD vicen_init , & ! initial ice volume (m), for linear ITD - vsnon_init ! initial snow volume (m), for aerosol + vsnon_init , & ! initial snow volume (m), for aerosol + Tsfcn_init ! initial ice surface temperature (degC) !======================================================================= @@ -173,6 +166,7 @@ subroutine alloc_state aicen_init(nx_block,ny_block,ncat,max_blocks) , & ! initial ice concentration, for linear ITD vicen_init(nx_block,ny_block,ncat,max_blocks) , & ! initial ice volume (m), for linear ITD vsnon_init(nx_block,ny_block,ncat,max_blocks) , & ! initial snow volume (m), for aerosol + Tsfcn_init(nx_block,ny_block,ncat,max_blocks) , & ! initial snow/ice surface temperature(degC) trcr (nx_block,ny_block,ntrcr,max_blocks) , & ! ice tracers: 1: surface temperature of ice/snow (C) trcrn (nx_block,ny_block,ntrcr,ncat,max_blocks) , & ! tracers: 1: surface temperature of ice/snow (C) stat=ierr) diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index 6a6810a4f..52504123a 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -60,7 +60,10 @@ subroutine save_init ! saves initial values for aice, aicen, vicen, vsnon use ice_state, only: aice, aicen, aice_init, aicen_init, & - vicen, vicen_init, vsnon, vsnon_init + vicen, vicen_init, vsnon, vsnon_init, trcrn, Tsfcn_init + + integer (kind=int_kind) :: & + nt_Tsfc ! Tsfc index in trcrn character(len=*), parameter :: subname = '(save_init)' @@ -70,10 +73,13 @@ subroutine save_init ! Save the initial ice area and volume in each category. !----------------------------------------------------------------- + call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc) + aice_init = aice aicen_init = aicen vicen_init = vicen vsnon_init = vsnon + Tsfcn_init = trcrn(:,:,nt_Tsfc,:,:) end subroutine save_init @@ -222,7 +228,8 @@ 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, meltsliqn, meltsliq, & - fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswthrun_uvrdr, fswthrun_uvrdf, fswthrun_pardr, fswthrun_pardf use ice_calendar, only: yday use ice_domain_size, only: ncat, nilyr, nslyr, n_iso, n_aero, nfsd use ice_flux, only: frzmlt, sst, Tf, strocnxT_iavg, strocnyT_iavg, rsiden, fbot, Tbot, Tsnice, & @@ -232,12 +239,14 @@ subroutine step_therm1 (dt, iblk) frain, Tair, strairxT, strairyT, fsurf, fcondtop, fsens, & flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + fswthru_uvrdr, fswthru_uvrdf, fswthru_pardr, fswthru_pardf, & meltt, melts, meltb, congel, snoice, & flatn_f, fsensn_f, fsurfn_f, fcondtopn_f, & + dfsurfndts_f, dflatndts_f, & send_i2x_per_cat, fswthrun_ai, dsnow 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 - use ice_grid, only: lmask_n, lmask_s, tmask + use ice_grid, only: lmask_n, lmask_s, tmask, opmask use ice_state, only: aice, aicen, aicen_init, vicen_init, & vice, vicen, vsno, vsnon, trcrn, vsnon_init #ifdef CICE_IN_NEMO @@ -387,7 +396,7 @@ subroutine step_therm1 (dt, iblk) enddo endif ! tr_aero - if (tmask(i,j,iblk)) then + if (tmask(i,j,iblk) .or. opmask(i,j,iblk)) then call icepack_step_therm1(dt=dt, & aicen_init = aicen_init (i,j,:,iblk), & @@ -484,6 +493,10 @@ subroutine step_therm1 (dt, iblk) fswthrun_vdf = fswthrun_vdf (i,j,:,iblk),& fswthrun_idr = fswthrun_idr (i,j,:,iblk),& fswthrun_idf = fswthrun_idf (i,j,:,iblk),& + fswthrun_uvrdr = fswthrun_uvrdr (i,j,:,iblk),& + fswthrun_uvrdf = fswthrun_uvrdf (i,j,:,iblk),& + fswthrun_pardr = fswthrun_pardr (i,j,:,iblk),& + fswthrun_pardf = fswthrun_pardf (i,j,:,iblk),& fswabs = fswabs (i,j, iblk), & flwout = flwout (i,j, iblk), & Sswabsn = Sswabsn (i,j,:,:,iblk), & @@ -504,10 +517,16 @@ subroutine step_therm1 (dt, iblk) fswthru_vdf = fswthru_vdf (i,j, iblk), & fswthru_idr = fswthru_idr (i,j, iblk), & fswthru_idf = fswthru_idf (i,j, iblk), & + fswthru_uvrdr = fswthru_uvrdr (i,j, iblk), & + fswthru_uvrdf = fswthru_uvrdf (i,j, iblk), & + fswthru_pardr = fswthru_pardr (i,j, iblk), & + fswthru_pardf = fswthru_pardf (i,j, iblk), & flatn_f = flatn_f (i,j,:,iblk), & fsensn_f = fsensn_f (i,j,:,iblk), & fsurfn_f = fsurfn_f (i,j,:,iblk), & fcondtopn_f = fcondtopn_f (i,j,:,iblk), & + dfsurfdT = dfsurfndTs_f(i,j,:,iblk), & + dflatdT = dflatndTs_f (i,j,:,iblk), & faero_atm = faero_atm (i,j,1:n_aero,iblk), & faero_ocn = faero_ocn (i,j,1:n_aero,iblk), & fiso_atm = fiso_atm (i,j,:,iblk), & @@ -620,7 +639,7 @@ subroutine step_therm2 (dt, iblk) meltl, frazil_diag use ice_flux_bgc, only: flux_bio, faero_ocn, & fiso_ocn, HDO_ocn, H2_16O_ocn, H2_18O_ocn - use ice_grid, only: tmask + use ice_grid, only: tmask, opmask use ice_state, only: aice, aicen, aice0, trcr_depend, & aicen_init, vicen_init, trcrn, vicen, vsnon, & trcr_base, n_trcr_strata, nt_strata @@ -672,7 +691,7 @@ subroutine step_therm2 (dt, iblk) do j = jlo, jhi do i = ilo, ihi - if (tmask(i,j,iblk)) then + if (tmask(i,j,iblk) .or. opmask(i,j,iblk)) then ! significant wave height for FSD if (tr_fsd) & @@ -1260,13 +1279,15 @@ subroutine step_radiation (dt, iblk) use ice_arrays_column, only: ffracn, dhsn, & fswsfcn, fswintn, fswpenln, Sswabsn, Iswabsn, & fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswthrun_uvrdr, fswthrun_uvrdf, fswthrun_pardr, fswthrun_pardf, & albicen, albsnon, albpndn, & alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, & swgrid, igrid use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, msec use ice_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr - use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow - use ice_grid, only: TLAT, TLON, tmask + use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow, & + swuvrdr, swuvrdf, swpardr, swpardf + use ice_grid, only: TLAT, TLON, tmask, opmask use ice_state, only: aicen, vicen, vsnon, trcrn use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw use ice_communicate, only: my_task @@ -1367,7 +1388,7 @@ subroutine step_radiation (dt, iblk) endif enddo - if (tmask(i,j,iblk)) then + if (tmask(i,j,iblk) .or. opmask(i,j,iblk)) then call icepack_step_radiation (dt=dt, & fbri=fbri(:), & @@ -1390,6 +1411,8 @@ subroutine step_radiation (dt, iblk) sec=msec, & swvdr =swvdr (i,j ,iblk), swvdf =swvdf (i,j ,iblk), & swidr =swidr (i,j ,iblk), swidf =swidf (i,j ,iblk), & + swuvrdr =swuvrdr (i,j ,iblk), swuvrdf =swuvrdf (i,j ,iblk), & + swpardr =swpardr (i,j ,iblk), swpardf =swpardf (i,j ,iblk), & coszen =coszen (i,j ,iblk), fsnow =fsnow (i,j ,iblk), & alvdrn =alvdrn (i,j,: ,iblk), alvdfn =alvdfn (i,j,: ,iblk), & alidrn =alidrn (i,j,: ,iblk), alidfn =alidfn (i,j,: ,iblk), & @@ -1399,7 +1422,11 @@ subroutine step_radiation (dt, 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), & + fswthrun_uvrdr =fswthrun_uvrdr (i,j,: ,iblk), & + fswthrun_uvrdf =fswthrun_uvrdf (i,j,: ,iblk), & + fswthrun_pardr =fswthrun_pardr (i,j,: ,iblk), & + fswthrun_pardf =fswthrun_pardf (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/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index 301120108..bc4cc5302 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -81,6 +81,7 @@ module ice_domain distribution_wght ! method for weighting work per block ! 'block' = POP default configuration ! 'blockall' = no land block elimination + ! 'blockfull'= blockall but all blocks get full weight ! 'latitude' = no. ocean points * |lat| ! 'file' = read distribution_wgth_file character (char_len_long) :: & @@ -95,7 +96,7 @@ module ice_domain !*********************************************************************** - subroutine init_domain_blocks + subroutine init_domain_blocks(npes, blkx, blky) ! This routine reads in domain information and calls the routine ! to set up the block decomposition. @@ -104,6 +105,10 @@ subroutine init_domain_blocks use ice_domain_size, only: ncat, nilyr, nslyr, max_blocks, & nx_global, ny_global, block_size_x, block_size_y use ice_fileunits, only: goto_nml + + integer (int_kind), intent(in), optional :: & + npes, blkx, blky ! set block from outside + !---------------------------------------------------------------------- ! ! local variables @@ -202,6 +207,11 @@ subroutine init_domain_blocks close(nu_nml) call release_fileunit(nu_nml) + ! override if passed in + if (present(npes)) nprocs = npes + if (present(blkx)) block_size_x = blkx + if (present(blky)) block_size_y = blky + endif call broadcast_scalar(nprocs, master_task) @@ -476,7 +486,8 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) flat = 1 endif - if (distribution_wght == 'blockall') landblockelim = .false. + if (distribution_wght == 'blockall' ) landblockelim = .false. + if (distribution_wght == 'blockfull') landblockelim = .false. allocate(nocn(nblocks_tot)) @@ -579,8 +590,10 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) #ifdef CICE_IN_NEMO ! Keep all blocks even the ones only containing land points + ! tcraig, use 'blockfull', get rid of the CPP, keep for backwards compatibility for now if (distribution_wght == 'block') nocn(n) = nx_block*ny_block #else + if (distribution_wght == 'blockfull') nocn(n) = nx_block*ny_block if (distribution_wght == 'block' .and. nocn(n) > 0) nocn(n) = nx_block*ny_block if (.not. landblockelim) nocn(n) = max(nocn(n),1) #endif diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index c13c58db6..e577b7d8a 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -108,7 +108,7 @@ module ice_grid ANGLE , & ! for conversions between POP grid and lat/lon ANGLET , & ! ANGLE converted to T-cells, valid in halo bathymetry , & ! ocean depth, for grounding keels and bergs (m) - ocn_gridcell_frac ! only relevant for lat-lon grids + ocn_gridcell_frac ! ocean gridcell fraction ! gridcell value of [1 - (land fraction)] (T-cell) real (kind=dbl_kind), dimension (:,:), allocatable, public :: & @@ -161,6 +161,7 @@ module ice_grid umaskCD, & ! land/boundary mask (U-cell) (1 if at least two surrounding T cells are ocean) nmask , & ! land/boundary mask, (N-cell) emask , & ! land/boundary mask, (E-cell) + opmask , & ! land/boundary orphan mask, ocean cells in atmosphere but not ocean/ice lmask_n, & ! northern hemisphere mask lmask_s ! southern hemisphere mask @@ -237,6 +238,7 @@ subroutine alloc_grid umaskCD (nx_block,ny_block,max_blocks), & ! land/boundary mask, velocity (U-cell) nmask (nx_block,ny_block,max_blocks), & ! land/boundary mask (N-cell) emask (nx_block,ny_block,max_blocks), & ! land/boundary mask (E-cell) + opmask (nx_block,ny_block,max_blocks), & ! land/boundary orphan mask (atm ocean/ice cell) lmask_n (nx_block,ny_block,max_blocks), & ! northern hemisphere mask lmask_s (nx_block,ny_block,max_blocks), & ! southern hemisphere mask rndex_global(nx_block,ny_block,max_blocks), & ! global index for local subdomain (dbl) @@ -251,6 +253,8 @@ subroutine alloc_grid stat=ierr) if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory1', file=__FILE__, line=__LINE__) + ocn_gridcell_frac(:,:,:) = c0 + if (save_ghte_ghtn) then if (my_task == master_task) then allocate( & @@ -359,7 +363,8 @@ subroutine init_grid1 if (trim(grid_type) == 'displaced_pole' .or. & trim(grid_type) == 'tripole' .or. & - trim(grid_type) == 'regional' ) then + trim(grid_type) == 'regional' .or. & + trim(grid_type) == 'geosmom' ) then ! Fill ULAT select case(trim(grid_format)) @@ -541,6 +546,13 @@ subroutine init_grid2 case default call popgrid ! read POP grid lengths directly end select + elseif (trim(grid_type) == 'geosmom') then + if (trim(grid_format) == 'nc') then + call geosgrid_nc ! tripolar grid used for GEOS-MOM coupled nodel + else + call abort_ice(subname//'ERROR: binary format for GEOS-MOM grid not supported', & + file=__FILE__, line=__LINE__) + endif #ifdef CESMCOUPLED elseif (trim(grid_type) == 'latlon') then call latlongrid ! lat lon grid for sequential CESM (CAM mode) @@ -1523,10 +1535,10 @@ subroutine mom_grid ! populate angle fields, angle is u-points, angleT is t-points ! even though mom supergrid files contain angle_dx, mom6 calculates internally - call grid_rotation_angle(G_ULON, G_ULAT, G_TLON(1:nx_global,1:ny_global), work_g1) ! anglet + call mom_grid_rotation_angle(G_ULON, G_ULAT, G_TLON(1:nx_global,1:ny_global), work_g1) ! anglet call scatter_global(ANGLET, work_g1, master_task, distrb_info, & field_loc_center, field_type_angle) - call grid_rotation_angle(G_TLON, G_TLAT, G_ULON(2:nx_global+1,2:ny_global+1), work_g1) ! angle + call mom_grid_rotation_angle(G_TLON, G_TLAT, G_ULON(2:nx_global+1,2:ny_global+1), work_g1) ! angle call scatter_global(ANGLE, work_g1, master_task, distrb_info, & field_loc_NEcorner, field_type_angle) @@ -2098,7 +2110,7 @@ end subroutine mom_area !======================================================================= - subroutine grid_rotation_angle(lon_cnr, lat_cnr, lon_cen, angle) + subroutine mom_grid_rotation_angle(lon_cnr, lat_cnr, lon_cen, angle) ! create angles in the same way mom6 creates the angle ! based on https://github.com/mom-ocean/MOM6/blob/129e1bda02d454fb280819d1d87ae16347fd044c/src/initialization/MOM_shared_initialization.F90#L535 ! the angle is between logical north on the grid and true north. @@ -2118,7 +2130,7 @@ subroutine grid_rotation_angle(lon_cnr, lat_cnr, lon_cen, angle) lonB(2,2) integer (kind=int_kind) :: i, j, m, n - character(len=*), parameter :: subname = '(grid_rotation_angle)' + character(len=*), parameter :: subname = '(mom_grid_rotation_angle)' if (my_task == master_task) then len_lon = maxval(lon_cnr)-minval(lon_cnr) ! The periodic range of longitudes, usually 2pi. @@ -2139,7 +2151,189 @@ subroutine grid_rotation_angle(lon_cnr, lat_cnr, lon_cen, angle) enddo endif - end subroutine grid_rotation_angle + end subroutine mom_grid_rotation_angle + +!======================================================================= +! GEOS MOM grid +! Grid record number, field and units are: \\ +! (1) ULAT (radians) \\ +! (2) ULON (radians) \\ +! (3) ANGLE (radians) \\ +! (4) ANGLET (radians) \\ +! (5) HTN (cm) \\ +! (6) HTE (cm) \\ +! +! Land mask record number and field is (1) KMT. +! + + subroutine geosgrid_nc + + use ice_blocks, only: nx_block, ny_block + use ice_constants, only: c0, c1, & + field_loc_center, field_loc_NEcorner, & + field_type_scalar, field_type_angle + use ice_domain_size, only: max_blocks +#ifdef USE_NETCDF + use netcdf +#endif + + integer (kind=int_kind) :: & + i, j, iblk, & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + fid_grid, & ! file id for netCDF grid file + fid_kmt ! file id for netCDF kmt file + + logical (kind=log_kind) :: diag + + character (char_len) :: & + fieldname ! field name in netCDF file + + real (kind=dbl_kind) :: & + pi, puny + + real (kind=dbl_kind), dimension(:,:), allocatable :: & + work_g1 + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + work1 + + type (block) :: & + this_block ! block information for current block + + integer(kind=int_kind) :: & + varid + integer (kind=int_kind) :: & + status ! status flag + + + character(len=*), parameter :: subname = '(geosgrid_nc)' + +#ifdef USE_NETCDF + call icepack_query_parameters(pi_out=pi, puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_open_nc(grid_file,fid_grid) + call ice_open_nc(kmt_file,fid_kmt) + + diag = .true. ! write diagnostic info + l_readCenter = .false. + !----------------------------------------------------------------- + ! topography + !----------------------------------------------------------------- + + fieldname='kmt' + call ice_read_nc(fid_kmt,1,fieldname,work1,diag, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + hm (:,:,:) = c0 + kmt(:,:,:) = c0 + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + 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 + kmt(i,j,iblk) = work1(i,j,iblk) + if (kmt(i,j,iblk) >= c1) hm(i,j,iblk) = c1 + ! set grid cells which are MOM ocean but land in GEOS to land + if (ocn_gridcell_frac(i,j,iblk) < puny) then + kmt(i,j,iblk) = c0 + hm(i,j,iblk) = c0 + endif + enddo + enddo + enddo + !$OMP END PARALLEL DO + + !----------------------------------------------------------------- + ! lat, lon, angle + !----------------------------------------------------------------- + + allocate(work_g1(nx_global,ny_global)) + + fieldname='ulat' + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! ULAT + call gridbox_verts(work_g1,latt_bounds) + call scatter_global(ULAT, work_g1, master_task, distrb_info, & + field_loc_NEcorner, field_type_scalar) + call ice_HaloExtrapolate(ULAT, distrb_info, & + ew_boundary_type, ns_boundary_type) + + fieldname='ulon' + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! ULON + call gridbox_verts(work_g1,lont_bounds) + call scatter_global(ULON, work_g1, master_task, distrb_info, & + field_loc_NEcorner, field_type_scalar) + call ice_HaloExtrapolate(ULON, distrb_info, & + ew_boundary_type, ns_boundary_type) + + fieldname='angle' + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! ANGLE + call scatter_global(ANGLE, work_g1, master_task, distrb_info, & + field_loc_NEcorner, field_type_angle) + ! fix ANGLE: roundoff error due to single precision + where (ANGLE > pi) ANGLE = pi + where (ANGLE < -pi) ANGLE = -pi + + ! if grid file includes anglet then read instead + fieldname='anglet' + if (my_task == master_task) then + status = nf90_inq_varid(fid_grid, trim(fieldname) , varid) + if (status /= nf90_noerr) then + write(nu_diag,*) subname//' CICE will calculate angleT, TLON and TLAT' + else + write(nu_diag,*) subname//' angleT, TLON and TLAT is read from grid file' + l_readCenter = .true. + endif + endif + call broadcast_scalar(l_readCenter,master_task) + if (l_readCenter) then + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(ANGLET, work_g1, master_task, distrb_info, & + field_loc_center, field_type_angle) + where (ANGLET > pi) ANGLET = pi + where (ANGLET < -pi) ANGLET = -pi + fieldname="tlon" + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(TLON, work_g1, master_task, distrb_info, & + field_loc_center, field_type_scalar) + fieldname="tlat" + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(TLAT, work_g1, master_task, distrb_info, & + field_loc_center, field_type_scalar) + endif + !----------------------------------------------------------------- + ! cell dimensions + ! calculate derived quantities from global arrays to preserve + ! information on boundaries + !----------------------------------------------------------------- + + fieldname='htn' + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! HTN + call primary_grid_lengths_HTN(work_g1) ! dxu, dxt + fieldname='hte' + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! HTE + call primary_grid_lengths_HTE(work_g1) ! dyu, dyt + + deallocate(work_g1) + + if (my_task == master_task) then + call ice_close_nc(fid_grid) + call ice_close_nc(fid_kmt) + endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + + end subroutine geosgrid_nc !======================================================================= @@ -2970,6 +3164,8 @@ subroutine makemask field_loc_Eface, field_type_scalar) call ice_HaloUpdate (bm, halo_info, & field_loc_center, field_type_scalar) + call ice_HaloUpdate (ocn_gridcell_frac, halo_info, & + field_loc_center, field_type_scalar) call ice_timer_stop(timer_bound) !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) @@ -2986,6 +3182,7 @@ subroutine makemask umaskCD(:,:,iblk) = .false. nmask(:,:,iblk) = .false. emask(:,:,iblk) = .false. + opmask(:,:,iblk) = .false. do j = jlo-nghost, jhi+nghost do i = ilo-nghost, ihi+nghost if ( hm(i,j,iblk) > p5 ) tmask (i,j,iblk) = .true. @@ -2993,6 +3190,8 @@ subroutine makemask if (uvmCD(i,j,iblk) > c1p5) umaskCD(i,j,iblk) = .true. if (npm(i,j,iblk) > p5 ) nmask (i,j,iblk) = .true. if (epm(i,j,iblk) > p5 ) emask (i,j,iblk) = .true. + if (ocn_gridcell_frac(i,j,iblk) > puny .and. .not. tmask(i,j,iblk)) & + opmask(i,j,iblk) = .true. enddo enddo diff --git a/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 b/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 index dd9d77807..8f11f7f5e 100644 --- a/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 @@ -29,6 +29,7 @@ module ice_restart_driver use ice_restart use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag, nu_rst_pointer, nu_restart, nu_dump + use ice_grid, only: tmask, opmask, grid_ice, grid_average_X2Y use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes @@ -64,11 +65,10 @@ subroutine dumpfile(filename_spec) stresspT, stressmT, stress12T, & stresspU, stressmU, stress12U use ice_flux, only: coszen - use ice_grid, only: grid_ice, tmask use ice_state, only: aicen, vicen, vsnon, trcrn, uvel, vvel, & uvelE, vvelE, uvelN, vvelN - character(len=char_len_long), intent(in), optional :: filename_spec + character(len=*), intent(in), optional :: filename_spec ! local variables @@ -92,7 +92,7 @@ subroutine dumpfile(filename_spec) file=__FILE__, line=__LINE__) if (present(filename_spec)) then - call init_restart_write(filename_spec) + call init_restart_write(filename_spec=filename_spec) else call init_restart_write endif @@ -107,7 +107,7 @@ subroutine dumpfile(filename_spec) do iblk = 1, nblocks do j = 1, ny_block do i = 1, nx_block - if (.not. tmask(i,j,iblk)) trcrn(i,j,:,:,iblk) = c0 + if (.not.tmask(i,j,iblk) .and. .not.opmask(i,j,iblk)) trcrn(i,j,:,:,iblk) = c0 enddo enddo enddo @@ -281,7 +281,7 @@ subroutine restartfile (ice_ic) use ice_boundary, only: ice_HaloUpdate_stress use ice_blocks, only: nghost, nx_block, ny_block use ice_calendar, only: istep0, npt, calendar - use ice_domain, only: nblocks, halo_info + use ice_domain, only: nblocks, halo_info, ns_boundary_type use ice_domain_size, only: nilyr, nslyr, ncat, & max_blocks use ice_dyn_shared, only: iceUmask, iceEmask, iceNmask,kdyn @@ -293,7 +293,6 @@ subroutine restartfile (ice_ic) stresspT, stressmT, stress12T, & stresspU, stressmU, stress12U use ice_flux, only: coszen, Tf - use ice_grid, only: tmask, grid_type, grid_ice, grid_average_X2Y use ice_state, only: trcr_depend, aice, vice, vsno, trcr, & aice0, aicen, vicen, vsnon, trcrn, aice_init, uvel, vvel, & uvelE, vvelE, uvelN, vvelN, & @@ -498,7 +497,8 @@ subroutine restartfile (ice_ic) 'stress12U',1,diag,field_loc_NEcorner,field_type_scalar) ! stress12U endif - if (trim(grid_type) == 'tripole') then + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then call ice_HaloUpdate_stress(stressp_1, stressp_3, halo_info, & field_loc_center, field_type_scalar) call ice_HaloUpdate_stress(stressp_3, stressp_1, halo_info, & @@ -608,7 +608,7 @@ subroutine restartfile (ice_ic) do iblk = 1, nblocks do j = 1, ny_block do i = 1, nx_block - if (.not. tmask(i,j,iblk)) trcrn(i,j,nt_Tsfc,:,iblk) = c0 + if (.not.tmask(i,j,iblk) .and. .not.opmask(i,j,iblk)) trcrn(i,j,nt_Tsfc,:,iblk) = c0 enddo enddo enddo @@ -685,7 +685,7 @@ subroutine restartfile (ice_ic) do j = 1, ny_block do i = 1, nx_block - if (tmask(i,j,iblk)) & + if (tmask(i,j,iblk) .or. opmask(i,j,iblk)) & call icepack_aggregate(aicen = aicen(i,j,:,iblk), & trcrn = trcrn(i,j,:,:,iblk), & vicen = vicen(i,j,:,iblk), & @@ -740,7 +740,6 @@ subroutine restartfile_v4 (ice_ic) stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 use ice_gather_scatter, only: scatter_global_stress - use ice_grid, only: tmask use ice_read_write, only: ice_open, ice_read, ice_read_global use ice_state, only: trcr_depend, aice, vice, vsno, trcr, & aice0, aicen, vicen, vsnon, trcrn, aice_init, uvel, vvel, & @@ -1052,7 +1051,7 @@ subroutine restartfile_v4 (ice_ic) do j = 1, ny_block do i = 1, nx_block - if (tmask(i,j,iblk)) & + if (tmask(i,j,iblk) .or. opmask(i,j,iblk)) & call icepack_aggregate(aicen = aicen(i,j,:,iblk), & trcrn = trcrn(i,j,:,:,iblk), & vicen = vicen(i,j,:,iblk), & diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 index 5866d7130..d8931866a 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 @@ -384,7 +384,7 @@ subroutine init_restart_write(filename_spec) use ice_dyn_shared, only: kdyn use ice_read_write, only: ice_open, ice_open_ext - character(len=char_len_long), intent(in), optional :: filename_spec + character(len=*), intent(in), optional :: filename_spec ! local variables diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index 0f9070fef..7e7841fae 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -156,7 +156,7 @@ subroutine init_restart_write(filename_spec) use ice_arrays_column, only: oceanmixed_ice use ice_grid, only: grid_ice - character(len=char_len_long), intent(in), optional :: filename_spec + character(len=*), intent(in), optional :: filename_spec ! local variables diff --git a/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 b/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 new file mode 100644 index 000000000..056832fed --- /dev/null +++ b/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 @@ -0,0 +1,150 @@ +!======================================================================= +! +! 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 + use ice_communicate, only: my_task, master_task + use ice_exit, only: end_run, abort_ice + use ice_fileunits, only: nu_diag, release_all_fileunits + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes + + implicit none + private + public :: CICE_Finalize, ice_checkpoint + +!======================================================================= + + contains + +!======================================================================= +! +! This routine shuts down CICE by exiting all relevent environments. + + subroutine CICE_Finalize + + use ice_restart_shared, only: runid + use ice_timers, only: ice_timer_stop, ice_timer_print_all, timer_total + + character(len=*), parameter :: subname = '(CICE_Finalize)' + + + call ice_checkpoint + + !------------------------------------------------------------------- + ! 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 + + !------------------------------------------------------------------- + ! quit MPI + !------------------------------------------------------------------- + +! standalone +! call end_run ! quit MPI + + end subroutine CICE_Finalize + +!======================================================================= + +!======================================================================= + subroutine ice_checkpoint(time_stamp) + + use ice_boundary, only: ice_HaloUpdate + use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep + use ice_calendar, only: idate, msec + use ice_domain, only: halo_info, nblocks + use ice_dyn_shared, only: kdyn, kridge + use ice_dyn_eap, only: write_restart_eap + use ice_restart, only: final_restart + use ice_restart_shared, only: & + restart_ext, restart_dir, restart_file, pointer_file, & + runid, use_restart_time, lenstr, restart_coszen + use ice_restart_column, only: write_restart_age, write_restart_FY, & + write_restart_lvl, write_restart_pond_lvl, & + write_restart_pond_topo, write_restart_aero, write_restart_fsd, & + write_restart_iso, write_restart_bgc, write_restart_hbrine, & + write_restart_snow + use ice_restart_driver, only: dumpfile + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_readwrite + use ice_communicate, only: MPI_COMM_ICE + + + character(len=*), intent(in), optional :: & + time_stamp + + integer (kind=int_kind) :: & + iblk , & ! block index + k , & ! dynamics supercycling index + ktherm ! thermodynamics is off when ktherm = -1 + + real (kind=dbl_kind) :: & + offset ! d(age)/dt time offset + + character(len=char_len_long) :: filename + + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & + tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & + calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + + character(len=*), parameter :: subname = '(ice_checkpoint)' + + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & + solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & + wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_start(timer_readwrite) ! reading/writing + + if(present(time_stamp)) then + filename = trim(restart_dir) // trim(restart_file) // '.' // trim(time_stamp) + else + filename = trim(restart_dir) // trim(restart_file) + endif + + call dumpfile(filename_spec=trim(filename)) ! 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_snow) call write_restart_snow + if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso + if (tr_aero) call write_restart_aero + if (solve_zsal .or. skl_bgc .or. z_tracers) & + call write_restart_bgc + if (tr_brine) call write_restart_hbrine + if (kdyn == 2) call write_restart_eap + call final_restart + + call ice_timer_stop(timer_readwrite) ! reading/writing + + end subroutine ice_checkpoint + + end module CICE_FinalMod + +!======================================================================= diff --git a/cicecore/drivers/mapl/geos/CICE_InitMod.F90 b/cicecore/drivers/mapl/geos/CICE_InitMod.F90 new file mode 100644 index 000000000..18b5dfbbb --- /dev/null +++ b/cicecore/drivers/mapl/geos/CICE_InitMod.F90 @@ -0,0 +1,529 @@ +module CICE_InitMod + + ! Initialize CICE model. + + use ice_kinds_mod + use ice_exit , only: abort_ice + use ice_fileunits, only: init_fileunits, nu_diag + use icepack_intfc, only: icepack_aggregate + use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist + use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation + use icepack_intfc, only: icepack_configure + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags + use icepack_intfc, only: icepack_init_parameters + use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes + + implicit none + private + public :: cice_init1 + public :: cice_init2 + public :: cice_delayed_init + public :: cice_cal_init + + private :: init_restart + +!======================================================================= +contains +!======================================================================= + + subroutine cice_init1(mpi_comm, npes, blkx, blky, dtg, k2c, alhl, alhs) + + ! Initialize the basic state, grid and all necessary parameters for + ! running the CICE model. + + use ice_init , only: input_data + use ice_communicate , only: init_communicate, my_task, master_task + use ice_init_column , only: input_zbgc, count_tracers + use ice_grid , only: init_grid1, alloc_grid + use ice_calendar , only: set_time_step + use ice_domain , only: init_domain_blocks + use ice_arrays_column , only: alloc_arrays_column + use ice_state , only: alloc_state + !use ice_dyn_shared , only: alloc_dyn_shared + use ice_flux_bgc , only: alloc_flux_bgc + use ice_flux , only: alloc_flux + use ice_timers , only: timer_total, init_ice_timers, ice_timer_start + + integer (kind=int_kind), intent(in) :: & + mpi_comm ! communicator for sequential geos + + integer (kind=int_kind), intent(in) :: & + npes, blkx, blky, dtg ! + + real(kind=real_kind), intent(in) :: & + k2c, alhl, alhs ! + + character(len=*), parameter :: subname = '(cice_init1)' + !---------------------------------------------------- + call init_communicate(mpi_comm) ! initial setup for message passing + + call init_fileunits ! unit numbers + call icepack_init_parameters(Tffresh_in = real(k2c, kind=dbl_kind)) + call icepack_init_parameters(Lvap_in = real(alhl, kind=dbl_kind)) + call icepack_init_parameters(Lsub_in = real(alhs, kind=dbl_kind)) + call icepack_configure() ! initialize icepack + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + call input_data ! namelist variables + call set_time_step(dtg) ! reset time step from coupler + call input_zbgc ! vertical biogeochemistry namelist + call count_tracers ! count tracers + + call init_domain_blocks(npes, blkx, blky) ! set up block decomposition + call init_grid1 ! domain distribution + call alloc_grid ! allocate grid arrays + call alloc_arrays_column ! allocate column arrays + call alloc_state ! allocate state arrays + !call alloc_dyn_shared ! allocate dyn shared arrays + call alloc_flux_bgc ! allocate flux_bgc arrays + call alloc_flux ! allocate flux arrays + call init_ice_timers ! initialize all timers + call ice_timer_start(timer_total) ! start timing entire run + + end subroutine cice_init1 + + subroutine cice_delayed_init + + ! Initialize the basic state, and all necessary parameters for + ! running the CICE model. + + use ice_grid , only: init_grid2 + + character(len=*), parameter :: subname = '(cice_delayed_init)' + !---------------------------------------------------- + + call init_grid2 ! finish building grid + + end subroutine cice_delayed_init + + subroutine cice_cal_init(yr, mo, dy, hr, mn, sc) + + ! Initialize the basic state, and all necessary parameters for + ! running the CICE model. + + use ice_calendar , only: dt, dt_dyn, istep, istep1, write_ic, init_calendar, calendar + + character(len=*), parameter :: subname = '(cice_delayed_init)' + !---------------------------------------------------- + + integer (kind=int_kind), intent(in) :: & + yr, mo, dy, hr, mn, sc + + call init_calendar(yr, mo, dy, hr, mn, sc) ! initialize some calendar stuff + + end subroutine cice_cal_init + + !======================================================================= + subroutine cice_init2!(yr, mo, dy, hr, mn, sc) + + ! Initialize the basic state, and all necessary parameters for + ! running the CICE model. + + use ice_grid , only: init_grid2 + use ice_arrays_column , only: hin_max, c_hi_range + use ice_arrays_column , only: floe_rad_l, floe_rad_c, floe_binwidth, c_fsd_range + use ice_calendar , only: dt, dt_dyn, istep, istep1, write_ic, init_calendar, calendar + use ice_communicate , only: my_task, master_task + use ice_diagnostics , only: init_diags + use ice_domain_size , only: ncat, nfsd + !use ice_dyn_eap , only: init_eap, alloc_dyn_eap + use ice_dyn_eap , only: init_eap + use ice_dyn_evp , only: init_evp + !use ice_dyn_shared , only: kdyn, init_dyn + use ice_dyn_shared , only: kdyn + use ice_grid , only: dealloc_grid + use ice_dyn_vp , only: init_vp + use ice_flux , only: init_coupler_flux, init_history_therm + use ice_flux , only: init_history_dyn, init_flux_atm, init_flux_ocn + use ice_forcing , only: init_snowtable + use ice_forcing_bgc , only: get_forcing_bgc, get_atm_bgc + use ice_forcing_bgc , only: faero_default, alloc_forcing_bgc, fiso_default + use ice_history , only: init_hist, accum_hist + use ice_restart_shared , only: restart, runtype + use ice_init , only: input_data, init_state + use ice_init_column , only: init_thermo_vertical, init_shortwave, init_zbgc + use ice_restoring , only: ice_HaloRestore_init + use ice_timers , only: timer_total, init_ice_timers, ice_timer_start + use ice_transport_driver , only: init_transport + + + ! integer (kind=int_kind), intent(in) :: & + ! yr, mo, dy, hr, mn, sc + + logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers + logical(kind=log_kind) :: tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table + character(len=*), parameter :: subname = '(cice_init2)' + !---------------------------------------------------- + + call init_grid2 ! finish building grid + call init_zbgc ! vertical biogeochemistry initialization + !call init_calendar(yr, mo, dy, hr, mn, sc) ! initialize some calendar stuff + call init_hist (dt) ! initialize output history file + + !call init_dyn (dt_dyn) ! define dynamics parameters, variables + if (kdyn == 1) then + call init_evp ! define evp dynamics parameters, variables + else if (kdyn == 2) then + !call alloc_dyn_eap ! allocate dyn_eap arrays + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables + endif + + call init_coupler_flux ! initialize fluxes exchanged with coupler + call init_thermo_vertical ! initialize vertical thermodynamics + + call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution + if (my_task == master_task) then + call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output + endif + + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (tr_fsd) call icepack_init_fsd_bounds (nfsd, & ! floe size distribution + floe_rad_l, & ! fsd size lower bound in m (radius) + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth, & ! fsd size bin width in m (radius) + c_fsd_range, & ! string for history output + write_diags=(my_task == master_task)) ! write diag on master only + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call calendar() ! determine the initial date + + call init_state ! initialize the ice state + call init_transport ! initialize horizontal transport + call ice_HaloRestore_init ! restored boundary conditions + + call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & + wave_spec_out=wave_spec, snw_aging_table_out=snw_aging_table) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (skl_bgc .or. z_tracers) call alloc_forcing_bgc ! allocate biogeochemistry arrays + + 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 + call icepack_init_radiation ! initialize icepack shortwave tables + + call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + ! snow aging lookup table initialization + if (tr_snow) then ! advanced snow physics + call icepack_init_snow() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + if (snw_aging_table(1:4) /= 'test') then + call init_snowtable() + endif + endif + + ! 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) then + call init_shortwave ! initialize radiative transfer + end if + + !-------------------------------------------------------------------- + ! coupler communication or forcing data initialization + !-------------------------------------------------------------------- + + if (z_tracers) call get_atm_bgc ! biogeochemistry + + if (runtype == 'initial' .and. .not. restart) then + call init_shortwave ! initialize radiative transfer using current swdn + end if + + call init_flux_atm ! initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + if (write_ic) then + call accum_hist(dt) ! write initial conditions + end if + + call dealloc_grid ! deallocate temporary grid arrays + + end subroutine cice_init2 + + !======================================================================= + + subroutine init_restart() + + use ice_arrays_column, only: dhsn + use ice_blocks, only: nx_block, ny_block + use ice_calendar, only: calendar + use ice_constants, only: c0 + use ice_domain, only: nblocks + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr + use ice_dyn_eap, only: read_restart_eap + use ice_dyn_shared, only: kdyn + use ice_flux, only: Tf + use ice_grid, only: tmask, opmask + use ice_init, only: ice_ic + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & + init_meltponds_lvl, init_meltponds_topo, & + init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd + use ice_restart_column, only: restart_age, read_restart_age, & + restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & + restart_pond_lvl, read_restart_pond_lvl, & + restart_pond_topo, read_restart_pond_topo, & + restart_snow, read_restart_snow, & + restart_fsd, read_restart_fsd, & + restart_iso, read_restart_iso, & + restart_aero, read_restart_aero, & + restart_hbrine, read_restart_hbrine, & + restart_bgc + use ice_restart_driver, only: restartfile + use ice_restart_shared, only: runtype, restart + use ice_state ! almost everything + + integer(kind=int_kind) :: & + i, j , & ! horizontal indices + iblk ! block index + logical(kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_pond_cesm, tr_pond_lvl, & + tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, tr_snow, & + skl_bgc, z_tracers + integer(kind=int_kind) :: & + ntrcr + integer(kind=int_kind) :: & + nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice + + character(len=*), parameter :: subname = '(init_restart)' + !---------------------------------------------------- + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_parameters(skl_bgc_out=skl_bgc, & + z_tracers_out=z_tracers) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (trim(runtype) == 'continue') then + ! start from core restart file + call restartfile() ! given by pointer in ice_in + call calendar() ! update time parameters + if (kdyn == 2) call read_restart_eap ! EAP + else if (restart) then ! ice_ic = core restart file + call restartfile (ice_ic) ! or 'default' or 'none' +!!! uncomment to create netcdf + ! 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 + + ! 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(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(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(iblk,trcrn(:,:,nt_alvl,:,iblk), & + trcrn(:,:,nt_vlvl,:,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(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(trcrn(:,:,nt_apnd,:,iblk), & + trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk)) + enddo ! iblk + endif ! .not. restart_pond + endif + ! snow redistribution/metamorphism + if (tr_snow) then + if (trim(runtype) == 'continue') restart_snow = .true. + if (restart_snow) then + call read_restart_snow + else + do iblk = 1, nblocks + call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), & + trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk)) + enddo ! iblk + endif + endif + + ! floe size distribution + if (tr_fsd) then + if (trim(runtype) == 'continue') restart_fsd = .true. + if (restart_fsd) then + call read_restart_fsd + else + call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) + endif + endif + ! isotopes + if (tr_iso) then + if (trim(runtype) == 'continue') restart_iso = .true. + if (restart_iso) then + call read_restart_iso + else + do iblk = 1, nblocks + call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & + trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) + enddo ! iblk + endif + endif + + if (tr_aero) then ! ice aerosol + if (trim(runtype) == 'continue') restart_aero = .true. + if (restart_aero) then + call read_restart_aero + else + do iblk = 1, nblocks + call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk)) + enddo ! iblk + endif ! .not. restart_aero + endif + + if (trim(runtype) == 'continue') then + if (tr_brine) & + restart_hbrine = .true. + if (skl_bgc .or. z_tracers) & + restart_bgc = .true. + endif + + if (tr_brine .or. skl_bgc) then ! brine height tracer + call init_hbrine + if (tr_brine .and. restart_hbrine) call read_restart_hbrine + endif + + if (skl_bgc .or. z_tracers) then ! biogeochemistry + if (tr_fsd) then + write (nu_diag,*) 'FSD implementation incomplete for use with BGC' + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + endif + call init_bgc + endif + + !----------------------------------------------------------------- + ! aggregate tracers + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + if (tmask(i,j,iblk) .or. opmask(i,j,iblk)) then + call icepack_aggregate(ncat = ncat, & + aicen = aicen(i,j,:,iblk), & + trcrn = trcrn(i,j,:,:,iblk), & + vicen = vicen(i,j,:,iblk), & + vsnon = vsnon(i,j,:,iblk), & + aice = aice (i,j, iblk), & + trcr = trcr (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vsno = vsno (i,j, iblk), & + aice0 = aice0(i,j, iblk), & + ntrcr = ntrcr, & + trcr_depend = trcr_depend, & + trcr_base = trcr_base, & + n_trcr_strata = n_trcr_strata, & + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) + else + ! tcraig, reset all tracer values on land to zero + trcrn(i,j,:,:,iblk) = c0 + endif + enddo + enddo + enddo + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + end subroutine init_restart + + !======================================================================= + +end module CICE_InitMod + +!======================================================================= diff --git a/cicecore/drivers/mapl/geos/CICE_RunMod.F90 b/cicecore/drivers/mapl/geos/CICE_RunMod.F90 new file mode 100644 index 000000000..ce7d7f361 --- /dev/null +++ b/cicecore/drivers/mapl/geos/CICE_RunMod.F90 @@ -0,0 +1,1304 @@ +!======================================================================= +! +! 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 ice_fileunits, only: nu_diag + use ice_arrays_column, only: oceanmixed_ice + use ice_domain_size, only: max_blocks, ncat, max_nstrm, nilyr + use ice_constants, only: c0, c1, c5, c10, c20, c180 + use ice_constants, only: field_loc_center, field_type_scalar + use ice_exit, only: abort_ice + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_max_iso, icepack_max_aero + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes + + implicit none + private + public :: CICE_Run, ice_step, ice_fast_physics, ice_radiation + +!======================================================================= + + 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_calendar, only: istep, istep1, dt, calendar, advance_timestep + use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & + get_wave_spec + use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & + fiso_default, faero_default + use ice_flux, only: init_flux_atm, init_flux_ocn + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_couple, timer_step + logical (kind=log_kind) :: & + tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd + character(len=*), parameter :: subname = '(CICE_Run)' + + !-------------------------------------------------------------------- + ! initialize error code and step timer + !-------------------------------------------------------------------- + + call ice_timer_start(timer_step) ! start timing entire run + + call icepack_query_parameters(skl_bgc_out=skl_bgc, & + z_tracers_out=z_tracers, & + wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, & + tr_zaero_out=tr_zaero, & + tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !-------------------------------------------------------------------- + ! timestep loop + !-------------------------------------------------------------------- + + !call ice_timer_start(timer_couple) ! atm/ocn coupling + + call advance_timestep() ! advance timestep and update calendar data + + !if (z_tracers) call get_atm_bgc ! biogeochemistry + + !call init_flux_atm ! Initialize atmosphere fluxes sent to coupler + !call init_flux_ocn ! initialize ocean fluxes sent to coupler + + !call ice_timer_stop(timer_couple) ! atm/ocn coupling + + call ice_step + + !-------------------------------------------------------------------- + ! 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_boundary, only: ice_HaloUpdate + use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep + use ice_calendar, only: idate, msec + use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice + use ice_diagnostics_bgc, only: hbrine_diags, bgc_diags + use ice_domain, only: halo_info, nblocks + use ice_dyn_eap, only: write_restart_eap + use ice_dyn_shared, only: kdyn, kridge + use ice_flux, only: scale_factor, init_history_therm, & + daidtt, daidtd, dvidtt, dvidtd, dvsdtt, dvsdtd, dagedtt, dagedtd + use ice_history, only: accum_hist + use ice_history_bgc, only: init_history_bgc + use ice_restart, only: final_restart + use ice_restart_column, only: write_restart_age, write_restart_FY, & + write_restart_lvl, write_restart_pond_lvl, & + write_restart_pond_topo, write_restart_aero, write_restart_fsd, & + write_restart_iso, write_restart_bgc, write_restart_hbrine, & + write_restart_snow + use ice_restart_driver, only: dumpfile + use ice_restoring, only: restore_ice, ice_HaloRestore + use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, & + update_state, step_dyn_horiz, step_dyn_ridge, step_radiation, & + biogeochemistry, step_prep, step_dyn_wave, step_snow + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_diags, timer_column, timer_thermo, timer_bound, & + timer_hist, timer_readwrite + use ice_communicate, only: MPI_COMM_ICE + use ice_prescribed_mod + + integer (kind=int_kind) :: & + iblk , & ! block index + k , & ! dynamics supercycling index + ktherm ! thermodynamics is off when ktherm = -1 + + real (kind=dbl_kind) :: & + offset ! d(age)/dt time offset + + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & + tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & + calc_Tsfc, skl_bgc, z_tracers, wave_spec + + character(len=*), parameter :: subname = '(ice_step)' + + character (len=char_len) :: plabeld + + !if (debug_model) then + ! plabeld = 'beginning time step' + ! do iblk = 1, nblocks + ! call debug_ice (iblk, plabeld) + ! enddo + !endif + + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & + z_tracers_out=z_tracers, ktherm_out=ktherm, wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + + call ice_timer_start(timer_column) ! continue column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + if (ktherm >= 0) then + + !----------------------------------------------------------------- + ! thermodynamics and biogeochemistry + !----------------------------------------------------------------- + + call biogeochemistry (dt, iblk) ! biogeochemistry + !if (debug_model) then + ! plabeld = 'post biogeochemistry' + ! call debug_ice (iblk, plabeld) + !endif + + if (.not.prescribed_ice) & + call step_therm2 (dt, iblk) ! ice thickness distribution thermo + if (debug_model) then + plabeld = 'post step_therm2' + call debug_ice (iblk, plabeld) + endif + + endif ! ktherm > 0 + + enddo ! iblk + !$OMP END PARALLEL DO + + ! clean up, update tendency diagnostics + offset = dt + call update_state (dt=dt, daidt=daidtt, dvidt=dvidtt, dvsdt=dvsdtt, & + dagedt=dagedtt, offset=offset) + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + !----------------------------------------------------------------- + ! dynamics, transport, ridging + !----------------------------------------------------------------- + + if (.not.prescribed_ice) then + + ! wave fracture of the floe size distribution + ! note this is called outside of the dynamics subcycling loop + if (tr_fsd .and. wave_spec) call step_dyn_wave(dt) + + do k = 1, ndtd + + ! momentum, stress, transport + call step_dyn_horiz (dt_dyn) + !if (debug_model) then + ! plabeld = 'post step_dyn_horiz' + ! do iblk = 1, nblocks + ! call debug_ice (iblk, plabeld) + ! enddo ! iblk + !endif + + ! ridging + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) + enddo + !$OMP END PARALLEL DO + !if (debug_model) then + ! plabeld = 'post step_dyn_ridge' + ! do iblk = 1, nblocks + ! call debug_ice (iblk, plabeld) + ! enddo ! iblk + !endif + + ! clean up, update tendency diagnostics + offset = c0 + call update_state (dt=dt_dyn, daidt=daidtd, dvidt=dvidtd, dvsdt=dvsdtd, & + dagedt=dagedtd, offset=offset) + + enddo + !if (debug_model) then + ! plabeld = 'post dynamics' + ! do iblk = 1, nblocks + ! call debug_ice (iblk, plabeld) + ! enddo + !endif + + endif ! not prescribed ice + + !----------------------------------------------------------------- + ! albedo, shortwave radiation + !----------------------------------------------------------------- + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + !----------------------------------------------------------------- + ! snow redistribution and metamorphosis + !----------------------------------------------------------------- + + if (tr_snow) then ! advanced snow physics + do iblk = 1, nblocks + call step_snow (dt, iblk) + enddo + call update_state (dt=dt) ! clean up + endif + +!MHRI: CHECK THIS OMP + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + !if (ktherm >= 0) call step_radiation (dt, iblk) + !if (debug_model) then + ! plabeld = 'post step_radiation' + ! call debug_ice (iblk, plabeld) + !endif + + !----------------------------------------------------------------- + ! get ready for coupling and the next time step + !----------------------------------------------------------------- + + call coupling_ocn (iblk) + if (debug_model) then + plabeld = 'post coupling_ocn' + call debug_ice (iblk, plabeld) + endif + 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 .or. z_tracers) call bgc_diags + if (tr_brine) call hbrine_diags + 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_snow) call write_restart_snow + if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso + if (tr_aero) call write_restart_aero + if (skl_bgc .or. z_tracers) & + 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_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & + fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswthrun_uvrdr, fswthrun_uvrdf, fswthrun_pardr, fswthrun_pardf, & + albicen, albsnon, albpndn, apeffn, snowfracn + use ice_blocks, only: nx_block, ny_block, get_block, block + use ice_domain, only: blocks_ice + use ice_calendar, only: dt, nstreams + use ice_domain_size, only: ncat + use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & + 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_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + fswthru_uvrdr, fswthru_uvrdf, fswthru_pardr, fswthru_pardf, & + swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & + fsens, flat, fswabs, flwout, evap, Tref, Qref, & + scale_fluxes, frzmlt_init, frzmlt, Uref, wind + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + flux_bio, flux_bio_ai, & + fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & + fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn + use ice_grid, only: tmask + use ice_state, only: aicen, aice + use ice_state, only: aice_init + use ice_flux, only: flatn_f, fsurfn_f + use ice_step_mod, only: ocean_mixed_layer + use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + n , & ! thickness category index + i,j , & ! horizontal indices + k , & ! tracer index + nbtrcr ! + + type (block) :: & + this_block ! block information for current block + + logical (kind=log_kind) :: & + skl_bgc , & ! + calc_Tsfc ! + + real (kind=dbl_kind) :: & + cszn , & ! counter for history averaging + puny , & ! + rhofresh , & ! + netsw ! flag for shortwave radiation presence + + character(len=*), parameter :: subname = '(coupling_prep)' + + !----------------------------------------------------------------- + + call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) + call icepack_query_parameters(skl_bgc_out=skl_bgc) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! 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 + + fswthru_vdr(i,j,iblk) = c0 + fswthru_vdf(i,j,iblk) = c0 + fswthru_idr(i,j,iblk) = c0 + fswthru_idf(i,j,iblk) = c0 + + fswthru_uvrdr(i,j,iblk) = c0 + fswthru_uvrdf(i,j,iblk) = c0 + fswthru_pardr(i,j,iblk) = c0 + fswthru_pardf(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 + + 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 n = 1, ncat + do j = jlo, jhi + do i = ilo, ihi + if (aicen(i,j,n,iblk) > puny) then + + 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) + + fswthru_vdr(i,j,iblk) = fswthru_vdr(i,j,iblk) & + + fswthrun_vdr(i,j,n,iblk)*aicen(i,j,n,iblk) + fswthru_vdf(i,j,iblk) = fswthru_vdf(i,j,iblk) & + + fswthrun_vdf(i,j,n,iblk)*aicen(i,j,n,iblk) + fswthru_idr(i,j,iblk) = fswthru_idr(i,j,iblk) & + + fswthrun_idr(i,j,n,iblk)*aicen(i,j,n,iblk) + fswthru_idf(i,j,iblk) = fswthru_idf(i,j,iblk) & + + fswthrun_idf(i,j,n,iblk)*aicen(i,j,n,iblk) + + fswthru_uvrdr(i,j,iblk) = fswthru_uvrdr(i,j,iblk) & + + fswthrun_uvrdr(i,j,n,iblk)*aicen(i,j,n,iblk) + fswthru_uvrdf(i,j,iblk) = fswthru_uvrdf(i,j,iblk) & + + fswthrun_uvrdf(i,j,n,iblk)*aicen(i,j,n,iblk) + fswthru_pardr(i,j,iblk) = fswthru_pardr(i,j,iblk) & + + fswthrun_pardr(i,j,n,iblk)*aicen(i,j,n,iblk) + fswthru_pardf(i,j,iblk) = fswthru_pardf(i,j,iblk) & + + fswthrun_pardf(i,j,n,iblk)*aicen(i,j,n,iblk) + + netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & + + swvdf(i,j,iblk) + swidf(i,j,iblk) + if (netsw > 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) + + endif ! aicen > puny + 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 CESM 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, & + icepack_max_aero, & + 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), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & + faero_ocn(:,:,:,iblk), & + alvdr (:,:,iblk), alidr (:,:,iblk), & + alvdf (:,:,iblk), alidf (:,:,iblk), & + flux_bio (:,:,1:nbtrcr,iblk), & + Qref_iso =Qref_iso (:,:,:,iblk), & + fiso_evap=fiso_evap(:,:,:,iblk), & + fiso_ocn =fiso_ocn (:,:,:,iblk), & + Uref=Uref(:,:,iblk), wind=wind(:,:,iblk) ) + + !----------------------------------------------------------------- + ! Define ice-ocean bgc fluxes + !----------------------------------------------------------------- + + if (nbtrcr > 0 .or. skl_bgc) then + call bgcflux_ice_to_ocn (nx_block, ny_block, & + flux_bio(:,:,1:nbtrcr,iblk), & + fnit(:,:,iblk), fsil(:,:,iblk), & + famm(:,:,iblk), fdmsp(:,:,iblk), & + fdms(:,:,iblk), fhum(:,:,iblk), & + fdust(:,:,iblk), falgalN(:,:,:,iblk), & + fdoc(:,:,:,iblk), fdic(:,:,:,iblk), & + fdon(:,:,:,iblk), ffep(:,:,:,iblk), & + ffed(:,:,:,iblk)) + endif + + call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling + + end subroutine coupling_prep + + subroutine coupling_atm (iblk) + + use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & + fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswthrun_uvrdr, fswthrun_uvrdf, fswthrun_pardr, fswthrun_pardf, & + albicen, albsnon, albpndn, apeffn, snowfracn + use ice_blocks, only: nx_block, ny_block, get_block, block + use ice_domain, only: blocks_ice + use ice_calendar, only: dt, nstreams + use ice_domain_size, only: ncat + use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & + albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & + alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & + fresh_ai, fsalt_ai, fsalt, fsurf, fcondtop, & + fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + fswthru_uvrdr, fswthru_uvrdf, fswthru_pardr, fswthru_pardf, & + swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & + fsens, flat, fswabs, flwout, evap, Tref, Qref, & + scale_fluxes, frzmlt_init, frzmlt, Uref, wind + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + flux_bio, flux_bio_ai, & + fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & + fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn + use ice_grid, only: tmask, opmask + use ice_state, only: aicen, aice, aicen_init, aice_init + use ice_flux, only: flatn_f, fsurfn_f + use ice_step_mod, only: ocean_mixed_layer + use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + n , & ! thickness category index + i,j , & ! horizontal indices + k , & ! tracer index + nbtrcr ! + + type (block) :: & + this_block ! block information for current block + + logical (kind=log_kind) :: & + skl_bgc , & ! + calc_Tsfc ! + + real (kind=dbl_kind) :: & + cszn , & ! counter for history averaging + puny , & ! + ar , & + stefan_boltzmann, & + Tffresh , & + rhofresh , & ! + netsw ! flag for shortwave radiation presence + + character(len=*), parameter :: subname = '(coupling_atm)' + + !----------------------------------------------------------------- + + call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) + call icepack_query_parameters(skl_bgc_out=skl_bgc) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_query_parameters(stefan_boltzmann_out=stefan_boltzmann, & + Tffresh_out=Tffresh) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! 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 + + !----------------------------------------------------------------- + ! 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 + cszn = c1 + do n = 1, nstreams + albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn + enddo + enddo + enddo + + 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 n = 1, ncat + do j = jlo, jhi + do i = ilo, ihi + if (aicen_init(i,j,n,iblk) > puny) then + + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + + alvdfn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + alidf(i,j,iblk) = alidf(i,j,iblk) & + + alidfn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + alvdr(i,j,iblk) = alvdr(i,j,iblk) & + + alvdrn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + alidr(i,j,iblk) = alidr(i,j,iblk) & + + alidrn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + + netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & + + swvdf(i,j,iblk) + swidf(i,j,iblk) + !if (netsw > puny) then ! sun above horizon + albice(i,j,iblk) = albice(i,j,iblk) & + + albicen(i,j,n,iblk)*aicen_init(i,j,n,iblk) + albsno(i,j,iblk) = albsno(i,j,iblk) & + + albsnon(i,j,n,iblk)*aicen_init(i,j,n,iblk) + albpnd(i,j,iblk) = albpnd(i,j,iblk) & + + albpndn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + !endif + + apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history + + apeffn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history + + snowfracn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + + endif ! aicen_init > puny + enddo + enddo + enddo + + do j = 1, ny_block + do i = 1, nx_block + + !---------------------------------------------------------------- + ! 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) + fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) + + + !----------------------------------------------------------------- + ! 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 CESM coupler assumes fluxes are per unit ice area + ! - also needed for global budget in diagnostics + !----------------------------------------------------------------- + + do j = 1, ny_block + do i = 1, nx_block + if ((tmask(i,j,iblk) .or. opmask(i,j,iblk)) .and. aice_init(i,j,iblk) > c0) then + ar = c1 / aice_init(i,j,iblk) + fsens (i,j,iblk) = fsens (i,j,iblk) * ar + flat (i,j,iblk) = flat (i,j,iblk) * ar + fswabs (i,j,iblk) = fswabs (i,j,iblk) * ar + flwout (i,j,iblk) = flwout (i,j,iblk) * ar + fsurf (i,j,iblk) = fsurf (i,j,iblk) * ar + fcondtop(i,j,iblk) = fcondtop(i,j,iblk) * ar + evap (i,j,iblk) = evap (i,j,iblk) * ar + Tref (i,j,iblk) = Tref (i,j,iblk) * ar + Qref (i,j,iblk) = Qref (i,j,iblk) * ar + Uref (i,j,iblk) = Uref (i,j,iblk) * ar + fswthru (i,j,iblk) = fswthru (i,j,iblk) * ar + fswthru_vdr (i,j,iblk) = fswthru_vdr (i,j,iblk) * ar + fswthru_vdf (i,j,iblk) = fswthru_vdf (i,j,iblk) * ar + fswthru_idr (i,j,iblk) = fswthru_idr (i,j,iblk) * ar + fswthru_idf (i,j,iblk) = fswthru_idf (i,j,iblk) * ar + alvdr (i,j,iblk) = alvdr (i,j,iblk) * ar + alidr (i,j,iblk) = alidr (i,j,iblk) * ar + alvdf (i,j,iblk) = alvdf (i,j,iblk) * ar + alidf (i,j,iblk) = alidf (i,j,iblk) * ar + fswthru_uvrdr (i,j,iblk) = fswthru_uvrdr (i,j,iblk) * ar + fswthru_uvrdf (i,j,iblk) = fswthru_uvrdf (i,j,iblk) * ar + fswthru_pardr (i,j,iblk) = fswthru_pardr (i,j,iblk) * ar + fswthru_pardf (i,j,iblk) = fswthru_pardf (i,j,iblk) * ar + else + fsens (i,j,iblk) = c0 + flat (i,j,iblk) = c0 + fswabs (i,j,iblk) = c0 + flwout (i,j,iblk) = -stefan_boltzmann *(Tf(i,j,iblk) + Tffresh)**4 + fsurf (i,j,iblk) = c0 + fcondtop(i,j,iblk) = c0 + evap (i,j,iblk) = c0 + Tref (i,j,iblk) = Tair (i,j,iblk) + Qref (i,j,iblk) = Qa (i,j,iblk) + Uref (i,j,iblk) = wind (i,j,iblk) + fswthru (i,j,iblk) = c0 + fswthru_vdr (i,j,iblk) = c0 + fswthru_vdf (i,j,iblk) = c0 + fswthru_idr (i,j,iblk) = c0 + fswthru_idf (i,j,iblk) = c0 + alvdr (i,j,iblk) = c0 + alidr (i,j,iblk) = c0 + alvdf (i,j,iblk) = c0 + alidf (i,j,iblk) = c0 + fswthru_uvrdr (i,j,iblk) = c0 + fswthru_uvrdf (i,j,iblk) = c0 + fswthru_pardr (i,j,iblk) = c0 + fswthru_pardf (i,j,iblk) = c0 + endif + + enddo + enddo + + + call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling + + end subroutine coupling_atm + + subroutine coupling_ocn (iblk) + + use ice_blocks, only: nx_block, ny_block, get_block, block + use ice_domain, only: blocks_ice + use ice_calendar, only: dt, nstreams + use ice_domain_size, only: ncat + use ice_flux, only: fpond, fresh, l_mpond_fresh, & + fhocn_ai, fresh_ai, fsalt_ai, fsalt, & + fhocn, strairxT, strairyT + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + flux_bio, flux_bio_ai, & + fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & + fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn + use ice_grid, only: tmask, opmask + use ice_state, only: aicen, aice, aicen_init, aice_init + use ice_flux, only: flatn_f, fsurfn_f + use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + n , & ! thickness category index + i,j , & ! horizontal indices + k , & ! tracer index + nbtrcr ! + + type (block) :: & + this_block ! block information for current block + + logical (kind=log_kind) :: & + skl_bgc , & ! + calc_Tsfc ! + + real (kind=dbl_kind) :: & + cszn , & ! counter for history averaging + puny , & ! + ar , & ! + rhofresh , & ! + netsw ! flag for shortwave radiation presence + + character(len=*), parameter :: subname = '(coupling_ocn)' + + !----------------------------------------------------------------- + + call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) + call icepack_query_parameters(skl_bgc_out=skl_bgc) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_start(timer_couple,iblk) ! atm/ocn coupling + + 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 + !---------------------------------------------------------------- + + 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) + + if (nbtrcr > 0) then + do k = 1, nbtrcr + flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) + enddo + endif + + enddo + enddo + + do j = 1, ny_block + do i = 1, nx_block + if ((tmask(i,j,iblk) .or. opmask(i,j,iblk)) .and. aice(i,j,iblk) > c0) then + ar = c1 / aice(i,j,iblk) + strairxT(i,j,iblk) = strairxT(i,j,iblk) * ar + strairyT(i,j,iblk) = strairyT(i,j,iblk) * ar + fresh(i,j,iblk) = fresh(i,j,iblk) * ar + fhocn(i,j,iblk) = fhocn(i,j,iblk) * ar + fsalt(i,j,iblk) = fsalt(i,j,iblk) * ar + flux_bio (i,j,:,iblk) = flux_bio (i,j,:,iblk) * ar + faero_ocn(i,j,:,iblk) = faero_ocn(i,j,:,iblk) * ar + Qref_iso (i,j,:,iblk) = Qref_iso (i,j,:,iblk) * ar + fiso_evap(i,j,:,iblk) = fiso_evap(i,j,:,iblk) * ar + fiso_ocn (i,j,:,iblk) = fiso_ocn (i,j,:,iblk) * ar + else + strairxT(i,j,iblk) = c0 + strairyT(i,j,iblk) = c0 + fresh(i,j,iblk) = c0 + fhocn(i,j,iblk) = c0 + fsalt(i,j,iblk) = c0 + flux_bio (i,j,:,iblk) = c0 + faero_ocn(i,j,:,iblk) = c0 + Qref_iso (i,j,:,iblk) = c0 + fiso_evap(i,j,:,iblk) = c0 + fiso_ocn (i,j,:,iblk) = c0 + endif + + enddo + enddo + + !----------------------------------------------------------------- + ! Define ice-ocean bgc fluxes + !----------------------------------------------------------------- + + if (nbtrcr > 0 .or. skl_bgc) then + call bgcflux_ice_to_ocn (nx_block, ny_block, & + flux_bio(:,:,1:nbtrcr,iblk), & + fnit(:,:,iblk), fsil(:,:,iblk), & + famm(:,:,iblk), fdmsp(:,:,iblk), & + fdms(:,:,iblk), fhum(:,:,iblk), & + fdust(:,:,iblk), falgalN(:,:,:,iblk), & + fdoc(:,:,:,iblk), fdic(:,:,:,iblk), & + fdon(:,:,:,iblk), ffep(:,:,:,iblk), & + ffed(:,:,:,iblk)) + endif + + call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling + + end subroutine coupling_ocn + +!======================================================================= + + subroutine ice_fast_physics + + use ice_boundary, only: ice_HaloUpdate + use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep + use ice_calendar, only: istep1, calendar, advance_timestep + use ice_calendar, only: idate, msec + use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice + use ice_diagnostics_bgc, only: hbrine_diags, bgc_diags + use ice_domain, only: halo_info, nblocks + use ice_dyn_eap, only: write_restart_eap + use ice_dyn_shared, only: kdyn, kridge + use ice_flux, only: scale_factor, init_history_therm, & + daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + use ice_flux, only: init_flux_atm, init_flux_ocn + use ice_history, only: accum_hist + use ice_history_bgc, only: init_history_bgc + use ice_restart, only: final_restart + use ice_restart_column, only: write_restart_age, write_restart_FY, & + write_restart_lvl, write_restart_pond_lvl, & + write_restart_pond_topo, write_restart_aero, write_restart_fsd, & + write_restart_iso, write_restart_bgc, write_restart_hbrine, & + write_restart_snow + use ice_restart_driver, only: dumpfile + use ice_restoring, only: restore_ice, ice_HaloRestore + use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, & + update_state, step_dyn_horiz, step_dyn_ridge, step_radiation, & + biogeochemistry, step_prep, step_dyn_wave, step_snow + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_diags, timer_column, timer_step, timer_thermo, & + timer_bound, timer_couple, timer_hist, timer_readwrite + + integer (kind=int_kind) :: & + iblk , & ! block index + k , & ! dynamics supercycling index + ktherm ! thermodynamics is off when ktherm = -1 + + real (kind=dbl_kind) :: & + offset ! d(age)/dt time offset + + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & + tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & + calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + + character(len=*), parameter :: subname = '(ice_fast_physics)' + + character (len=char_len) :: plabeld + + call ice_timer_start(timer_step) ! start timing entire run + + if (debug_model) then + plabeld = 'beginning time step' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & + solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & + wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_start(timer_couple) ! atm/ocn coupling + + !call advance_timestep() ! advance timestep and update calendar data + + !if (z_tracers) call get_atm_bgc ! biogeochemistry + + call init_flux_atm ! Initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + call ice_timer_stop(timer_couple) ! atm/ocn coupling + !----------------------------------------------------------------- + ! restoring on grid boundaries + !----------------------------------------------------------------- + + if (restore_ice) call ice_HaloRestore + + + !----------------------------------------------------------------- + ! initialize diagnostics and save initial state values + !----------------------------------------------------------------- + + 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 + + call step_prep + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + if (ktherm >= 0) then + + !----------------------------------------------------------------- + ! scale radiation fields + !----------------------------------------------------------------- + + !if (calc_Tsfc) call prep_radiation (iblk) + !if (debug_model) then + ! plabeld = 'post prep_radiation' + ! call debug_ice (iblk, plabeld) + !endif + + call step_radiation (dt, iblk) + if (debug_model) then + plabeld = 'post step_radiation' + call debug_ice (iblk, plabeld) + endif + + !----------------------------------------------------------------- + ! get ready for coupling and the next time step + !----------------------------------------------------------------- + + !call coupling_prep (iblk) + !if (debug_model) then + ! plabeld = 'post coupling_prep' + ! call debug_ice (iblk, plabeld) + !endif + + !----------------------------------------------------------------- + ! thermodynamics and biogeochemistry + !----------------------------------------------------------------- + + call step_therm1 (dt, iblk) ! vertical thermodynamics + if (debug_model) then + plabeld = 'post step_therm1' + call debug_ice (iblk, plabeld) + endif + + call coupling_atm (iblk) + if (debug_model) then + plabeld = 'post coupling_atm' + call debug_ice (iblk, plabeld) + endif + + endif ! ktherm > 0 + + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + call ice_timer_stop(timer_step) ! start timing entire run + + end subroutine ice_fast_physics + +!======================================================================= + + subroutine ice_radiation + + use ice_calendar, only: dt + use ice_domain, only: nblocks + use ice_step_mod, only: step_radiation + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_column, timer_thermo + use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & + fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswthrun_uvrdr, fswthrun_uvrdf, fswthrun_pardr, fswthrun_pardf, & + albicen, albsnon, albpndn, apeffn, snowfracn + use ice_blocks, only: nx_block, ny_block, get_block, block + use ice_domain, only: blocks_ice + use ice_calendar, only: dt, nstreams + use ice_domain_size, only: ncat + use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & + 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_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + fswthru_uvrdr, fswthru_uvrdf, fswthru_pardr, fswthru_pardf, & + swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & + fsens, flat, fswabs, flwout, evap, Tref, Qref, & + scale_fluxes, frzmlt_init, frzmlt, Uref, wind + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + flux_bio, flux_bio_ai, & + fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & + fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn + use ice_grid, only: tmask, opmask + use ice_state, only: aicen, aice, aicen_init, aice_init + use ice_flux, only: flatn_f, fsurfn_f + use ice_step_mod, only: ocean_mixed_layer + + integer (kind=int_kind) :: & + i,j,n,iblk ! block index + + integer (kind=int_kind) :: & + ilo, ihi, jlo, jhi + + type (block) :: & + this_block ! block information for current block + + real (kind=dbl_kind) :: & + ar, puny + + character(len=*), parameter :: subname = '(ice_radiation)' + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + call icepack_query_parameters(puny_out=puny) + + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + !call step_albedo_only(dt, iblk) + call step_radiation(dt, iblk) + enddo ! iblk + !$OMP END PARALLEL DO + + do iblk = 1, nblocks + 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 + enddo + enddo + enddo + + 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 n = 1, ncat + do j = jlo, jhi + do i = ilo, ihi + if (aicen_init(i,j,n,iblk) > puny) then + + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + + alvdfn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + alidf(i,j,iblk) = alidf(i,j,iblk) & + + alidfn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + alvdr(i,j,iblk) = alvdr(i,j,iblk) & + + alvdrn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + alidr(i,j,iblk) = alidr(i,j,iblk) & + + alidrn(i,j,n,iblk)*aicen_init(i,j,n,iblk) + + endif ! aicen_init > puny + enddo + enddo + enddo + enddo + + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + if ((tmask(i,j,iblk) .or. opmask(i,j,iblk)) .and. aice_init(i,j,iblk) > c0) then + ar = c1 / aice_init(i,j,iblk) + alvdr (i,j,iblk) = alvdr (i,j,iblk) * ar + alidr (i,j,iblk) = alidr (i,j,iblk) * ar + alvdf (i,j,iblk) = alvdf (i,j,iblk) * ar + alidf (i,j,iblk) = alidf (i,j,iblk) * ar + else + alvdr (i,j,iblk) = c0 + alidr (i,j,iblk) = c0 + alvdf (i,j,iblk) = c0 + alidf (i,j,iblk) = c0 + endif + enddo ! i + enddo ! j + enddo ! iblk + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + + end subroutine ice_radiation + + + end module CICE_RunMod + +!======================================================================= diff --git a/cicecore/drivers/mapl/geos/CICE_copyright.txt b/cicecore/drivers/mapl/geos/CICE_copyright.txt new file mode 100644 index 000000000..6eb3c9cca --- /dev/null +++ b/cicecore/drivers/mapl/geos/CICE_copyright.txt @@ -0,0 +1,17 @@ +! Copyright (c) 2022, Triad National Security, LLC +! All rights reserved. +! +! Copyright 2022. Triad National Security, LLC. This software was +! produced under U.S. Government contract DE-AC52-06NA25396 for Los +! Alamos National Laboratory (LANL), which is operated by Triad +! National Security, LLC for the U.S. Department of Energy. The U.S. +! Government has rights to use, reproduce, and distribute this software. +! NEITHER THE GOVERNMENT NOR TRIAD NATIONAL SECURITY, LLC MAKES ANY +! WARRANTY, EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF +! THIS SOFTWARE. If software is modified to produce derivative works, +! such modified software should be clearly marked, so as not to confuse +! it with the version available from LANL. +! +! The full license and distribution policy are available from +! https://github.com/CICE-Consortium +! diff --git a/cicecore/drivers/mapl/geos/ice_import_export.F90 b/cicecore/drivers/mapl/geos/ice_import_export.F90 new file mode 100644 index 000000000..14002ef44 --- /dev/null +++ b/cicecore/drivers/mapl/geos/ice_import_export.F90 @@ -0,0 +1,1034 @@ +module ice_import_export + + use ESMF + use ice_kinds_mod , only : int_kind, dbl_kind, real_kind, char_len, log_kind + use ice_constants , only : c0, c1, p5, p25, spval_dbl, radius + use ice_constants , only : field_loc_center, field_type_scalar, field_type_vector + use ice_blocks , only : block, get_block, nx_block, ny_block, nghost + 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_exit , only : abort_ice + use ice_flux , only : strairxt, strairyt, strocnxT_iavg, strocnyT_iavg + 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 : evapn_f, fsurfn_f, dfsurfndts_f, dflatndts_f + use ice_flux , only : flatn_f, coszen + use ice_flux , only : fswthru_uvrdr, fswthru_uvrdf, fswthru_pardr, fswthru_pardf + use ice_flux , only : send_i2x_per_cat, fswthrun_ai + use ice_flux_bgc , only : faero_atm, faero_ocn + use ice_flux_bgc , only : fiso_atm, fiso_ocn, fiso_evap + use ice_flux_bgc , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn + use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa + use ice_flux , only : fresh_ai, fsalt_ai, fhocn_ai + use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain + use ice_flux , only : swuvrdr, swuvrdf, swpardr, swpardf + use ice_flux , only : fcondtop + use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt + use ice_flux , only : send_i2x_per_cat + use ice_flux , only : sss, Tf, wind, fsw + use ice_state , only : vice, vsno, aice, aicen, trcr, trcrn + use ice_state , only : Tsfcn_init, aice_init, uvel, vvel + use ice_grid , only : tlon, tlat, tarea, tmask, umask, anglet, ocn_gridcell_frac, hm + use ice_grid , only : dxu, dyu, dxE, dyE, dxN, dyN, nmask, emask + use ice_grid , only : grid_type, grid_ice + use ice_boundary , only : ice_HaloUpdate + use ice_shr_methods , only : chkerr + use ice_fileunits , only : nu_diag, flush_fileunit + use ice_communicate , only : my_task, master_task, MPI_COMM_ICE + use ice_prescribed_mod , only : prescribed_ice + use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags + use icepack_intfc , only : icepack_liquidus_temperature + use icepack_intfc , only : icepack_sea_freezing_temperature + + implicit none + public + + public :: ice_import_thermo1 + public :: ice_export_thermo1 + public :: ice_import_grid + !public :: ice_import_thermo2 + !public :: ice_export_thermo2 + public :: ice_import_dyna + public :: ice_export_dyna + public :: ice_export_field + + interface ice_export_field + module procedure ice_export_field_2d + module procedure ice_export_field_3d + end interface ice_export_field + + private :: state_FldChk + + interface state_getfldptr + module procedure state_getfldptr_1d + module procedure state_getfldptr_2d + module procedure state_getfldptr_3d + end interface state_getfldptr + private :: state_getfldptr + + interface state_getimport + module procedure state_getimport_4d + module procedure state_getimport_3d + end interface state_getimport + private :: state_getimport + + interface state_setexport + module procedure state_setexport_4d + module procedure state_setexport_3d + end interface state_setexport + private :: state_setexport + + interface arr_setexport + module procedure arr_setexport_4d + module procedure arr_setexport_3d + end interface arr_setexport + private :: arr_setexport + + ! Private module data + + type fld_list_type + character(len=128) :: stdname + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 + end type fld_list_type + + ! area correction factors for fluxes send and received from mediator + real(dbl_kind), allocatable :: mod2med_areacor(:) ! ratios of model areas to input mesh areas + real(dbl_kind), allocatable :: med2mod_areacor(:) ! ratios of input mesh areas to model areas + + integer, parameter :: fldsMax = 100 + integer :: fldsToIce_num = 0 + integer :: fldsFrIce_num = 0 + type (fld_list_type) :: fldsToIce(fldsMax) + type (fld_list_type) :: fldsFrIce(fldsMax) + + integer , parameter :: io_dbug = 10 ! i/o debug messages + character(*), parameter :: u_FILE_u = & + __FILE__ + +!============================================================================== +contains +!============================================================================== + subroutine ice_import_grid( fro, rc ) + + ! input/output variables + real(kind=real_kind), dimension(:,:), intent(in) :: fro + integer , intent(out) :: rc + + integer :: i, j, i1, j1, k, iblk, n + integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain + type(block) :: this_block ! block information for current block + + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + ocn_gridcell_frac(i,j,iblk) = real(fro(i1, j1), kind=dbl_kind) + enddo + enddo + enddo + + rc = ESMF_SUCCESS + + end subroutine ice_import_grid + !=============================================================================== + + subroutine ice_import_thermo1( importState, rc ) + + ! input/output variables + type(ESMF_State) , intent(in) :: importState + integer , intent(out) :: rc + + ! local variables + integer,parameter :: nfldu=5 + integer,parameter :: nfld=12 + integer :: i, j, k, iblk, n + integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain + type(block) :: this_block ! block information for current block + real (kind=dbl_kind) :: Tffresh + real (kind=dbl_kind),allocatable :: afldu(:,:,:,:,:) + real (kind=dbl_kind),allocatable :: afld(:,:,:,:) + character(len=*), parameter :: subname = 'ice_import_thermo1' + character(len=1024) :: msgString + !----------------------------------------------------- + + call icepack_query_parameters(Tffresh_out=Tffresh) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=u_FILE_u, line=__LINE__) + + + allocate(afldu(nx_block,ny_block,ncat,nfldu,nblocks)) + afldu = c0 + allocate( afld(nx_block,ny_block, nfld,nblocks)) + afld = c0 + + !call state_getimport(importState, 'TSKINICE', output=afldu, index=1, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'EVAP', output=afldu, index=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'FSURF', output=afldu, index=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'DFSURFDTS', output=afldu, index=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'DLHFDTS', output=afldu, index=4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'LHF', output=afldu, index=5, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + + call state_getimport(importState, 'SNOW', output=afld, index=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'RAIN', output=afld, index=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'DRPAR', output=afld, index=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'DFPAR', output=afld, index=4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'DRNIR', output=afld, index=5, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'DFNIR', output=afld, index=6, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'DRUVR', output=afld, index=7, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'DFUVR', output=afld, index=8, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'COSZ', output=afld, index=9, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'SST', output=afld, index=10, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'SSS', output=afld, index=11, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'FRZMLT', output=afld, index=12, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! now fill in the ice internal data types + do k = 1, ncat + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + !trcrn (i,j,1,k,iblk) = afldu(i,j,k,1,iblk) - Tffresh + evapn_f (i,j,k,iblk) = afldu(i,j,k,1,iblk) + fsurfn_f (i,j,k,iblk) = afldu(i,j,k,2,iblk) + dfsurfndts_f(i,j,k,iblk) = afldu(i,j,k,3,iblk) + dflatndts_f(i,j,k,iblk) = afldu(i,j,k,4,iblk) + flatn_f (i,j,k,iblk) = afldu(i,j,k,5,iblk) + end do + end do + end do + !$OMP END PARALLEL DO + end do + + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + fsnow (i,j,iblk) = afld(i,j,1,iblk) + frain (i,j,iblk) = afld(i,j,2,iblk) + swvdr (i,j,iblk) = afld(i,j,3,iblk) + afld(i,j,7,iblk) + swidr (i,j,iblk) = afld(i,j,5,iblk) + swvdf (i,j,iblk) = afld(i,j,4,iblk) + afld(i,j,8,iblk) + swidf (i,j,iblk) = afld(i,j,6,iblk) + swuvrdr(i,j,iblk) = afld(i,j,7,iblk) + swuvrdf(i,j,iblk) = afld(i,j,8,iblk) + swpardr(i,j,iblk) = afld(i,j,3,iblk) + swpardf(i,j,iblk) = afld(i,j,4,iblk) + coszen(i,j,iblk) = afld(i,j,9,iblk) + sst (i,j,iblk) = afld(i,j,10,iblk) - Tffresh + sss (i,j,iblk) = afld(i,j,11,iblk) + frzmlt(i,j,iblk) = afld(i,j,12,iblk) + fsw (i,j,iblk) = swvdr(i,j,iblk) + swvdf(i,j,iblk) & + + swidr(i,j,iblk) + swidf(i,j,iblk) + end do + end do + end do + !$OMP END PARALLEL DO + + + + !== will change to read in from coupler once Tf from MOM is ready + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + Tf(i,j,iblk) = icepack_sea_freezing_temperature(sss(i,j,iblk)) + end do + end do + end do + !$OMP END PARALLEL DO + + deallocate(afldu) + deallocate(afld) + + rc = ESMF_SUCCESS + + end subroutine ice_import_thermo1 + + subroutine ice_import_radiation( importState, rc ) + + ! input/output variables + type(ESMF_State) , intent(in) :: importState + integer , intent(out) :: rc + + ! local variables + integer,parameter :: nfld=1 + integer :: i, j, k, iblk + integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain + type(block) :: this_block ! block information for current block + real (kind=dbl_kind),allocatable :: afld(:,:,:,:) + character(len=*), parameter :: subname = 'ice_import_radiation' + character(len=1024) :: msgString + !----------------------------------------------------- + + + allocate( afld(nx_block,ny_block, nfld,nblocks)) + afld = c0 + + call state_getimport(importState, 'COSZ', output=afld, index=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + coszen(i,j,iblk) = afld(i,j,1,iblk) + end do + end do + end do + !$OMP END PARALLEL DO + + deallocate(afld) + + rc = ESMF_SUCCESS + + end subroutine ice_import_radiation + + subroutine ice_import_dyna( taux, tauy, slv, uob, vob, uoc, voc, rc ) + + ! input/output variables + real(kind=real_kind) , intent(in) :: taux(:,:) + real(kind=real_kind) , intent(in) :: tauy(:,:) + real(kind=real_kind) , intent(in) :: slv(:,:) + real(kind=real_kind) , intent(in) :: uob(:,:) + real(kind=real_kind) , intent(in) :: vob(:,:) + real(kind=real_kind) , intent(in) :: uoc(:,:) + real(kind=real_kind) , intent(in) :: voc(:,:) + integer , intent(out):: rc + + ! local variables + integer :: i, j, k, iblk + integer :: i1, j1 + integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain + type(block) :: this_block ! block information for current block + real(kind=dbl_kind) :: workx, worky + real(kind=dbl_kind) :: ssh(nx_block,ny_block,max_blocks) + character(len=*), parameter :: subname = 'ice_import_dyna' + character(len=1024) :: msgString + !----------------------------------------------------- + + + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + if(tmask(i,j,iblk)) then + workx = real(taux(i1, j1), kind=dbl_kind) + worky = real(tauy(i1, j1), kind=dbl_kind) + strairxT(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + worky*sin(ANGLET(i,j,iblk)) ! note strax, stray, wind + strairyT(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & ! are on the T-grid here + - workx*sin(ANGLET(i,j,iblk)) + ! multiply by aice to properly treat free drift + strairxT(i,j,iblk) = strairxT(i,j,iblk) * aice_init(i,j,iblk) + strairyT(i,j,iblk) = strairyT(i,j,iblk) * aice_init(i,j,iblk) + ssh(i,j,iblk) = real(slv(i1,j1), kind=dbl_kind) + else + strairxT(i,j,iblk) = c0 + strairyT(i,j,iblk) = c0 + ssh(i,j,iblk) = c0 + endif + if(trim(grid_ice) == 'B') then + if(umask(i,j,iblk)) then + uocn(i,j,iblk) = real(uob(i1,j1), kind=dbl_kind) + vocn(i,j,iblk) = real(vob(i1,j1), kind=dbl_kind) + else + uocn(i,j,iblk) = c0 + vocn(i,j,iblk) = c0 + endif + elseif(trim(grid_ice) == 'C') then + if(emask(i,j,iblk)) then + uocn(i,j,iblk) = real(uoc(i1,j1), kind=dbl_kind) + else + uocn(i,j,iblk) = c0 + endif + if(nmask(i,j,iblk)) then + vocn(i,j,iblk) = real(voc(i1,j1), kind=dbl_kind) + else + vocn(i,j,iblk) = c0 + endif + else + call abort_ice(error_message='unknown grid_ice', & + file=u_FILE_u, line=__LINE__) + endif + enddo + enddo + enddo + + call ice_HaloUpdate (ssh, halo_info, & + field_loc_center, field_type_scalar) + + !*** if C-grid ice dynamics is on, the following needs to be revised + !*** so a query of which dynamics (B- or C-) should be made and branch into + !*** different computation of ss_tlt* terms + 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(trim(grid_ice) == 'B') then + if(umask(i,j,iblk)) then + ss_tltx(i,j,iblk) = p5*(ssh(i+1,j+1,iblk)-ssh(i,j+1,iblk) & + +ssh(i+1,j ,iblk)-ssh(i,j ,iblk)) & + /dxu(i,j,iblk) + ss_tlty(i,j,iblk) = p5*(ssh(i+1,j+1,iblk)+ssh(i,j+1,iblk) & + -ssh(i+1,j ,iblk)-ssh(i,j ,iblk)) & + /dyu(i,j,iblk) + else + ss_tltx(i,j,iblk) = c0 + ss_tlty(i,j,iblk) = c0 + endif + elseif(trim(grid_ice) == 'C') then + if(emask(i,j,iblk)) then + ss_tltx(i,j,iblk) = (ssh(i+1,j ,iblk)-ssh(i,j ,iblk)) & + /dxE(i,j,iblk) + else + ss_tltx(i,j,iblk) = c0 + endif + if(nmask(i,j,iblk)) then + ss_tlty(i,j,iblk) = (ssh(i,j+1,iblk) - ssh(i,j ,iblk)) & + /dyN(i,j,iblk) + else + ss_tlty(i,j,iblk) = c0 + endif + else + call abort_ice(error_message='unknown grid_ice', & + file=u_FILE_u, line=__LINE__) + endif + enddo + enddo + enddo + + rc = ESMF_SUCCESS + + end subroutine ice_import_dyna + + subroutine ice_export_dyna( tauxo, tauyo, ui, vi, rc ) + + ! input/output variables + real(kind=real_kind) , intent(out) :: tauxo(:,:) + real(kind=real_kind) , intent(out) :: tauyo(:,:) + real(kind=real_kind) , intent(out) :: ui (:,:) + real(kind=real_kind) , intent(out) :: vi (:,:) + integer , intent(out):: rc + + ! local variables + integer :: i, j, k, iblk + integer :: i1, j1 + integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain + type(block) :: this_block ! block information for current block + real(kind=dbl_kind) :: workx, worky + character(len=*), parameter :: subname = 'ice_export_dyna' + character(len=1024) :: msgString + !----------------------------------------------------- + + + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + ! ice/ocean stress (on POP T-grid: convert to lat-lon) + workx = strocnxT_iavg(i,j,iblk) ! N/m^2 + worky = strocnyT_iavg(i,j,iblk) ! N/m^2 + tauxo(i1,j1) = real(workx*cos(ANGLET(i,j,iblk)) - & + worky*sin(ANGLET(i,j,iblk)), kind=real_kind) + tauyo(i1,j1) = real(worky*cos(ANGLET(i,j,iblk)) + & + workx*sin(ANGLET(i,j,iblk)), kind=real_kind) + workx = p25*(uvel(i,j ,iblk) + uvel(i-1,j ,iblk) & ! cell-centered velocity + + uvel(i,j-1,iblk) + uvel(i-1,j-1,iblk)) ! assumes wind components + worky = p25*(vvel(i,j ,iblk) + vvel(i-1,j ,iblk) & ! are also cell-centered + + vvel(i,j-1,iblk) + vvel(i-1,j-1,iblk)) + ui(i1,j1) = real(workx*cos(ANGLET(i,j,iblk)) - & + worky*sin(ANGLET(i,j,iblk)), kind=real_kind) + vi(i1,j1) = real(worky*cos(ANGLET(i,j,iblk)) + & + workx*sin(ANGLET(i,j,iblk)), kind=real_kind) + enddo + enddo + enddo + + rc = ESMF_SUCCESS + + end subroutine ice_export_dyna + + !=============================================================================== + subroutine ice_export_thermo1( exportState, rc ) + + ! input/output variables + type(ESMF_State), intent(inout) :: exportState + integer , intent(out) :: rc + + ! local variables + type(block) :: this_block ! block information for current block + integer :: i, j, iblk, n ! incides + integer :: n2 ! thickness category index + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + real (kind=dbl_kind) :: workx, worky ! tmps for converting grid + logical :: flag + integer (kind=int_kind) :: indxi (nx_block*ny_block) ! compressed indices in i + integer (kind=int_kind) :: indxj (nx_block*ny_block) ! compressed indices in i + real (kind=dbl_kind) :: dTsrf (nx_block,ny_block,ncat,max_blocks) ! surface temperature + real (kind=dbl_kind) :: Tffresh + !integer, parameter :: nfldu=1 + !real (kind=dbl_kind),allocatable :: afldu(:,:,:,:,:) + character(len=*),parameter :: subname = 'ice_export_thermo1' + !----------------------------------------------------- + + rc = ESMF_SUCCESS + if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + call icepack_query_parameters(Tffresh_out=Tffresh) + ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & + ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & + ! Tffresh_out=Tffresh) + ! call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_iage_out=tr_iage, & + ! tr_FY_out=tr_FY, tr_pond_out=tr_pond, tr_lvl_out=tr_lvl, & + ! tr_zaero_out=tr_zaero, tr_bgc_Nit_out=tr_bgc_Nit) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=u_FILE_u, line=__LINE__) + + !--------------------------------- + ! Create the export state + !--------------------------------- + !allocate(afldu(nx_block,ny_block,ncat,nfldu,nblocks)) + !afldu = c0 + !call state_getimport(exportState, 'TSKINICE', output=afldu, index=1, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + dTsrf = trcrn(:,:,1,:,:) - Tsfcn_init + + call state_setexport(exportState, 'DTS', input=dTsrf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'ALBVR', input=alvdr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'ALBVF', input=alvdf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'ALBNR', input=alidr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'ALBNF', input=alidf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'PENUVR', input=fswthru_uvrdr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'PENUVF', input=fswthru_uvrdf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'PENPAR', input=fswthru_pardr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'PENPAF', input=fswthru_pardf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'GHTSKIN', input=fcondtop, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !deallocate(afldu) + + end subroutine ice_export_thermo1 + + subroutine ice_export_radiation( exportState, rc ) + + ! input/output variables + type(ESMF_State), intent(inout) :: exportState + integer , intent(out) :: rc + + ! local variables + character(len=*),parameter :: subname = 'ice_export_radiation' + !----------------------------------------------------- + + rc = ESMF_SUCCESS + if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + call state_setexport(exportState, 'ALBVR', input=alvdr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'ALBVF', input=alvdf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'ALBNR', input=alidr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'ALBNF', input=alidf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine ice_export_radiation + + subroutine ice_export_field_3d(fldname, fld, rc) + + ! input/output variables + character(len=*) , intent(in) :: fldname + real(kind=real_kind) , intent(out) :: fld(:,:,:) + integer , intent(out) :: rc + + ! local variables + character(len=*),parameter :: subname = 'ice_export_field_3d' + real(kind=dbl_kind) :: Tffresh + + rc = ESMF_SUCCESS + + call icepack_query_parameters(Tffresh_out=Tffresh) + ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & + ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & + ! Tffresh_out=Tffresh) + ! call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_iage_out=tr_iage, & + ! tr_FY_out=tr_FY, tr_pond_out=tr_pond, tr_lvl_out=tr_lvl, & + ! tr_zaero_out=tr_zaero, tr_bgc_Nit_out=tr_bgc_Nit) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=u_FILE_u, line=__LINE__) + + if (trim(fldname) == 'TI') then + call arr_setexport_4d(fld, trcrn(:,:,1,:,:), rc) + fld(:,:,:) = real(Tffresh, kind=real_kind) + fld(:,:,:) !Kelvin (original ???) + elseif (trim(fldname) == 'FRSEAICE') then + call arr_setexport_4d(fld, aicen, rc) + else + call ESMF_LogWrite(trim(subname)//": "//trim(fldname)//" not available for export", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + end subroutine ice_export_field_3d + + subroutine ice_export_field_2d(fldname, fld, rc) + + ! input/output variables + character(len=*) , intent(in) :: fldname + real(kind=real_kind) , intent(out) :: fld(:,:) + integer , intent(out) :: rc + + ! local variables + character(len=*),parameter :: subname = 'ice_export_field_2d' + + + rc = ESMF_SUCCESS + + if (trim(fldname) == 'FRACICE') then + call arr_setexport_3d(fld, aice, rc) + elseif (trim(fldname) == 'FHOCN') then + call arr_setexport_3d(fld, fhocn_ai, rc) + elseif (trim(fldname) == 'FRESH') then + call arr_setexport_3d(fld, fresh_ai, rc) + elseif (trim(fldname) == 'FSALT') then + call arr_setexport_3d(fld, fsalt_ai, rc) + else + call ESMF_LogWrite(trim(subname)//": "//trim(fldname)//" not available for export", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + end subroutine ice_export_field_2d + + !=============================================================================== + logical function State_FldChk(State, fldname) + ! ---------------------------------------------- + ! Determine if field is in state + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + + ! local variables + type(ESMF_StateItem_Flag) :: itemType + ! ---------------------------------------------- + + call ESMF_StateGet(State, trim(fldname), itemType) + State_FldChk = (itemType /= ESMF_STATEITEM_NOTFOUND) + + end function State_FldChk + + !=============================================================================== + subroutine state_getimport_4d(state, fldname, output, index, rc) + + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real (kind=dbl_kind) , intent(inout) :: output(:,:,:,:,:) + integer , intent(in) :: index + integer , intent(out) :: rc + + ! local variables + type(block) :: this_block ! block information for current block + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + integer :: i, j, k, iblk, n, i1, j1 ! incides + !real(kind=real_kind), pointer :: dataPtr1d(:,:) ! mesh + real(kind=real_kind), pointer :: dataPtr3d(:,:,:) ! mesh + + character(len=*), parameter :: subname='(ice_import_export:state_getimport_4d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataPtr3d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! set values of output array + do k = 1, ncat + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + output(i,j,k,index,iblk) = real(dataPtr3d(i1,j1,k), kind=dbl_kind) + end do + end do + end do + end do + + end subroutine state_getimport_4d + + !=============================================================================== + subroutine state_getimport_3d(state, fldname, output, index, rc) + + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real (kind=dbl_kind) , intent(inout) :: output(:,:,:,:) + integer , intent(in) :: index + integer , intent(out) :: rc + + ! local variables + type(block) :: this_block ! block information for current block + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + integer :: i, j, iblk, n, i1, j1 ! incides + real(kind=real_kind),pointer :: dataPtr2d(:,:) ! mesh + character(len=*) , parameter :: subname='(ice_import_export:state_getimport_3d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataPtr2d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine output array + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + output(i,j,index,iblk) = real(dataPtr2d(i1, j1), kind=dbl_kind) + end do + end do + end do + + end subroutine state_getimport_3d + + !=============================================================================== + subroutine arr_setexport_4d(output, input, rc) + + ! ---------------------------------------------- + ! Map 4d input array to export state field + ! ---------------------------------------------- + + ! input/output variables + real(kind=real_kind) , intent(out) :: output(:,:,:) + real(kind=dbl_kind) , intent(in) :: input(:,:,:,:) + integer , intent(out) :: rc + + ! local variables + type(block) :: this_block ! block information for current block + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + integer :: i, j, k, iblk, n, i1, j1 ! indices + character(len=*), parameter :: subname='(ice_import_export:arr_setexport_4d)' + ! ---------------------------------------------- + + + do k = 1, ncat + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + output(i1,j1,k) = real(input(i,j,k,iblk), kind=real_kind) + end do + end do + end do + end do + + rc = ESMF_SUCCESS + + end subroutine arr_setexport_4d + + !=============================================================================== + subroutine arr_setexport_3d(output, input, rc) + + ! ---------------------------------------------- + ! Map 3d input array to export array + ! ---------------------------------------------- + + ! input/output variables + real(kind=real_kind) , intent(out) :: output(:,:) + real(kind=dbl_kind) , intent(in) :: input(:,:,:) + integer , intent(out) :: rc + + ! local variables + type(block) :: this_block ! block information for current block + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + integer :: i, j, k, iblk, n, i1, j1 ! indices + character(len=*), parameter :: subname='(ice_import_export:arr_setexport_3d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + output(i1,j1) = real(input(i,j,iblk), kind=real_kind) + end do + end do + end do + + end subroutine arr_setexport_3d + + !=============================================================================== + subroutine state_setexport_4d(state, fldname, input, rc) + + ! ---------------------------------------------- + ! Map 4d input array to export state field + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + real(kind=dbl_kind) , intent(in) :: input(:,:,:,:) + integer , intent(out) :: rc + + ! local variables + type(block) :: this_block ! block information for current block + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + integer :: i, j, k, iblk, n, i1, j1 ! indices + real(kind=real_kind), pointer :: dataPtr3d(:,:,:) ! mesh + character(len=*), parameter :: subname='(ice_import_export:state_setexport_4d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataPtr3d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do k = 1, ncat + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + dataPtr3d(i1,j1,k) = real(input(i,j,k,iblk), kind=real_kind) + end do + end do + end do + end do + + end subroutine state_setexport_4d + + !=============================================================================== + subroutine state_setexport_3d(state, fldname, input, rc) + + ! ---------------------------------------------- + ! Map 3d input array to export state field + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + real(kind=dbl_kind) , intent(in) :: input(:,:,:) + integer , intent(out) :: rc + + ! local variables + type(block) :: this_block ! block information for current block + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + integer :: i, j, iblk, n, i1, j1 ! incides + real(kind=real_kind), pointer :: dataPtr2d(:,:) ! mesh + integer :: num_ice + character(len=*), parameter :: subname='(ice_import_export:state_setexport_3d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataPtr2d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + 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 + j1 = j - nghost + do i = ilo, ihi + i1 = i - nghost + dataPtr2d(i1, j1) = input(i,j,iblk) + end do + end do + end do + + end subroutine state_setexport_3d + + !=============================================================================== + subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(kind=real_kind), pointer , intent(inout) :: fldptr(:) + integer, optional , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + character(len=*),parameter :: subname='(ice_import_export:State_GetFldPtr_1d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine State_GetFldPtr_1d + + !=============================================================================== + subroutine state_getfldptr_2d(state, fldname, fldptr, rc) + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(kind=real_kind), pointer , intent(inout) :: fldptr(:,:) + integer , optional , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + character(len=*),parameter :: subname='(ice_import_export:State_GetFldPtr_2d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine state_getfldptr_2d + + subroutine State_GetFldPtr_3d(State, fldname, fldptr, rc) + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(kind=real_kind), pointer , intent(inout) :: fldptr(:,:,:) + integer , optional , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + character(len=*),parameter :: subname='(ice_import_export:State_GetFldPtr_3d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine State_GetFldPtr_3d + +end module ice_import_export diff --git a/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 b/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 new file mode 100644 index 000000000..ef0b6ca59 --- /dev/null +++ b/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 @@ -0,0 +1,489 @@ +module ice_prescribed_mod + + ! !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. + + +#ifndef CESMCOUPLED + + use ice_kinds_mod + implicit none + private ! except + public :: ice_prescribed_init ! initialize input data stream + logical(kind=log_kind), parameter, public :: prescribed_ice = .false. ! true if prescribed ice +contains + ! This is a stub routine for now + subroutine ice_prescribed_init(rc) + integer , intent(out) :: rc + ! do nothing + end subroutine ice_prescribed_init + +#else + + use ESMF + use ice_kinds_mod + use shr_nl_mod , only : shr_nl_find_group_name + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_print + use dshr_strdata_mod , only : shr_strdata_init_from_inline, shr_strdata_advance + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use ice_broadcast + use ice_communicate , only : my_task, master_task, MPI_COMM_ICE + 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, tarea, grid_type, ocn_gridcell_frac + use ice_calendar , only : idate, calendar_type + use ice_arrays_column , only : hin_max + use ice_read_write + use ice_exit , only: abort_ice + use icepack_intfc , only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc , only: icepack_query_tracer_indices, icepack_query_tracer_sizes + use icepack_intfc , only: icepack_query_parameters + use ice_shr_methods , only: chkerr + + implicit none + private ! except + + ! 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 + + ! private data members: + type(shr_strdata_type) :: sdat ! prescribed data stream + real(kind=dbl_kind),allocatable :: ice_cov(:,:,:) ! ice cover + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!======================================================================= +contains +!=============================================================================== + + subroutine ice_prescribed_init(clock, mesh, rc) + + ! Prescribed ice initialization + + include 'mpif.h' + + ! input/output parameters + type(ESMF_Clock) , intent(in) :: clock + type(ESMF_Mesh) , intent(in) :: mesh + integer , intent(out) :: rc + + ! local parameters + integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files + integer(kind=int_kind) :: n, nFile, ierr + integer(kind=int_kind) :: nml_error ! namelist i/o error flag + character(len=char_len_long) :: stream_meshFile + character(len=char_len_long) :: stream_dataFiles(nFilesMaximum) + character(len=char_len_long) :: stream_varname + character(len=char_len_long) :: stream_mapalgo + integer(kind=int_kind) :: stream_yearfirst ! first year in stream to use + integer(kind=int_kind) :: stream_yearlast ! last year in stream to use + integer(kind=int_kind) :: stream_yearalign ! align stream_year_first + integer(kind=int_kind) :: nu_nml + logical :: prescribed_ice_mode + character(*),parameter :: subName = "('ice_prescribed_init')" + character(*),parameter :: F00 = "('(ice_prescribed_init) ',4a)" + character(*),parameter :: F01 = "('(ice_prescribed_init) ',a,i0)" + character(*),parameter :: F02 = "('(ice_prescribed_init) ',2a,i0,)" + !-------------------------------- + + namelist /ice_prescribed_nml/ & + prescribed_ice_mode, & + stream_meshfile, & + stream_varname , & + stream_datafiles, & + stream_mapalgo, & + stream_yearalign, & + stream_yearfirst , & + stream_yearlast + + rc = ESMF_SUCCESS + + ! default values for namelist + prescribed_ice_mode = .false. ! if true, prescribe ice + stream_yearfirst = 1 ! first year in pice stream to use + stream_yearlast = 1 ! last year in pice stream to use + stream_yearalign = 1 ! align stream_year_first with this model year + stream_varname = 'ice_cov' + stream_meshfile = ' ' + stream_datafiles(:) = ' ' + stream_mapalgo = 'bilinear' + + ! read namelist on master task + if (my_task == master_task) then + open (newunit=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 + write(nu_diag,F00) "ERROR: problem on read of ice_prescribed_nml namelist" + call abort_ice(subName) + endif + read(nu_nml, ice_prescribed_nml, iostat=nml_error) + close(nu_nml) + end if + + ! broadcast namelist input + call broadcast_scalar(prescribed_ice_mode, master_task) + + ! set module variable 'prescribed_ice' + prescribed_ice = prescribed_ice_mode + + ! -------------------------------------------------- + ! only do the following if prescribed ice mode is on + ! -------------------------------------------------- + + if (prescribed_ice_mode) then + + call broadcast_scalar(stream_yearalign , master_task) + call broadcast_scalar(stream_yearfirst , master_task) + call broadcast_scalar(stream_yearlast , master_task) + call broadcast_scalar(stream_meshfile , master_task) + call broadcast_scalar(stream_mapalgo , master_task) + call broadcast_scalar(stream_varname , master_task) + call mpi_bcast(stream_dataFiles, len(stream_datafiles(1))*NFilesMaximum, MPI_CHARACTER, 0, MPI_COMM_ICE, ierr) + + nFile = 0 + do n = 1,nFilesMaximum + if (stream_datafiles(n) /= ' ') nFile = nFile + 1 + end do + + if (my_task == master_task) then + write(nu_diag,*) ' ' + write(nu_diag,F00) 'This is the prescribed ice coverage option.' + write(nu_diag,F01) ' stream_yearfirst = ',stream_yearfirst + write(nu_diag,F01) ' stream_yearlast = ',stream_yearlast + write(nu_diag,F01) ' stream_yearalign = ',stream_yearalign + write(nu_diag,F00) ' stream_meshfile = ',trim(stream_meshfile) + write(nu_diag,F00) ' stream_varname = ',trim(stream_varname) + write(nu_diag,F00) ' stream_mapalgo = ',trim(stream_mapalgo) + do n = 1,nFile + write(nu_diag,F00) ' stream_datafiles = ',trim(stream_dataFiles(n)) + end do + write(nu_diag,*) ' ' + endif + + ! initialize sdat + call shr_strdata_init_from_inline(sdat, & + my_task = my_task, & + logunit = nu_diag, & + compname = 'ICE', & + model_clock = clock, & + model_mesh = mesh, & + stream_meshfile = stream_meshfile, & + stream_lev_dimname = 'null', & + stream_mapalgo = trim(stream_mapalgo), & + stream_filenames = stream_datafiles(1:nfile), & + stream_fldlistFile = (/'ice_cov'/), & + stream_fldListModel = (/'ice_cov'/), & + stream_yearFirst = stream_yearFirst, & + stream_yearLast = stream_yearLast, & + stream_yearAlign = stream_yearAlign , & + stream_offset = 0, & + stream_taxmode = 'cycle', & + stream_dtlimit = 1.5_dbl_kind, & + stream_tintalgo = 'linear', & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! print out sdat info + if (my_task == master_task) then + call shr_strdata_print(sdat,'ice coverage prescribed 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 if ! end of if prescribed ice mode + + end subroutine ice_prescribed_init + + !======================================================================= + subroutine ice_prescribed_run(mDateIn, secIn) + + ! Finds two time slices bounding current model time, remaps if necessary + ! Interpolate to new ice coverage + + ! 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 + + ! local variables + 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 + real(kind=dbl_kind), pointer :: dataptr(:) + integer :: rc ! ESMF return code + character(*),parameter :: subName = "('ice_prescribed_run')" + character(*),parameter :: F00 = "('(ice_prescribed_run) ',a,2g20.13)" + logical :: first_time = .true. + !------------------------------------------------------------------------ + + rc = ESMF_SUCCESS + + ! Advance sdat stream + call shr_strdata_advance(sdat, ymd=mDateIn, tod=SecIn, logunit=nu_diag, istr='cice_pice', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! Get pointer for stream data that is time and spatially interpolate to model time and grid + call dshr_fldbun_getFldPtr(sdat%pstrm(1)%fldbun_model, 'ice_cov', dataptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! Fill in module ice_cov array + if (.not. allocated(ice_cov)) then + allocate(ice_cov(nx_block,ny_block,max_blocks)) + end if + 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) = dataptr(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 + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + end if + first_time = .false. + end if + + ! Set prescribed ice state and fluxes + call ice_prescribed_phys() + + end subroutine ice_prescribed_run + + !======================================================================= + subroutine ice_prescribed_phys() + + ! Set prescribed ice state using input ice concentration; + ! set surface ice temperature to atmospheric value; use + ! linear temperature gradient in ice to ocean temperature. + + use ice_flux + use ice_state + use icepack_intfc, only : icepack_aggregate + use ice_dyn_evp + + !----- 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 + integer(kind=int_kind) :: nt_Tsfc + integer(kind=int_kind) :: nt_sice + integer(kind=int_kind) :: nt_qice + integer(kind=int_kind) :: nt_qsno + integer(kind=int_kind) :: ntrcr + 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) :: rad_to_deg, pi, puny + real(kind=dbl_kind) :: rhoi + real(kind=dbl_kind) :: rhos + real(kind=dbl_kind) :: cp_ice + real(kind=dbl_kind) :: cp_ocn + real(kind=dbl_kind) :: lfresh + real(kind=dbl_kind) :: depressT + 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) + character(*),parameter :: subName = '(ice_prescribed_phys)' + !----------------------------------------------------------------- + + call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_sice_out=nt_sice, & + nt_qice_out=nt_qice, nt_qsno_out=nt_qsno) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_query_parameters(rad_to_deg_out=rad_to_deg, pi_out=pi, & + puny_out=puny, rhoi_out=rhoi, rhos_out=rhos, cp_ice_out=cp_ice, cp_ocn_out=cp_ocn, & + lfresh_out=lfresh, depressT_out=depressT) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! 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 + + !-------------------------------------------------------------------- + ! compute aggregate ice state and open water area + !-------------------------------------------------------------------- + call icepack_aggregate(ncat = ncat, & + aicen = aicen(i,j,:,iblk), & + trcrn = trcrn(i,j,1:ntrcr,:,iblk), & + vicen = vicen(i,j,:,iblk), & + vsnon = vsnon(i,j,:,iblk), & + aice = aice (i,j, iblk), & + trcr = trcr (i,j,1:ntrcr,iblk), & + vice = vice (i,j, iblk), & + vsno = vsno (i,j, iblk), & + aice0 = aice0(i,j, iblk), & + ntrcr = ntrcr, & + trcr_depend = trcr_depend(1:ntrcr), & + trcr_base = trcr_base(1:ntrcr,:), & + n_trcr_strata = n_trcr_strata(1:ntrcr), & + nt_strata = nt_strata(1:ntrcr,:)) + + end if ! tmask + enddo ! i + enddo ! j + 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 + +#endif + +end module ice_prescribed_mod diff --git a/cicecore/drivers/mapl/geos/ice_record_mod.F90 b/cicecore/drivers/mapl/geos/ice_record_mod.F90 new file mode 100644 index 000000000..557872e7b --- /dev/null +++ b/cicecore/drivers/mapl/geos/ice_record_mod.F90 @@ -0,0 +1,165 @@ + + module ice_record_mod + + use ice_kinds_mod + use ice_constants, only: field_loc_center, field_type_scalar, c0 + use ice_domain_size, only: max_blocks, ncat + use ice_communicate, only: my_task, master_task + use ice_blocks, only: nx_block, ny_block + use ice_state, only: aicen, vicen, vsnon, trcrn + use ice_flux + use ice_exit, only: abort_ice + use ice_fileunits, only: nu_diag + use icepack_intfc, only: icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + + implicit none + private + public :: alloc_record_state, save_record_state, restore_record_state + + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable :: & + aicen_save , & ! concentration of ice + vicen_save , & ! volume per unit area of ice (m) + vsnon_save ! volume per unit area of snow (m) + + + real (kind=dbl_kind), & + dimension (:,:,:,:,:), allocatable :: & + trcrn_save ! tracers + ! 1: surface temperature of ice/snow (C) + + contains + + subroutine alloc_record_state + integer (int_kind) :: ntrcr, ierr + character(len=*),parameter :: subname='(alloc_record_state)' + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + allocate ( aicen_save(nx_block,ny_block,ncat,max_blocks) , & ! concentration of ice + vicen_save(nx_block,ny_block,ncat,max_blocks) , & ! volume per unit area of ice (m) + vsnon_save(nx_block,ny_block,ncat,max_blocks) , & ! volume per unit area of snow (m) + trcrn_save(nx_block,ny_block,ntrcr,ncat,max_blocks) , & ! tracers: 1: surface temperature of ice/snow (C) + stat=ierr) + if (ierr/=0) call abort_ice('(alloc_record_state): Out of memory1') + + + aicen_save = c0 + vicen_save = c0 + vsnon_save = c0 + trcrn_save = c0 + + end subroutine alloc_record_state + + subroutine save_record_state + + character(len=*),parameter :: subname='(save_record_state)' + + if (.not. allocated(trcrn_save)) & + call abort_ice(error_message=subname//': trcrn_save not allocated', & + file=__FILE__, line=__LINE__) + + + aicen_save(:,:,:,:) = aicen(:,:,:,:) + vicen_save(:,:,:,:) = vicen(:,:,:,:) + vsnon_save(:,:,:,:) = vsnon(:,:,:,:) + trcrn_save(:,:,:,:,:) = trcrn(:,:,:,:,:) + + if(my_task == master_task) then + write(*,*), 'CICE6 thermo state saved' + endif + + end subroutine save_record_state + + subroutine restore_record_state + + use ice_flux_bgc, only: flux_bio_atm, flux_bio, faero_atm, fiso_atm, & + fnit, famm, fsil, fdmsp, fdms, fhum, fdust, falgalN, & + fdoc, fdon, fdic, ffed, ffep + + + character(len=*),parameter :: subname='(restore_record_state)' + real (kind=dbl_kind) :: stefan_boltzmann, Tffresh + + call icepack_query_parameters(stefan_boltzmann_out=stefan_boltzmann, & + Tffresh_out=Tffresh) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + + if (.not. allocated(trcrn_save)) & + call abort_ice(error_message=subname//': trcrn_save not allocated', & + file=__FILE__, line=__LINE__) + + aicen(:,:,:,:) = aicen_save(:,:,:,:) + vicen(:,:,:,:) = vicen_save(:,:,:,:) + vsnon(:,:,:,:) = vsnon_save(:,:,:,:) + trcrn(:,:,:,:,:) = trcrn_save(:,:,:,:,:) + + + fsens (:,:,:) = c0 + flat (:,:,:) = c0 + fswabs (:,:,:) = c0 + fswint_ai(:,:,:) = c0 + flwout (:,:,:) = -stefan_boltzmann*Tffresh**4 + ! in case atm model diagnoses Tsfc from flwout + evap (:,:,:) = c0 + evaps (:,:,:) = c0 + evapi (:,:,:) = c0 + Tref (:,:,:) = c0 + Qref (:,:,:) = c0 + Uref (:,:,:) = c0 + + + + fresh (:,:,:) = c0 + fsalt (:,:,:) = c0 + fpond (:,:,:) = c0 + fhocn (:,:,:) = c0 + fswthru (:,:,:) = c0 + fswthru_vdr (:,:,:) = c0 + fswthru_vdf (:,:,:) = c0 + fswthru_idr (:,:,:) = c0 + fswthru_idf (:,:,:) = c0 + fswthru_uvrdr (:,:,:) = c0 + fswthru_uvrdf (:,:,:) = c0 + fswthru_pardr (:,:,:) = c0 + fswthru_pardf (:,:,:) = c0 + + alvdr (:,:,:) = c0 + alidr (:,:,:) = c0 + alvdf (:,:,:) = c0 + alidf (:,:,:) = c0 + + + fresh_da(:,:,:) = c0 ! data assimilation + fsalt_da(:,:,:) = c0 + flux_bio(:,:,:,:) = c0 ! bgc + fnit (:,:,:) = c0 + fsil (:,:,:) = c0 + famm (:,:,:) = c0 + fdmsp (:,:,:) = c0 + fdms (:,:,:) = c0 + fhum (:,:,:) = c0 + fdust (:,:,:) = c0 + falgalN(:,:,:,:)= c0 + fdoc (:,:,:,:)= c0 + fdic (:,:,:,:)= c0 + fdon (:,:,:,:)= c0 + ffep (:,:,:,:)= c0 + ffed (:,:,:,:)= c0 + + + if(my_task == master_task) then + write(*,*), 'CICE6 thermo state restored' + endif + + end subroutine restore_record_state + + end module ice_record_mod diff --git a/cicecore/drivers/mapl/geos/ice_shr_methods.F90 b/cicecore/drivers/mapl/geos/ice_shr_methods.F90 new file mode 100644 index 000000000..2e9bfb3ad --- /dev/null +++ b/cicecore/drivers/mapl/geos/ice_shr_methods.F90 @@ -0,0 +1,33 @@ +module ice_shr_methods + + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + + implicit none + private + + public :: chkerr + + +!=============================================================================== +contains +!=============================================================================== + + + logical function chkerr(rc, line, file) + + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + + integer :: lrc + character(len=*), parameter :: subname='(chkerr)' + + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + +end module ice_shr_methods diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index 337828d60..38f3ee0f7 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -112,7 +112,11 @@ module ice_arrays_column 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) + fswthrun_uvrdr,& ! vis uvr dir SW through ice to ocean (W/m^2) + fswthrun_uvrdf,& ! vis uvr dif SW through ice to ocean (W/m^2) + fswthrun_pardr,& ! vis par dir SW through ice to ocean (W/m^2) + fswthrun_pardf,& ! vis par 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, public :: & fswpenln ! visible SW entering ice layers (W m-2) @@ -320,6 +324,10 @@ subroutine alloc_arrays_column 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) + fswthrun_uvrdr(nx_block,ny_block,ncat,max_blocks), & ! vis uvr dir SW uhrough ice to ocean (W/m^2) + fswthrun_uvrdf(nx_block,ny_block,ncat,max_blocks), & ! vis uvr dif SW through ice to ocean (W/m^2) + fswthrun_pardr(nx_block,ny_block,ncat,max_blocks), & ! vis par dir SW through ice to ocean (W/m^2) + fswthrun_pardf(nx_block,ny_block,ncat,max_blocks), & ! vis par 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_calendar.F90 b/cicecore/shared/ice_calendar.F90 index c4a8dd16e..ac8fa62d7 100644 --- a/cicecore/shared/ice_calendar.F90 +++ b/cicecore/shared/ice_calendar.F90 @@ -212,7 +212,7 @@ subroutine init_calendar ! this avoids using it uninitialzed in 'calendar' below nstreams = 0 -#ifdef CESMCOUPLED +#if defined (CESMCOUPLED) || defined (GEOSCOUPLED) ! calendar_type set by coupling #else calendar_type = '' @@ -401,7 +401,9 @@ subroutine calendar() !--- compute other stuff -#ifndef CESMCOUPLED +#if defined (CESMCOUPLED) || defined (GEOSCOUPLED) + ! skip setting stop_now and dump_last write_restart +#else if (istep >= npt+1) stop_now = 1 if (istep == npt .and. dump_last) write_restart = 1 ! last timestep #endif diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 2aae83326..abf02295f 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -165,6 +165,7 @@ subroutine init_shortwave use ice_arrays_column, only: fswpenln, Iswabsn, Sswabsn, albicen, & albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, & fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswthrun_uvrdr, fswthrun_uvrdf, fswthrun_pardr, fswthrun_pardf, & fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, & swgrid, igrid use ice_blocks, only: block, get_block @@ -176,7 +177,7 @@ subroutine init_shortwave alvdr_ai, alidr_ai, alvdf_ai, alidf_ai, & swvdr, swvdf, swidr, swidf, scale_factor, snowfrac, & albice, albsno, albpnd, apeff_ai, coszen, fsnow - use ice_grid, only: tlat, tlon, tmask + use ice_grid, only: tlat, tlon, tmask, opmask use ice_restart_shared, only: restart, runtype use ice_state, only: aicen, vicen, vsnon, trcrn @@ -287,6 +288,11 @@ subroutine init_shortwave alidrn(i,j,n,iblk) = c0 alvdfn(i,j,n,iblk) = c0 alidfn(i,j,n,iblk) = c0 + albpndn(i,j,n,iblk) = c0 + albicen(i,j,n,iblk) = c0 + albsnon(i,j,n,iblk) = c0 + apeffn(i,j,n,iblk) = c0 + snowfracn(i,j,n,iblk) = c0 fswsfcn(i,j,n,iblk) = c0 fswintn(i,j,n,iblk) = c0 fswthrun(i,j,n,iblk) = c0 @@ -294,6 +300,10 @@ subroutine init_shortwave fswthrun_vdf(i,j,n,iblk) = c0 fswthrun_idr(i,j,n,iblk) = c0 fswthrun_idf(i,j,n,iblk) = c0 + fswthrun_uvrdr(i,j,n,iblk) = c0 + fswthrun_uvrdf(i,j,n,iblk) = c0 + fswthrun_pardr(i,j,n,iblk) = c0 + fswthrun_pardf(i,j,n,iblk) = c0 enddo ! ncat enddo @@ -303,7 +313,9 @@ subroutine init_shortwave if (shortwave(1:4) == 'dEdd') then ! delta Eddington -#ifndef CESMCOUPLED +#if defined (CESMCOUPLED) || defined (GEOSCOUPLED) + ! initialized externally +#else ! initialize orbital parameters ! These come from the driver in the coupled model. call icepack_init_orbit() @@ -325,7 +337,7 @@ subroutine init_shortwave endif enddo - if (tmask(i,j,iblk)) then + if (tmask(i,j,iblk) .or. opmask(i,j,iblk)) then call icepack_step_radiation (dt=dt, & fbri=fbri(:), & aicen=aicen(i,j,:,iblk), & diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 63d5f9953..eb9620122 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -274,6 +274,19 @@ cat >> ${jobfile} << EOFB ##SBATCH --qos=standby EOFB +else if (${ICE_MACHINE} =~ discover*) then +cat >> ${jobfile} << EOFB +#SBATCH -J ${ICE_CASENAME} +#SBATCH -t ${ICE_RUNLENGTH} +#SBATCH -A ${acct} +#SBATCH -N ${nnodes} +#SBATCH -e slurm%j.err +#SBATCH -o slurm%j.out +###SBATCH --mail-type END,FAIL +###SBATCH --mail-user=eclare@lanl.gov +#SBATCH --qos=debug +EOFB + else if (${ICE_MACHINE} =~ fram*) then cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 533ecad9c..a2c38e597 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -163,6 +163,18 @@ srun -n ${ntasks} -c ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE EOFR endif +#======= +else if (${ICE_MACHCOMP} =~ discover*) then +if (${ICE_COMMDIR} =~ serial*) then +cat >> ${jobfile} << EOFR +./cice >&! \$ICE_RUNLOG_FILE +EOFR +else +cat >> ${jobfile} << EOFR +mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE +EOFR +endif + #======= else if (${ICE_MACHCOMP} =~ fram*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 73603534f..093f647c1 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -302,6 +302,8 @@ ocn_data_format = 'bin' ocn_data_dir = '/unknown_ocn_data_dir' oceanmixed_file = 'unknown_oceanmixed_file' + geos_heatflux = .false. + geos_massflux = .false. / &domain_nml diff --git a/configuration/scripts/machines/Macros.discover_intel b/configuration/scripts/machines/Macros.discover_intel new file mode 100644 index 000000000..173646777 --- /dev/null +++ b/configuration/scripts/machines/Macros.discover_intel @@ -0,0 +1,42 @@ +#============================================================================== +# Makefile macros for NASA NCCS discover, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -xHost + +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -xHost +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +else + FFLAGS += -O2 +endif + +SCC := mpiicc +SFC := mpiifort +CC := $(SCC) +FC := $(SFC) +LD := $(FC) + +NETCDF_INCLUDES := $(shell $$BASEDIR/Linux/bin/nf-config --cflags) +NETCDF_LIBS := $(shell $$BASEDIR/Linux/bin/nf-config --flibs) + +INCLDIR := $(INCLDIR) +INCLDIR += $(NETCDF_INCLUDES) + +LIB_NETCDF := $(NETCDF_LIBS) +#LIB_MPI := $(IMPILIBDIR) + +SLIBS := $(LIB_NETCDF) + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/env.discover_intel b/configuration/scripts/machines/env.discover_intel new file mode 100755 index 000000000..9a4e81ff2 --- /dev/null +++ b/configuration/scripts/machines/env.discover_intel @@ -0,0 +1,54 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source /usr/share/modules/init/csh + +module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES12 + +module purge +module load GEOSenv +module load comp/gcc/10.1.0 +module load comp/intel/2021.3.0 +module load mpi/impi/2021.3.0 +module load python/GEOSpyD/Min4.11.0_py3.9 + +endif + +## Baselibs + +set basedir = /discover/swdev/gmao_SIteam/Baselibs/ESMA-Baselibs-6.2.13/x86_64-pc-linux-gnu/ifort_2021.3.0-intelmpi_2021.3.0 +setenv BASEDIR $basedir + +set arch = `uname -s` +if ($?LD_LIBRARY_PATH) then + echo $LD_LIBRARY_PATH | grep $BASEDIR/$arch/lib > /dev/null + if ($status) then # == 1, if not found + setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:$BASEDIR/$arch/lib + endif +else + setenv LD_LIBRARY_PATH $BASEDIR/$arch/lib +endif + +setenv PATH $BASEDIR/$arch/bin:$PATH + + +setenv ICE_MACHINE_MACHNAME discover +setenv ICE_MACHINE_MACHINFO "Discover" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "ifort (IFORT) 2021.3.0 20210609" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /discover/nobackup/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /home/bzhao/aogcm/CICE_INPUT +setenv ICE_MACHINE_BASELINE /discover/nobackup/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch" +setenv ICE_MACHINE_ACCT g0609 +setenv ICE_MACHINE_QUEUE "share" +setenv ICE_MACHINE_TPNODE 36 +setenv ICE_MACHINE_BLDTHRDS 1 +setenv ICE_MACHINE_QSTAT "squeue " diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index cf99ba738..2e5c665d7 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -309,7 +309,7 @@ section :ref:`tabnamelist`. "grid_ocn_dynv", "grid for ocn dynamic-v forcing/coupling fields, 'T', 'U', 'N', 'E'", "" "grid_ocn_thrm", "grid for ocn thermodynamic forcing/coupling fields, 'T', 'U', 'N', 'E'", "" "grid_outfile", "write one-time grid history file", "" - "grid_type", "‘rectangular’, ‘displaced_pole’, ‘column’ or ‘regional’", "" + "grid_type", "grid input file type, ‘rectangular’, ‘displaced_pole’, 'tripole', etc", "" "gridcpl_file", "input file for coupling grid info", "" "grow_net", "specific biogeochemistry growth rate per grid cell", "s :math:`^{-1}`" "Gstar", "piecewise-linear ridging participation function parameter", "0.15" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index a03ce8c73..1215ff03c 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -315,7 +315,10 @@ grid_nml "", "``C``", "ocn forcing/coupling grid, thermo fields on T grid, dynu fields on E grid, dynv fields on N grid", "" "", "``CD``", "ocn forcing/coupling grid, thermo fields on T grid, dyn fields on N and E grid", "" "``grid_outfile``", "logical", "write one-time grid history file", "``.false.``" - "``grid_type``", "``displaced_pole``", "read from file in *popgrid*", "``rectangular``" + "``grid_type``", "``column``", "latlon grid with single column set", "``rectangular``" + "", "``displaced_pole``", "read from file in *popgrid*", "" + "", "``geosmom``", "read in *geosgrid*", "" + "", "``latlon``", "read in *latlongrid*", "" "", "``rectangular``", "defined in *rectgrid*", "" "", "``regional``", "read from file in *popgrid*", "" "", "``tripole``", "read from file in *popgrid*", "" @@ -365,7 +368,8 @@ domain_nml "", "``spiralcenter``", "distribute blocks via roundrobin from center of grid outward in a spiral", "" "", "``wghtfile``", "distribute blocks based on weights specified in ``distribution_wght_file``", "" "``distribution_wght``", "``block``", "full block weight method with land block elimination", "``latitude``" - "", "``blockall``", "full block weight method without land block elimination", "" + "", "``blockall``", "block weight method with NO land block elimination", "" + "", "``blockfull``", "full block weight method with NO land block elimination", "" "", "``latitude``", "latitude/ocean sets ``work_per_block``", "" "``distribution_wght_file``", "string", "distribution weight file when distribution_type is ``wghtfile``", "'unknown'" "``ew_boundary_type``", "``cyclic``", "periodic boundary conditions in x-direction", "``cyclic``" @@ -690,6 +694,8 @@ forcing_nml "", "``default``", "default forcing value for iron", "" "``formdrag``", "logical", "calculate form drag", "``.false.``" "``fyear_init``", "integer", "first year of atmospheric forcing data", "1900" + "``geos_heatflux``", "logical", "GEOS heatflux coupling calculation based on d(hf)/dTs", "``.false.``" + "``geos_massflux``", "logical", "GEOS mass/enthalpy coupling adjustment", "``.false.``" "``highfreq``", "logical", "high-frequency atmo coupling", "``.false.``" "``ice_data_conc``", "``box2001``", "ice distribution ramped from 0 to 1 west to east consistent with :ref:`box2001` test (:cite:`Hunke01`)", "``default``" "", "``c1``", "initial ice concentation of 1.0", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 9a3d04bc5..f98f310e9 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -733,8 +733,10 @@ each block and is written with a lot of array syntax requiring calculations over entire blocks (whether or not land is present). This option is provided in CICE as well for direct-communication compatibility with POP. Blocks that contain 100% -land grid cells are eliminated with 'block'. The 'blockall' option is identical -to 'block' but does not do land block elimination. The ‘latitude’ option +land grid cells are eliminated with 'block'. The 'blockfull' option is identical +to 'block' but does not do land block elimination. The 'blockall' option +does not do land block elimination and blocks with all land are given +minimal weight. The ‘latitude’ option weights the blocks based on latitude and the number of ocean grid cells they contain. Many of the non-cartesian decompositions support automatic land block elimination and provide alternative ways to From c214f2b46165deba85dc10dc7759e6fc7c1d01d7 Mon Sep 17 00:00:00 2001 From: apcraig Date: Sun, 16 Mar 2025 13:20:04 -0600 Subject: [PATCH 02/11] Remove trailing blanks --- cicecore/cicedyn/general/ice_flux.F90 | 6 +- cicecore/cicedyn/general/ice_init.F90 | 2 +- .../cicedyn/infrastructure/ice_domain.F90 | 10 +-- cicecore/cicedyn/infrastructure/ice_grid.F90 | 2 +- cicecore/drivers/mapl/geos/CICE_FinalMod.F90 | 2 +- cicecore/drivers/mapl/geos/CICE_InitMod.F90 | 22 +++--- cicecore/drivers/mapl/geos/CICE_RunMod.F90 | 68 +++++++++--------- .../drivers/mapl/geos/ice_import_export.F90 | 72 +++++++++---------- .../drivers/mapl/geos/ice_prescribed_mod.F90 | 2 +- cicecore/drivers/mapl/geos/ice_record_mod.F90 | 4 +- 10 files changed, 91 insertions(+), 99 deletions(-) diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index bdce9d7d0..654780afc 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -589,8 +589,8 @@ subroutine alloc_flux fsensn_f (nx_block,ny_block,ncat,max_blocks), & ! sensible heat flux (W m-2) flatn_f (nx_block,ny_block,ncat,max_blocks), & ! latent heat flux (W m-2) evapn_f (nx_block,ny_block,ncat,max_blocks), & ! evaporative water flux (kg/m^2/s) by atmosphere model - dflatndTs_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of flatn with respect to Ts - dfsurfndTs_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of fsurfn with respect to Ts + dflatndTs_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of flatn with respect to Ts + dfsurfndTs_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of fsurfn with respect to Ts meltsn (nx_block,ny_block,ncat,max_blocks), & ! snow melt in category n (m) melttn (nx_block,ny_block,ncat,max_blocks), & ! top melt in category n (m) meltbn (nx_block,ny_block,ncat,max_blocks), & ! bottom melt in category n (m) @@ -1263,7 +1263,7 @@ subroutine scale_fluxes (nx_block, ny_block, & flat (i,j) = flat (i,j) * ar fswabs (i,j) = fswabs (i,j) * ar ! Special case where aice_init was zero and aice > 0. - if (flwout(i,j) > -puny) & + if (flwout(i,j) > -puny) & flwout (i,j) = -stefan_boltzmann *(Tf(i,j) + Tffresh)**4 flwout (i,j) = flwout (i,j) * ar evap (i,j) = evap (i,j) * ar diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index fbad53ea6..73cb5f86f 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -3387,7 +3387,7 @@ subroutine set_state_var (nx_block, ny_block, & elseif (trim(ice_data_type) == 'uniform' .or. trim(ice_data_type) == 'box2001') then ! all cells not land mask are ice - ! box2001 used to have a check for west of 50W, this was changed, so now box2001 is + ! box2001 used to have a check for west of 50W, this was changed, so now box2001 is ! the same as uniform. keep box2001 option for backwards compatibility. icells = 0 do j = jlo, jhi diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index bc4cc5302..ddf35b6e9 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -96,7 +96,7 @@ module ice_domain !*********************************************************************** - subroutine init_domain_blocks(npes, blkx, blky) + subroutine init_domain_blocks ! This routine reads in domain information and calls the routine ! to set up the block decomposition. @@ -106,9 +106,6 @@ subroutine init_domain_blocks(npes, blkx, blky) nx_global, ny_global, block_size_x, block_size_y use ice_fileunits, only: goto_nml - integer (int_kind), intent(in), optional :: & - npes, blkx, blky ! set block from outside - !---------------------------------------------------------------------- ! ! local variables @@ -207,11 +204,6 @@ subroutine init_domain_blocks(npes, blkx, blky) close(nu_nml) call release_fileunit(nu_nml) - ! override if passed in - if (present(npes)) nprocs = npes - if (present(blkx)) block_size_x = blkx - if (present(blky)) block_size_y = blky - endif call broadcast_scalar(nprocs, master_task) diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index e577b7d8a..1d718cca4 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -552,7 +552,7 @@ subroutine init_grid2 else call abort_ice(subname//'ERROR: binary format for GEOS-MOM grid not supported', & file=__FILE__, line=__LINE__) - endif + endif #ifdef CESMCOUPLED elseif (trim(grid_type) == 'latlon') then call latlongrid ! lat lon grid for sequential CESM (CAM mode) diff --git a/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 b/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 index 056832fed..e9b24ba8e 100644 --- a/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 +++ b/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 @@ -20,7 +20,7 @@ module CICE_FinalMod implicit none private - public :: CICE_Finalize, ice_checkpoint + public :: CICE_Finalize, ice_checkpoint !======================================================================= diff --git a/cicecore/drivers/mapl/geos/CICE_InitMod.F90 b/cicecore/drivers/mapl/geos/CICE_InitMod.F90 index 18b5dfbbb..b390a55a5 100644 --- a/cicecore/drivers/mapl/geos/CICE_InitMod.F90 +++ b/cicecore/drivers/mapl/geos/CICE_InitMod.F90 @@ -12,7 +12,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags - use icepack_intfc, only: icepack_init_parameters + use icepack_intfc, only: icepack_init_parameters use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes implicit none @@ -37,7 +37,7 @@ subroutine cice_init1(mpi_comm, npes, blkx, blky, dtg, k2c, alhl, alhs) use ice_communicate , only: init_communicate, my_task, master_task use ice_init_column , only: input_zbgc, count_tracers use ice_grid , only: init_grid1, alloc_grid - use ice_calendar , only: set_time_step + use ice_calendar , only: set_time_step use ice_domain , only: init_domain_blocks use ice_arrays_column , only: alloc_arrays_column use ice_state , only: alloc_state @@ -50,19 +50,19 @@ subroutine cice_init1(mpi_comm, npes, blkx, blky, dtg, k2c, alhl, alhs) mpi_comm ! communicator for sequential geos integer (kind=int_kind), intent(in) :: & - npes, blkx, blky, dtg ! + npes, blkx, blky, dtg ! real(kind=real_kind), intent(in) :: & - k2c, alhl, alhs ! + k2c, alhl, alhs ! character(len=*), parameter :: subname = '(cice_init1)' !---------------------------------------------------- call init_communicate(mpi_comm) ! initial setup for message passing call init_fileunits ! unit numbers - call icepack_init_parameters(Tffresh_in = real(k2c, kind=dbl_kind)) - call icepack_init_parameters(Lvap_in = real(alhl, kind=dbl_kind)) - call icepack_init_parameters(Lsub_in = real(alhs, kind=dbl_kind)) + call icepack_init_parameters(Tffresh_in = real(k2c, kind=dbl_kind)) + call icepack_init_parameters(Lvap_in = real(alhl, kind=dbl_kind)) + call icepack_init_parameters(Lsub_in = real(alhs, kind=dbl_kind)) call icepack_configure() ! initialize icepack call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & @@ -96,7 +96,7 @@ subroutine cice_delayed_init character(len=*), parameter :: subname = '(cice_delayed_init)' !---------------------------------------------------- - call init_grid2 ! finish building grid + call init_grid2 ! finish building grid end subroutine cice_delayed_init @@ -111,7 +111,7 @@ subroutine cice_cal_init(yr, mo, dy, hr, mn, sc) !---------------------------------------------------- integer (kind=int_kind), intent(in) :: & - yr, mo, dy, hr, mn, sc + yr, mo, dy, hr, mn, sc call init_calendar(yr, mo, dy, hr, mn, sc) ! initialize some calendar stuff @@ -152,7 +152,7 @@ subroutine cice_init2!(yr, mo, dy, hr, mn, sc) ! integer (kind=int_kind), intent(in) :: & - ! yr, mo, dy, hr, mn, sc + ! yr, mo, dy, hr, mn, sc logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers logical(kind=log_kind) :: tr_iso, tr_fsd, wave_spec, tr_snow @@ -160,7 +160,7 @@ subroutine cice_init2!(yr, mo, dy, hr, mn, sc) character(len=*), parameter :: subname = '(cice_init2)' !---------------------------------------------------- - call init_grid2 ! finish building grid + call init_grid2 ! finish building grid call init_zbgc ! vertical biogeochemistry initialization !call init_calendar(yr, mo, dy, hr, mn, sc) ! initialize some calendar stuff call init_hist (dt) ! initialize output history file diff --git a/cicecore/drivers/mapl/geos/CICE_RunMod.F90 b/cicecore/drivers/mapl/geos/CICE_RunMod.F90 index ce7d7f361..46b86c865 100644 --- a/cicecore/drivers/mapl/geos/CICE_RunMod.F90 +++ b/cicecore/drivers/mapl/geos/CICE_RunMod.F90 @@ -345,7 +345,7 @@ subroutine ice_step call ice_timer_stop(timer_readwrite) ! reading/writing end subroutine ice_step - + !======================================================================= ! ! Prepare for coupling @@ -446,7 +446,7 @@ subroutine coupling_prep (iblk) alidf(i,j,iblk) = c0 alvdr(i,j,iblk) = c0 alidr(i,j,iblk) = c0 - + fswthru_vdr(i,j,iblk) = c0 fswthru_vdf(i,j,iblk) = c0 fswthru_idr(i,j,iblk) = c0 @@ -492,7 +492,7 @@ subroutine coupling_prep (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) - + fswthru_vdr(i,j,iblk) = fswthru_vdr(i,j,iblk) & + fswthrun_vdr(i,j,n,iblk)*aicen(i,j,n,iblk) fswthru_vdf(i,j,iblk) = fswthru_vdf(i,j,iblk) & @@ -606,7 +606,7 @@ subroutine coupling_prep (iblk) fiso_evap=fiso_evap(:,:,:,iblk), & fiso_ocn =fiso_ocn (:,:,:,iblk), & Uref=Uref(:,:,iblk), wind=wind(:,:,iblk) ) - + !----------------------------------------------------------------- ! Define ice-ocean bgc fluxes !----------------------------------------------------------------- @@ -679,7 +679,7 @@ subroutine coupling_atm (iblk) real (kind=dbl_kind) :: & cszn , & ! counter for history averaging puny , & ! - ar , & + ar , & stefan_boltzmann, & Tffresh , & rhofresh , & ! @@ -722,7 +722,7 @@ subroutine coupling_atm (iblk) 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 @@ -841,33 +841,33 @@ subroutine coupling_atm (iblk) fswthru_pardr (i,j,iblk) = fswthru_pardr (i,j,iblk) * ar fswthru_pardf (i,j,iblk) = fswthru_pardf (i,j,iblk) * ar else - fsens (i,j,iblk) = c0 - flat (i,j,iblk) = c0 - fswabs (i,j,iblk) = c0 - flwout (i,j,iblk) = -stefan_boltzmann *(Tf(i,j,iblk) + Tffresh)**4 - fsurf (i,j,iblk) = c0 - fcondtop(i,j,iblk) = c0 + fsens (i,j,iblk) = c0 + flat (i,j,iblk) = c0 + fswabs (i,j,iblk) = c0 + flwout (i,j,iblk) = -stefan_boltzmann *(Tf(i,j,iblk) + Tffresh)**4 + fsurf (i,j,iblk) = c0 + fcondtop(i,j,iblk) = c0 evap (i,j,iblk) = c0 Tref (i,j,iblk) = Tair (i,j,iblk) - Qref (i,j,iblk) = Qa (i,j,iblk) - Uref (i,j,iblk) = wind (i,j,iblk) - fswthru (i,j,iblk) = c0 - fswthru_vdr (i,j,iblk) = c0 - fswthru_vdf (i,j,iblk) = c0 + Qref (i,j,iblk) = Qa (i,j,iblk) + Uref (i,j,iblk) = wind (i,j,iblk) + fswthru (i,j,iblk) = c0 + fswthru_vdr (i,j,iblk) = c0 + fswthru_vdf (i,j,iblk) = c0 fswthru_idr (i,j,iblk) = c0 fswthru_idf (i,j,iblk) = c0 - alvdr (i,j,iblk) = c0 - alidr (i,j,iblk) = c0 - alvdf (i,j,iblk) = c0 - alidf (i,j,iblk) = c0 - fswthru_uvrdr (i,j,iblk) = c0 + alvdr (i,j,iblk) = c0 + alidr (i,j,iblk) = c0 + alvdf (i,j,iblk) = c0 + alidf (i,j,iblk) = c0 + fswthru_uvrdr (i,j,iblk) = c0 fswthru_uvrdf (i,j,iblk) = c0 fswthru_pardr (i,j,iblk) = c0 fswthru_pardf (i,j,iblk) = c0 endif enddo - enddo + enddo call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling @@ -914,7 +914,7 @@ subroutine coupling_ocn (iblk) real (kind=dbl_kind) :: & cszn , & ! counter for history averaging puny , & ! - ar , & ! + ar , & ! rhofresh , & ! netsw ! flag for shortwave radiation presence @@ -948,7 +948,7 @@ subroutine coupling_ocn (iblk) ! Store grid box mean albedos and fluxes before scaling by aice !---------------------------------------------------------------- - fresh_ai (i,j,iblk) = fresh (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) @@ -989,8 +989,8 @@ subroutine coupling_ocn (iblk) endif enddo - enddo - + enddo + !----------------------------------------------------------------- ! Define ice-ocean bgc fluxes !----------------------------------------------------------------- @@ -1096,7 +1096,7 @@ subroutine ice_fast_physics !----------------------------------------------------------------- if (restore_ice) call ice_HaloRestore - + !----------------------------------------------------------------- ! initialize diagnostics and save initial state values @@ -1147,7 +1147,7 @@ subroutine ice_fast_physics !----------------------------------------------------------------- ! thermodynamics and biogeochemistry !----------------------------------------------------------------- - + call step_therm1 (dt, iblk) ! vertical thermodynamics if (debug_model) then plabeld = 'post step_therm1' @@ -1213,7 +1213,7 @@ subroutine ice_radiation integer (kind=int_kind) :: & ilo, ihi, jlo, jhi - + type (block) :: & this_block ! block information for current block @@ -1283,10 +1283,10 @@ subroutine ice_radiation alvdf (i,j,iblk) = alvdf (i,j,iblk) * ar alidf (i,j,iblk) = alidf (i,j,iblk) * ar else - alvdr (i,j,iblk) = c0 - alidr (i,j,iblk) = c0 - alvdf (i,j,iblk) = c0 - alidf (i,j,iblk) = c0 + alvdr (i,j,iblk) = c0 + alidr (i,j,iblk) = c0 + alvdf (i,j,iblk) = c0 + alidf (i,j,iblk) = c0 endif enddo ! i enddo ! j diff --git a/cicecore/drivers/mapl/geos/ice_import_export.F90 b/cicecore/drivers/mapl/geos/ice_import_export.F90 index 14002ef44..124100001 100644 --- a/cicecore/drivers/mapl/geos/ice_import_export.F90 +++ b/cicecore/drivers/mapl/geos/ice_import_export.F90 @@ -11,7 +11,7 @@ module ice_import_export use ice_flux , only : strairxt, strairyt, strocnxT_iavg, strocnyT_iavg 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 : evapn_f, fsurfn_f, dfsurfndts_f, dflatndts_f + use ice_flux , only : evapn_f, fsurfn_f, dfsurfndts_f, dflatndts_f use ice_flux , only : flatn_f, coszen use ice_flux , only : fswthru_uvrdr, fswthru_uvrdf, fswthru_pardr, fswthru_pardf use ice_flux , only : send_i2x_per_cat, fswthrun_ai @@ -29,10 +29,10 @@ module ice_import_export use ice_state , only : vice, vsno, aice, aicen, trcr, trcrn use ice_state , only : Tsfcn_init, aice_init, uvel, vvel use ice_grid , only : tlon, tlat, tarea, tmask, umask, anglet, ocn_gridcell_frac, hm - use ice_grid , only : dxu, dyu, dxE, dyE, dxN, dyN, nmask, emask + use ice_grid , only : dxu, dyu, dxE, dyE, dxN, dyN, nmask, emask use ice_grid , only : grid_type, grid_ice use ice_boundary , only : ice_HaloUpdate - use ice_shr_methods , only : chkerr + use ice_shr_methods , only : chkerr use ice_fileunits , only : nu_diag, flush_fileunit use ice_communicate , only : my_task, master_task, MPI_COMM_ICE use ice_prescribed_mod , only : prescribed_ice @@ -54,9 +54,9 @@ module ice_import_export public :: ice_export_field interface ice_export_field - module procedure ice_export_field_2d - module procedure ice_export_field_3d - end interface ice_export_field + module procedure ice_export_field_2d + module procedure ice_export_field_3d + end interface ice_export_field private :: state_FldChk @@ -137,7 +137,7 @@ subroutine ice_import_grid( fro, rc ) rc = ESMF_SUCCESS - end subroutine ice_import_grid + end subroutine ice_import_grid !=============================================================================== subroutine ice_import_thermo1( importState, rc ) @@ -254,7 +254,7 @@ subroutine ice_import_thermo1( importState, rc ) !$OMP END PARALLEL DO - + !== will change to read in from coupler once Tf from MOM is ready !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks @@ -330,7 +330,7 @@ subroutine ice_import_dyna( taux, tauy, slv, uob, vob, uoc, voc, rc ) integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain type(block) :: this_block ! block information for current block real(kind=dbl_kind) :: workx, worky - real(kind=dbl_kind) :: ssh(nx_block,ny_block,max_blocks) + real(kind=dbl_kind) :: ssh(nx_block,ny_block,max_blocks) character(len=*), parameter :: subname = 'ice_import_dyna' character(len=1024) :: msgString !----------------------------------------------------- @@ -343,24 +343,24 @@ subroutine ice_import_dyna( taux, tauy, slv, uob, vob, uoc, voc, rc ) jlo = this_block%jlo jhi = this_block%jhi do j = jlo, jhi - j1 = j - nghost + j1 = j - nghost do i = ilo, ihi - i1 = i - nghost + i1 = i - nghost if(tmask(i,j,iblk)) then - workx = real(taux(i1, j1), kind=dbl_kind) - worky = real(tauy(i1, j1), kind=dbl_kind) + workx = real(taux(i1, j1), kind=dbl_kind) + worky = real(tauy(i1, j1), kind=dbl_kind) strairxT(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + worky*sin(ANGLET(i,j,iblk)) ! note strax, stray, wind strairyT(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & ! are on the T-grid here - workx*sin(ANGLET(i,j,iblk)) - ! multiply by aice to properly treat free drift - strairxT(i,j,iblk) = strairxT(i,j,iblk) * aice_init(i,j,iblk) - strairyT(i,j,iblk) = strairyT(i,j,iblk) * aice_init(i,j,iblk) + ! multiply by aice to properly treat free drift + strairxT(i,j,iblk) = strairxT(i,j,iblk) * aice_init(i,j,iblk) + strairyT(i,j,iblk) = strairyT(i,j,iblk) * aice_init(i,j,iblk) ssh(i,j,iblk) = real(slv(i1,j1), kind=dbl_kind) else strairxT(i,j,iblk) = c0 - strairyT(i,j,iblk) = c0 - ssh(i,j,iblk) = c0 + strairyT(i,j,iblk) = c0 + ssh(i,j,iblk) = c0 endif if(trim(grid_ice) == 'B') then if(umask(i,j,iblk)) then @@ -393,8 +393,8 @@ subroutine ice_import_dyna( taux, tauy, slv, uob, vob, uoc, voc, rc ) field_loc_center, field_type_scalar) !*** if C-grid ice dynamics is on, the following needs to be revised - !*** so a query of which dynamics (B- or C-) should be made and branch into - !*** different computation of ss_tlt* terms + !*** so a query of which dynamics (B- or C-) should be made and branch into + !*** different computation of ss_tlt* terms do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo @@ -467,9 +467,9 @@ subroutine ice_export_dyna( tauxo, tauyo, ui, vi, rc ) jlo = this_block%jlo jhi = this_block%jhi do j = jlo, jhi - j1 = j - nghost + j1 = j - nghost do i = ilo, ihi - i1 = i - nghost + i1 = i - nghost ! ice/ocean stress (on POP T-grid: convert to lat-lon) workx = strocnxT_iavg(i,j,iblk) ! N/m^2 worky = strocnyT_iavg(i,j,iblk) ! N/m^2 @@ -619,14 +619,14 @@ subroutine ice_export_field_3d(fldname, fld, rc) file=u_FILE_u, line=__LINE__) if (trim(fldname) == 'TI') then - call arr_setexport_4d(fld, trcrn(:,:,1,:,:), rc) + call arr_setexport_4d(fld, trcrn(:,:,1,:,:), rc) fld(:,:,:) = real(Tffresh, kind=real_kind) + fld(:,:,:) !Kelvin (original ???) elseif (trim(fldname) == 'FRSEAICE') then - call arr_setexport_4d(fld, aicen, rc) + call arr_setexport_4d(fld, aicen, rc) else call ESMF_LogWrite(trim(subname)//": "//trim(fldname)//" not available for export", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE - return + return endif end subroutine ice_export_field_3d @@ -645,17 +645,17 @@ subroutine ice_export_field_2d(fldname, fld, rc) rc = ESMF_SUCCESS if (trim(fldname) == 'FRACICE') then - call arr_setexport_3d(fld, aice, rc) + call arr_setexport_3d(fld, aice, rc) elseif (trim(fldname) == 'FHOCN') then - call arr_setexport_3d(fld, fhocn_ai, rc) + call arr_setexport_3d(fld, fhocn_ai, rc) elseif (trim(fldname) == 'FRESH') then - call arr_setexport_3d(fld, fresh_ai, rc) + call arr_setexport_3d(fld, fresh_ai, rc) elseif (trim(fldname) == 'FSALT') then - call arr_setexport_3d(fld, fsalt_ai, rc) + call arr_setexport_3d(fld, fsalt_ai, rc) else call ESMF_LogWrite(trim(subname)//": "//trim(fldname)//" not available for export", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE - return + return endif end subroutine ice_export_field_2d @@ -713,7 +713,7 @@ subroutine state_getimport_4d(state, fldname, output, index, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! set values of output array - do k = 1, ncat + do k = 1, ncat do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo @@ -721,9 +721,9 @@ subroutine state_getimport_4d(state, fldname, output, index, rc) jlo = this_block%jlo jhi = this_block%jhi do j = jlo, jhi - j1 = j - nghost + j1 = j - nghost do i = ilo, ihi - i1 = i - nghost + i1 = i - nghost output(i,j,k,index,iblk) = real(dataPtr3d(i1,j1,k), kind=dbl_kind) end do end do @@ -801,7 +801,7 @@ subroutine arr_setexport_4d(output, input, rc) ! ---------------------------------------------- - do k = 1, ncat + do k = 1, ncat do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo; ihi = this_block%ihi @@ -885,7 +885,7 @@ subroutine state_setexport_4d(state, fldname, input, rc) ! get field pointer call state_getfldptr(state, trim(fldname), dataPtr3d, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do k = 1, ncat + do k = 1, ncat do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo; ihi = this_block%ihi @@ -943,7 +943,7 @@ subroutine state_setexport_3d(state, fldname, input, rc) do j = jlo, jhi j1 = j - nghost do i = ilo, ihi - i1 = i - nghost + i1 = i - nghost dataPtr2d(i1, j1) = input(i,j,iblk) end do end do diff --git a/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 b/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 index ef0b6ca59..d5d917c23 100644 --- a/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 +++ b/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 @@ -173,7 +173,7 @@ subroutine ice_prescribed_init(clock, mesh, rc) end do write(nu_diag,*) ' ' endif - + ! initialize sdat call shr_strdata_init_from_inline(sdat, & my_task = my_task, & diff --git a/cicecore/drivers/mapl/geos/ice_record_mod.F90 b/cicecore/drivers/mapl/geos/ice_record_mod.F90 index 557872e7b..b8cdbf0d6 100644 --- a/cicecore/drivers/mapl/geos/ice_record_mod.F90 +++ b/cicecore/drivers/mapl/geos/ice_record_mod.F90 @@ -30,7 +30,7 @@ module ice_record_mod trcrn_save ! tracers ! 1: surface temperature of ice/snow (C) - contains + contains subroutine alloc_record_state integer (int_kind) :: ntrcr, ierr @@ -64,7 +64,7 @@ subroutine save_record_state call abort_ice(error_message=subname//': trcrn_save not allocated', & file=__FILE__, line=__LINE__) - + aicen_save(:,:,:,:) = aicen(:,:,:,:) vicen_save(:,:,:,:) = vicen(:,:,:,:) vsnon_save(:,:,:,:) = vsnon(:,:,:,:) From 6aacde6edf65bf02751b525a50ffbac4ccdec9d0 Mon Sep 17 00:00:00 2001 From: bzhao Date: Wed, 26 Mar 2025 13:21:42 -0400 Subject: [PATCH 03/11] updates/fixes to make it wiork with new GEOS PR --- cicecore/drivers/mapl/geos/CICE_InitMod.F90 | 19 ++++++++++--------- cicecore/shared/ice_init_column.F90 | 11 +++++++++++ 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/cicecore/drivers/mapl/geos/CICE_InitMod.F90 b/cicecore/drivers/mapl/geos/CICE_InitMod.F90 index b390a55a5..2f7da8cf9 100644 --- a/cicecore/drivers/mapl/geos/CICE_InitMod.F90 +++ b/cicecore/drivers/mapl/geos/CICE_InitMod.F90 @@ -37,7 +37,7 @@ subroutine cice_init1(mpi_comm, npes, blkx, blky, dtg, k2c, alhl, alhs) use ice_communicate , only: init_communicate, my_task, master_task use ice_init_column , only: input_zbgc, count_tracers use ice_grid , only: init_grid1, alloc_grid - use ice_calendar , only: set_time_step + !use ice_calendar , only: set_time_step use ice_domain , only: init_domain_blocks use ice_arrays_column , only: alloc_arrays_column use ice_state , only: alloc_state @@ -69,11 +69,12 @@ subroutine cice_init1(mpi_comm, npes, blkx, blky, dtg, k2c, alhl, alhs) file=__FILE__,line= __LINE__) call input_data ! namelist variables - call set_time_step(dtg) ! reset time step from coupler + !call set_time_step(dtg) ! reset time step from coupler call input_zbgc ! vertical biogeochemistry namelist call count_tracers ! count tracers - call init_domain_blocks(npes, blkx, blky) ! set up block decomposition + !call init_domain_blocks(npes, blkx, blky) ! set up block decomposition + call init_domain_blocks ! set up block decomposition call init_grid1 ! domain distribution call alloc_grid ! allocate grid arrays call alloc_arrays_column ! allocate column arrays @@ -113,7 +114,8 @@ subroutine cice_cal_init(yr, mo, dy, hr, mn, sc) integer (kind=int_kind), intent(in) :: & yr, mo, dy, hr, mn, sc - call init_calendar(yr, mo, dy, hr, mn, sc) ! initialize some calendar stuff + !call init_calendar(yr, mo, dy, hr, mn, sc) ! initialize some calendar stuff + call init_calendar ! initialize some calendar stuff end subroutine cice_cal_init @@ -178,9 +180,9 @@ subroutine cice_init2!(yr, mo, dy, hr, mn, sc) call init_coupler_flux ! initialize fluxes exchanged with coupler call init_thermo_vertical ! initialize vertical thermodynamics - call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution + call icepack_init_itd(hin_max=hin_max) ! ice thickness distribution if (my_task == master_task) then - call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output + call icepack_init_itd_hist(hin_max=hin_max, c_hi_range=c_hi_range) ! output endif call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) @@ -188,7 +190,7 @@ subroutine cice_init2!(yr, mo, dy, hr, mn, sc) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_fsd) call icepack_init_fsd_bounds (nfsd, & ! floe size distribution + if (tr_fsd) call icepack_init_fsd_bounds ( & floe_rad_l, & ! fsd size lower bound in m (radius) floe_rad_c, & ! fsd size bin centre in m (radius) floe_binwidth, & ! fsd size bin width in m (radius) @@ -492,7 +494,7 @@ subroutine init_restart() do j = 1, ny_block do i = 1, nx_block if (tmask(i,j,iblk) .or. opmask(i,j,iblk)) then - call icepack_aggregate(ncat = ncat, & + call icepack_aggregate( & aicen = aicen(i,j,:,iblk), & trcrn = trcrn(i,j,:,:,iblk), & vicen = vicen(i,j,:,iblk), & @@ -502,7 +504,6 @@ subroutine init_restart() vice = vice (i,j, iblk), & vsno = vsno (i,j, iblk), & aice0 = aice0(i,j, iblk), & - ntrcr = ntrcr, & trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index abf02295f..18e3cb3ba 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -176,6 +176,7 @@ subroutine init_shortwave use ice_flux, only: alvdf, alidf, alvdr, alidr, & alvdr_ai, alidr_ai, alvdf_ai, alidf_ai, & swvdr, swvdf, swidr, swidf, scale_factor, snowfrac, & + swuvrdr, swuvrdf, swpardr, swpardf, & albice, albsno, albpnd, apeff_ai, coszen, fsnow use ice_grid, only: tlat, tlon, tmask, opmask use ice_restart_shared, only: restart, runtype @@ -282,6 +283,10 @@ subroutine init_shortwave albpnd(i,j,iblk) = c0 snowfrac(i,j,iblk) = c0 apeff_ai(i,j,iblk) = c0 + swuvrdr(i,j,iblk) = c0 + swuvrdf(i,j,iblk) = c0 + swpardr(i,j,iblk) = c0 + swpardf(i,j,iblk) = c0 do n = 1, ncat alvdrn(i,j,n,iblk) = c0 @@ -359,6 +364,8 @@ subroutine init_shortwave sec=msec, & swvdr=swvdr(i,j,iblk), swvdf=swvdf(i,j,iblk),& swidr=swidr(i,j,iblk), swidf=swidf(i,j,iblk),& + swuvrdr=swuvrdr(i,j,iblk), swuvrdf=swuvrdf (i,j,iblk), & + swpardr=swpardr(i,j,iblk), swpardf=swpardf (i,j,iblk), & coszen=coszen(i,j,iblk), fsnow=fsnow(i,j,iblk),& alvdrn=alvdrn(i,j,:,iblk), alvdfn=alvdfn(i,j,:,iblk), & alidrn=alidrn(i,j,:,iblk), alidfn=alidfn(i,j,:,iblk), & @@ -368,6 +375,10 @@ subroutine init_shortwave fswthrun_vdf=fswthrun_vdf(i,j,:,iblk), & fswthrun_idr=fswthrun_idr(i,j,:,iblk), & fswthrun_idf=fswthrun_idf(i,j,:,iblk), & + fswthrun_uvrdr=fswthrun_uvrdr (i,j,: ,iblk), & + fswthrun_uvrdf=fswthrun_uvrdf (i,j,: ,iblk), & + fswthrun_pardr=fswthrun_pardr (i,j,: ,iblk), & + fswthrun_pardf=fswthrun_pardf (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), & From 25c9dd9c38783f3864651f2a31f57233292d4872 Mon Sep 17 00:00:00 2001 From: bzhao Date: Wed, 26 Mar 2025 15:10:40 -0400 Subject: [PATCH 04/11] rearrange zero initialization; fixed a bug in restert filename_spec --- cicecore/cicedyn/general/ice_flux.F90 | 9 +++++++++ .../cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 | 2 +- cicecore/shared/ice_init_column.F90 | 4 ---- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index 654780afc..dcfa1face 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -609,6 +609,11 @@ subroutine alloc_flux stat=ierr) if (ierr/=0) call abort_ice('(alloc_flux): Out of memory') + swuvrdr(:,:,:) = c0 + swuvrdf(:,:,:) = c0 + swpardr(:,:,:) = c0 + swpardf(:,:,:) = c0 + if (grid_ice == "CD" .or. grid_ice == "C") & allocate( & taubxN (nx_block,ny_block,max_blocks), & ! seabed stress (x) at N points (N/m^2) @@ -929,6 +934,10 @@ subroutine init_flux_ocn fswthru_vdf (:,:,:) = c0 fswthru_idr (:,:,:) = c0 fswthru_idf (:,:,:) = c0 + fswthru_uvrdr(:,:,:) = c0 + fswthru_uvrdf(:,:,:) = c0 + fswthru_pardr(:,:,:) = c0 + fswthru_pardf(:,:,:) = c0 faero_ocn (:,:,:,:) = c0 fiso_ocn (:,:,:,:) = c0 diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index 3c0c126b0..e4e7341e0 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -147,7 +147,7 @@ subroutine init_restart_write(filename_spec) use ice_dyn_shared, only: kdyn use ice_grid, only: grid_ice - character(len=char_len_long), intent(in), optional :: filename_spec + character(len=*), intent(in), optional :: filename_spec ! local variables diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 18e3cb3ba..ec7d40981 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -283,10 +283,6 @@ subroutine init_shortwave albpnd(i,j,iblk) = c0 snowfrac(i,j,iblk) = c0 apeff_ai(i,j,iblk) = c0 - swuvrdr(i,j,iblk) = c0 - swuvrdf(i,j,iblk) = c0 - swpardr(i,j,iblk) = c0 - swpardf(i,j,iblk) = c0 do n = 1, ncat alvdrn(i,j,n,iblk) = c0 From 0466ca65bef1debe2dc597dd43f9726df0c931fa Mon Sep 17 00:00:00 2001 From: bzhao Date: Wed, 26 Mar 2025 15:39:46 -0400 Subject: [PATCH 05/11] fixed indentation --- cicecore/cicedyn/general/ice_flux.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index dcfa1face..fa49238d9 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -609,10 +609,10 @@ subroutine alloc_flux stat=ierr) if (ierr/=0) call abort_ice('(alloc_flux): Out of memory') - swuvrdr(:,:,:) = c0 - swuvrdf(:,:,:) = c0 - swpardr(:,:,:) = c0 - swpardf(:,:,:) = c0 + swuvrdr(:,:,:) = c0 + swuvrdf(:,:,:) = c0 + swpardr(:,:,:) = c0 + swpardf(:,:,:) = c0 if (grid_ice == "CD" .or. grid_ice == "C") & allocate( & From caa2cf6f344735e3666d70dfeb514ce0a03e04d0 Mon Sep 17 00:00:00 2001 From: bzhao Date: Wed, 23 Apr 2025 09:38:55 -0400 Subject: [PATCH 06/11] allow A-grid currents and sea surface height tilt terms --- .../drivers/mapl/geos/ice_import_export.F90 | 57 ++++++++++++++++++- 1 file changed, 55 insertions(+), 2 deletions(-) diff --git a/cicecore/drivers/mapl/geos/ice_import_export.F90 b/cicecore/drivers/mapl/geos/ice_import_export.F90 index 124100001..1f03a228e 100644 --- a/cicecore/drivers/mapl/geos/ice_import_export.F90 +++ b/cicecore/drivers/mapl/geos/ice_import_export.F90 @@ -362,7 +362,19 @@ subroutine ice_import_dyna( taux, tauy, slv, uob, vob, uoc, voc, rc ) strairyT(i,j,iblk) = c0 ssh(i,j,iblk) = c0 endif - if(trim(grid_ice) == 'B') then + if(trim(grid_ocn) == 'A') then + if(tmask(i,j,iblk)) then + workx = real(uoa(i1,j1), kind=dbl_kind) + worky = real(voa(i1,j1), kind=dbl_kind) + uocn(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + worky*sin(ANGLET(i,j,iblk)) ! note strax, stray, wind + vocn(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & ! are on the T-grid here + - workx*sin(ANGLET(i,j,iblk)) + else + uocn(i,j,iblk) = c0 + vocn(i,j,iblk) = c0 + endif + elseif(trim(grid_ice) == 'B') then if(umask(i,j,iblk)) then uocn(i,j,iblk) = real(uob(i1,j1), kind=dbl_kind) vocn(i,j,iblk) = real(vob(i1,j1), kind=dbl_kind) @@ -403,7 +415,48 @@ subroutine ice_import_dyna( taux, tauy, slv, uob, vob, uoc, voc, rc ) jhi = this_block%jhi do j = jlo, jhi do i = ilo, ihi - if(trim(grid_ice) == 'B') then + if(trim(grid_ocn) == 'A') then + if(tmask(i,j,iblk)) then + slp_L = ssh(I,j,iblk) - ssh(I-1,j,iblk) + if(.not. emask(i-1,j,iblk)) slp_L = c0 + slp_R = ssh(I+1,j,iblk) - ssh(I,j,iblk) + if(.not. emask(i,j,iblk)) slp_R = c0 + slp_C = p5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > c0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j,iblk), ssh(i,j,iblk), ssh(i+1,j,iblk) ) + u_max = max( ssh(i-1,j,iblk), ssh(i,j,iblk), ssh(i+1,j,iblk) ) + slope = sign( min( abs(slp_C), c2*min( ssh(i,j,iblk) - u_min, u_max - ssh(i,j,iblk) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = c0 + endif + ss_tltx(i,j,iblk) = slope / dxT(i,j,iblk) + + slp_L = ssh(I,j,iblk) - ssh(I,j-1,iblk) + if(.not. nmask(i,j-1,iblk)) slp_L = c0 + slp_R = ssh(I,j+1,iblk) - ssh(I,j,iblk) + if(.not. nmask(i,j,iblk)) slp_R = c0 + slp_C = p5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > c0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1,iblk), ssh(i,j,iblk), ssh(i,j+1,iblk) ) + u_max = max( ssh(i,j-1,iblk), ssh(i,j,iblk), ssh(i,j+1,iblk) ) + slope = sign( min( abs(slp_C), c2*min( ssh(i,j,iblk) - u_min, u_max - ssh(i,j,iblk) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = c0 + endif + ss_tlty(i,j,iblk) = slope / dyT(i,j,iblk) + else + ss_tltx(i,j,iblk) = c0 + ss_tlty(i,j,iblk) = c0 + endif + elseif(trim(grid_ice) == 'B') then if(umask(i,j,iblk)) then ss_tltx(i,j,iblk) = p5*(ssh(i+1,j+1,iblk)-ssh(i,j+1,iblk) & +ssh(i+1,j ,iblk)-ssh(i,j ,iblk)) & From 9341acf12c9e1b1c49f38f9ebe8c8e86f4199cd0 Mon Sep 17 00:00:00 2001 From: apcraig Date: Tue, 13 May 2025 20:02:13 -0600 Subject: [PATCH 07/11] Rebased to #95e581eb1d86cc06 on main and update implementation to be consistent with new grid implementation. --- cicecore/cicedyn/general/ice_init.F90 | 17 +- cicecore/cicedyn/infrastructure/ice_grid.F90 | 230 +++++------------- .../drivers/mapl/geos/ice_import_export.F90 | 2 +- .../drivers/mapl/geos/ice_prescribed_mod.F90 | 2 +- .../drivers/mct/cesm1/ice_import_export.F90 | 2 +- .../nuopc/cmeps/ice_prescribed_mod.F90 | 2 +- doc/source/user_guide/ug_case_settings.rst | 19 +- 7 files changed, 84 insertions(+), 190 deletions(-) diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 73cb5f86f..532667857 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -1222,6 +1222,9 @@ subroutine input_data if (trim(ice_data_dist) == 'default') ice_data_dist = 'uniform' if (trim(ice_data_type) == 'default') ice_data_type = 'latsst' + ! For backward compatibility + if (grid_format == 'nc') grid_format = 'pop_nc' + !----------------------------------------------------------------- ! verify inputs !----------------------------------------------------------------- @@ -1953,13 +1956,12 @@ subroutine input_data write(nu_diag,*) ' ' write(nu_diag,*) ' Grid, Discretization' write(nu_diag,*) '--------------------------------' - write(nu_diag,1030) ' grid_format = ',trim(grid_format) + write(nu_diag,1030) ' grid_format = ',trim(grid_format) tmpstr2 = ' ' if (trim(grid_type) == 'rectangular') tmpstr2 = ' : internally defined, rectangular grid' - if (trim(grid_type) == 'regional') tmpstr2 = ' : pop grid file, regional grid' - if (trim(grid_type) == 'displaced_pole') tmpstr2 = ' : pop grid file with rotated north pole' - if (trim(grid_type) == 'tripole') tmpstr2 = ' : pop grid file with northern hemisphere zipper' - if (trim(grid_type) == 'geosmom') tmpstr2 = ' : geos mom grid file' + if (trim(grid_type) == 'regional') tmpstr2 = ' : grid file, regional grid' + if (trim(grid_type) == 'displaced_pole') tmpstr2 = ' : grid file with rotated north pole' + if (trim(grid_type) == 'tripole') tmpstr2 = ' : grid file with northern hemisphere zipper' if (trim(grid_type) == 'latlon') tmpstr2 = ' : cesm latlon domain file' write(nu_diag,1030) ' grid_type = ',trim(grid_type),trim(tmpstr2) write(nu_diag,1030) ' grid_ice = ',trim(grid_ice) @@ -2687,11 +2689,9 @@ subroutine input_data endif ! my_task = master_task - ! For backward compatibility - if (grid_format == 'nc') grid_format = 'pop_nc' - if (grid_format /= 'pop_nc' .and. & grid_format /= 'mom_nc' .and. & + grid_format /= 'geosnc' .and. & grid_format /= 'meshnc' .and. & grid_format /= 'bin' ) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: unknown grid_format=',trim(grid_type) @@ -2703,7 +2703,6 @@ subroutine input_data grid_type /= 'column' .and. & grid_type /= 'rectangular' .and. & grid_type /= 'regional' .and. & - grid_type /= 'geosmom' .and. & grid_type /= 'latlon') then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: unknown grid_type=',trim(grid_type) abort_list = trim(abort_list)//":20" diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index 1d718cca4..fb2ef702b 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -253,7 +253,7 @@ subroutine alloc_grid stat=ierr) if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory1', file=__FILE__, line=__LINE__) - ocn_gridcell_frac(:,:,:) = c0 + ocn_gridcell_frac(:,:,:) = -c1 ! special value to start, will be ignored unless set elsewhere if (save_ghte_ghtn) then if (my_task == master_task) then @@ -273,7 +273,6 @@ subroutine alloc_grid end subroutine alloc_grid !======================================================================= - ! ! DeAllocate space for variables no longer needed after initialization ! @@ -291,7 +290,6 @@ subroutine dealloc_grid end subroutine dealloc_grid !======================================================================= - ! Distribute blocks across processors. The distribution is optimized ! based on latitude and topography, contained in the ULAT and KMT arrays. ! @@ -305,8 +303,8 @@ subroutine init_grid1 #endif integer (kind=int_kind) :: & - fid_grid, & ! file id for netCDF grid file - fid_kmt ! file id for netCDF kmt file + fid_grid, & ! file id for netCDF grid file + fid_kmt ! file id for netCDF kmt file character (char_len) :: & fieldname ! field name in netCDF file @@ -363,8 +361,7 @@ subroutine init_grid1 if (trim(grid_type) == 'displaced_pole' .or. & trim(grid_type) == 'tripole' .or. & - trim(grid_type) == 'regional' .or. & - trim(grid_type) == 'geosmom' ) then + trim(grid_type) == 'regional') then ! Fill ULAT select case(trim(grid_format)) @@ -394,7 +391,7 @@ subroutine init_grid1 deallocate(work_mom, stat=ierr) if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error', file=__FILE__, line=__LINE__) - case('pop_nc') + case('pop_nc', 'geosnc') fieldname='ulat' call ice_open_nc(grid_file,fid_grid) @@ -416,7 +413,7 @@ subroutine init_grid1 ! Fill kmt if (trim(kmt_type) =='file') then select case(trim(grid_format)) - case ('mom_nc', 'pop_nc') + case ('mom_nc', 'pop_nc', 'geosnc') ! mask variable name might be kmt or mask, check both call ice_open_nc(kmt_file,fid_kmt) @@ -480,7 +477,6 @@ subroutine init_grid1 end subroutine init_grid1 !======================================================================= - ! Horizontal grid initialization: ! ! U{LAT,LONG} = true {latitude,longitude} of U points @@ -505,8 +501,7 @@ subroutine init_grid2 ierr real (kind=dbl_kind) :: & - angle_0, angle_w, angle_s, angle_sw, & - pi, pi2, puny + angle_0, angle_w, angle_s, angle_sw, pi logical (kind=log_kind), dimension(nx_block,ny_block,max_blocks):: & out_of_range @@ -529,8 +524,8 @@ subroutine init_grid2 !----------------------------------------------------------------- l_readCenter = .false. + call icepack_query_parameters(pi_out=pi) - call icepack_query_parameters(pi_out=pi, pi2_out=pi2, puny_out=puny) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -540,19 +535,14 @@ subroutine init_grid2 trim(grid_type) == 'regional' ) then select case (trim(grid_format)) case('mom_nc') - call mom_grid ! derive cice grid from mom supergrid nc file + call mom_grid ! derive cice grid from MOM supergrid nc file case ('pop_nc') call popgrid_nc ! read POP grid lengths from nc file + case ('geosnc') + call geosgrid_nc ! read GEOS MOM grid used from nc file case default call popgrid ! read POP grid lengths directly end select - elseif (trim(grid_type) == 'geosmom') then - if (trim(grid_format) == 'nc') then - call geosgrid_nc ! tripolar grid used for GEOS-MOM coupled nodel - else - call abort_ice(subname//'ERROR: binary format for GEOS-MOM grid not supported', & - file=__FILE__, line=__LINE__) - endif #ifdef CESMCOUPLED elseif (trim(grid_type) == 'latlon') then call latlongrid ! lat lon grid for sequential CESM (CAM mode) @@ -567,12 +557,12 @@ subroutine init_grid2 hm(:,:,:) = c1 else if (trim(kmt_type) =='file') then select case (trim(grid_format)) - case('mom_nc', 'pop_nc') - call kmtmask_nc + case('mom_nc', 'pop_nc' ,'geosnc') + call kmtmask('nc') case default - call kmtmask - end select - endif !the other types are handled by rectgrid + call kmtmask('bin') + end select + endif ! the other types are handled by rectgrid !----------------------------------------------------------------- ! Diagnose OpenMP thread schedule, force order in output @@ -845,39 +835,55 @@ subroutine init_grid2 end subroutine init_grid2 !======================================================================= - ! POP land mask ! Land mask record number and field is (1) KMT. - subroutine kmtmask + subroutine kmtmask(filetype) + + character(len=*), intent(in) :: & + filetype ! 'nc' or 'bin' integer (kind=int_kind) :: & i, j, iblk, & - ilo,ihi,jlo,jhi ! beginning and end of physical domain + ilo,ihi,jlo,jhi ! beginning and end of physical domain + + integer (kind=int_kind) :: & + fid_kmt ! file id for netCDF kmt file logical (kind=log_kind) :: diag - real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & - work1 + real (kind=dbl_kind) :: & + puny type (block) :: & - this_block ! block information for current block + this_block ! block information for current block character(len=*), parameter :: subname = '(kmtmask)' - call ice_open(nu_kmt,kmt_file,32) + call icepack_query_parameters(puny_out=puny) diag = .true. ! write diagnostic info - !----------------------------------------------------------------- - ! topography - !----------------------------------------------------------------- kmt(:,:,:) = c0 hm (:,:,:) = c0 - call ice_read(nu_kmt,1,kmt,'ida4',diag, & - field_loc=field_loc_center, & - field_type=field_type_scalar) + if (filetype == 'bin') then + call ice_open(nu_kmt,kmt_file,32) + call ice_read(nu_kmt,1,kmt,'ida4',diag, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + if (my_task == master_task) then + close (nu_kmt) + endif + elseif (filetype == 'nc') then + call ice_open_nc(kmt_file,fid_kmt) + call ice_read_nc(fid_kmt,1,mask_fieldname,kmt,diag, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + call ice_close_nc(fid_kmt) + else + call abort_ice(subname//' ERROR: invalid filetype='//trim(filetype), file=__FILE__, line=__LINE__) + endif !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks @@ -889,20 +895,20 @@ subroutine kmtmask do j = jlo, jhi do i = ilo, ihi + ! force grid cells to land if ocn_gridcell_frac is defined + if (ocn_gridcell_frac(i,j,iblk) >= c0 .and. & + ocn_gridcell_frac(i,j,iblk) < puny) then + kmt(i,j,iblk) = c0 + endif if (kmt(i,j,iblk) >= p5) hm(i,j,iblk) = c1 enddo enddo enddo !$OMP END PARALLEL DO - if (my_task == master_task) then - close (nu_kmt) - endif - end subroutine kmtmask !======================================================================= - ! POP displaced pole grid (or tripole). ! Grid record number, field and units are: \\ ! (1) ULAT (radians) \\ @@ -977,60 +983,6 @@ subroutine popgrid end subroutine popgrid !======================================================================= - -! POP/MOM land mask. -! Land mask field is kmt or mask, saved in mask_fieldname. - - subroutine kmtmask_nc - - integer (kind=int_kind) :: & - i, j, iblk, & - ilo,ihi,jlo,jhi, & ! beginning and end of physical domain - fid_kmt ! file id for netCDF kmt file - - logical (kind=log_kind) :: diag - - real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & - work1 - - type (block) :: & - this_block ! block information for current block - - character(len=*), parameter :: subname = '(kmtmask_nc)' - - diag = .true. ! write diagnostic info - - hm (:,:,:) = c0 - kmt(:,:,:) = c0 - - call ice_open_nc(kmt_file,fid_kmt) - - call ice_read_nc(fid_kmt,1,mask_fieldname,kmt,diag, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - call ice_close_nc(fid_kmt) - - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) - 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 (kmt(i,j,iblk) >= c1) hm(i,j,iblk) = c1 - enddo - enddo - enddo - !$OMP END PARALLEL DO - - end subroutine kmtmask_nc - -!======================================================================= - ! POP displaced pole grid and land mask. ! Grid record number, field and units are: \\ ! (1) ULAT (radians) \\ @@ -1168,7 +1120,6 @@ end subroutine popgrid_nc #ifdef CESMCOUPLED !======================================================================= - ! Read in kmt file that matches CAM lat-lon grid and has single column ! functionality ! author: Mariana Vertenstein @@ -1217,7 +1168,6 @@ subroutine latlongrid real (kind=dbl_kind) :: & pos_scmlon,& ! temporary pi, & - puny, & scamdata ! temporary character(len=*), parameter :: subname = '(lonlatgrid)' @@ -1230,7 +1180,7 @@ subroutine latlongrid ! - Read in ocean from "kmt" file (1 for ocean, 0 for land) !----------------------------------------------------------------- - call icepack_query_parameters(pi_out=pi, puny_out=puny) + call icepack_query_parameters(pi_out=pi) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -2179,78 +2129,40 @@ subroutine geosgrid_nc integer (kind=int_kind) :: & i, j, iblk, & - ilo,ihi,jlo,jhi, & ! beginning and end of physical domain - fid_grid, & ! file id for netCDF grid file - fid_kmt ! file id for netCDF kmt file + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + fid_grid ! file id for netCDF grid file logical (kind=log_kind) :: diag character (char_len) :: & - fieldname ! field name in netCDF file + fieldname ! field name in netCDF file real (kind=dbl_kind) :: & - pi, puny + pi real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 - real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & - work1 - type (block) :: & - this_block ! block information for current block + this_block ! block information for current block integer(kind=int_kind) :: & varid integer (kind=int_kind) :: & status ! status flag - character(len=*), parameter :: subname = '(geosgrid_nc)' #ifdef USE_NETCDF - call icepack_query_parameters(pi_out=pi, puny_out=puny) + call icepack_query_parameters(pi_out=pi) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) call ice_open_nc(grid_file,fid_grid) - call ice_open_nc(kmt_file,fid_kmt) diag = .true. ! write diagnostic info l_readCenter = .false. - !----------------------------------------------------------------- - ! topography - !----------------------------------------------------------------- - - fieldname='kmt' - call ice_read_nc(fid_kmt,1,fieldname,work1,diag, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - hm (:,:,:) = c0 - kmt(:,:,:) = c0 - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) - 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 - kmt(i,j,iblk) = work1(i,j,iblk) - if (kmt(i,j,iblk) >= c1) hm(i,j,iblk) = c1 - ! set grid cells which are MOM ocean but land in GEOS to land - if (ocn_gridcell_frac(i,j,iblk) < puny) then - kmt(i,j,iblk) = c0 - hm(i,j,iblk) = c0 - endif - enddo - enddo - enddo - !$OMP END PARALLEL DO !----------------------------------------------------------------- ! lat, lon, angle @@ -2326,7 +2238,6 @@ subroutine geosgrid_nc if (my_task == master_task) then call ice_close_nc(fid_grid) - call ice_close_nc(fid_kmt) endif #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & @@ -2336,7 +2247,6 @@ subroutine geosgrid_nc end subroutine geosgrid_nc !======================================================================= - ! Regular rectangular grid and mask ! ! author: Elizabeth C. Hunke, LANL @@ -2694,7 +2604,6 @@ subroutine rectgrid_scale_dxdy end subroutine rectgrid_scale_dxdy !======================================================================= - ! Complex land mask for testing box cases ! Requires nx_global, ny_global > 20 ! Assumes work array has been initialized to 1 (ocean) and north and @@ -2822,7 +2731,6 @@ end subroutine grid_boxislands_kmt !======================================================================= - ! Calculate dxU and dxT from HTN on the global grid, to preserve ! ghost cell and/or land values that might otherwise be lost. Scatter ! dxU, dxT and HTN to all processors. @@ -3043,7 +2951,6 @@ subroutine primary_grid_lengths_HTE(work_g) end subroutine primary_grid_lengths_HTE !======================================================================= - ! This subroutine fills ghost cells in global extended grid subroutine global_ext_halo(array) @@ -3085,7 +2992,6 @@ subroutine global_ext_halo(array) end subroutine global_ext_halo !======================================================================= - ! Sets the boundary values for the T cell land mask (hm) and ! makes the logical land masks for T and U cells (tmask, umask) ! and N and E cells (nmask, emask). @@ -3245,7 +3151,6 @@ subroutine makemask end subroutine makemask !======================================================================= - ! Initializes latitude and longitude on T grid ! ! author: Elizabeth C. Hunke, LANL; code originally based on POP grid @@ -3373,7 +3278,6 @@ subroutine Tlatlon end subroutine Tlatlon !======================================================================= - ! Initializes latitude and longitude on N, E grid ! ! author: T. Craig from Tlatlon @@ -3571,7 +3475,6 @@ subroutine NElatlon end subroutine NElatlon !======================================================================= - ! Shifts quantities from one grid to another ! Constructs the shift based on the grid ! NOTE: Input array includes ghost cells that must be updated before @@ -3606,7 +3509,6 @@ subroutine grid_average_X2Y_base(type,work1,grid1,work2,grid2) end subroutine grid_average_X2Y_base !======================================================================= - ! Shifts quantities from one grid to another ! NOTE: Input array includes ghost cells that must be updated before ! calling this routine. @@ -3642,7 +3544,6 @@ subroutine grid_average_X2Y_userwghts(type,work1,grid1,wght1,mask1,work2,grid2) end subroutine grid_average_X2Y_userwghts !======================================================================= - ! Shifts quantities from one grid to another ! NOTE: Input array includes ghost cells that must be updated before ! calling this routine. @@ -3697,7 +3598,6 @@ subroutine grid_average_X2Y_NEversion(type,work1a,grid1a,work1b,grid1b,work2,gri end subroutine grid_average_X2Y_NEversion !======================================================================= - ! Shifts quantities from one grid to another ! NOTE: Input array includes ghost cells that must be updated before ! calling this routine. @@ -3806,7 +3706,6 @@ subroutine grid_average_X2Y_1(X2Y,work1,work2) end subroutine grid_average_X2Y_1 !======================================================================= - ! Shifts quantities from one grid to another ! NOTE: Input array includes ghost cells that must be updated before ! calling this routine. @@ -4142,7 +4041,7 @@ subroutine grid_average_X2YS(dir,work1,wght1,mask1,work2) case default call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) - end select + end select end subroutine grid_average_X2YS @@ -4370,7 +4269,7 @@ subroutine grid_average_X2YA(dir,work1,wght1,work2) case default call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) - end select + end select end subroutine grid_average_X2YA @@ -4572,7 +4471,7 @@ subroutine grid_average_X2YF(dir,work1,wght1,work2,wght2) case default call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) - end select + end select end subroutine grid_average_X2YF @@ -4717,7 +4616,7 @@ subroutine grid_average_X2Y_2(dir,work1a,wght1a,mask1a,work1b,wght1b,mask1b,work case default call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) - end select + end select end subroutine grid_average_X2Y_2 @@ -5281,7 +5180,6 @@ subroutine gridbox_edges end subroutine gridbox_edges !======================================================================= - ! NOTE: Boundary conditions for fields on NW, SW, SE corners ! have not been implemented; using NE corner location for all. ! Extrapolations are also used: these fields are approximate! @@ -5417,9 +5315,6 @@ subroutine get_bathymetry real (kind=dbl_kind), dimension(nlevel) :: & depth ! total depth, m - real (kind=dbl_kind) :: & - puny - logical (kind=log_kind) :: & calc_dragio @@ -5442,7 +5337,7 @@ subroutine get_bathymetry character(len=*), parameter :: subname = '(get_bathymetry)' - call icepack_query_parameters(puny_out=puny, calc_dragio_out=calc_dragio) + call icepack_query_parameters(calc_dragio_out=calc_dragio) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -5590,7 +5485,6 @@ subroutine get_bathymetry_popfile end subroutine get_bathymetry_popfile !======================================================================= - ! Read bathymetry data for seabed stress calculation (grounding scheme for ! landfast ice) in CICE stand-alone mode. When CICE is in coupled mode ! (e.g. CICE-NEMO), hwater should be uptated at each time level so that diff --git a/cicecore/drivers/mapl/geos/ice_import_export.F90 b/cicecore/drivers/mapl/geos/ice_import_export.F90 index 1f03a228e..ca3dd626e 100644 --- a/cicecore/drivers/mapl/geos/ice_import_export.F90 +++ b/cicecore/drivers/mapl/geos/ice_import_export.F90 @@ -30,7 +30,7 @@ module ice_import_export use ice_state , only : Tsfcn_init, aice_init, uvel, vvel use ice_grid , only : tlon, tlat, tarea, tmask, umask, anglet, ocn_gridcell_frac, hm use ice_grid , only : dxu, dyu, dxE, dyE, dxN, dyN, nmask, emask - use ice_grid , only : grid_type, grid_ice + use ice_grid , only : grid_ice use ice_boundary , only : ice_HaloUpdate use ice_shr_methods , only : chkerr use ice_fileunits , only : nu_diag, flush_fileunit diff --git a/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 b/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 index d5d917c23..a25c81ab5 100644 --- a/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 +++ b/cicecore/drivers/mapl/geos/ice_prescribed_mod.F90 @@ -38,7 +38,7 @@ end subroutine ice_prescribed_init 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, tarea, grid_type, ocn_gridcell_frac + use ice_grid , only : TLAT, TLON, hm, tmask, tarea, ocn_gridcell_frac use ice_calendar , only : idate, calendar_type use ice_arrays_column , only : hin_max use ice_read_write diff --git a/cicecore/drivers/mct/cesm1/ice_import_export.F90 b/cicecore/drivers/mct/cesm1/ice_import_export.F90 index 110bcd39c..b950a3f99 100644 --- a/cicecore/drivers/mct/cesm1/ice_import_export.F90 +++ b/cicecore/drivers/mct/cesm1/ice_import_export.F90 @@ -29,7 +29,7 @@ module ice_import_export 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 use ice_grid , only: tlon, tlat, tarea, tmask, anglet, hm - use ice_grid , only: grid_type, grid_average_X2Y + use ice_grid , only: grid_average_X2Y use ice_boundary , only: ice_HaloUpdate use ice_communicate , only: my_task, master_task, MPI_COMM_ICE, get_num_procs use ice_calendar , only: istep, istep1, diagfreq diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 7113fa915..cbe53387e 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -28,7 +28,7 @@ module ice_prescribed_mod 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, tarea, grid_type, ocn_gridcell_frac + use ice_grid , only : TLAT, TLON, hm, tmask, tarea, ocn_gridcell_frac use ice_calendar , only : idate, msec, calendar_type use ice_arrays_column , only : hin_max use ice_read_write diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 1215ff03c..32d5ce237 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -293,7 +293,7 @@ grid_nml "", "", "", "" "``bathymetry_file``", "string", "name of bathymetry file to be read", "'unknown_bathymetry_file'" "``bathymetry_format``", "``default``", "NetCDF depth field", "'default'" - "", "``pop``", "pop thickness file in cm in ascii format", "" + "", "``pop``", "POP thickness file in cm in ascii format", "" "``close_boundaries``", "logical", "force two gridcell wide land mask on boundaries for rectangular grids", "``.false.``" "``dxrect``", "real", "x-direction grid spacing for rectangular grid in cm", "0.0" "``dxscale``", "real", "user defined rectgrid x-grid scale factor", "1.0" @@ -306,8 +306,10 @@ grid_nml "", "``CD``", "atm forcing/coupling grid, thermo fields on T grid, dyn fields on N and E grid", "" "``grid_file``", "string", "name of grid file to be read", "'unknown_grid_file'" "``grid_format``", "``bin``", "read direct access grid and kmt files", "``bin``" - "", "``pop_nc``", "read grid and kmt files in pop netcdf format", "" - "", "``mom_nc``", "read grid in mom (supergrid) format and kmt files", "" + "", "``geosnc``", "read grid and kmt file in GEOS netcdf format", "" + "", "``pop_nc``", "read grid and kmt files in POP netcdf format", "" + "", "``meshnc``", "coupled model grid option, no CICE code support", "" + "", "``mom_nc``", "read grid in MOM (supergrid) format and kmt files", "" "``grid_ice``", "``B``", "use B grid structure with T at center and U at NE corner", "``B``" "", "``C``", "use C grid structure with T at center, U at E edge, V at N edge", "" "``grid_ocn``", "``A``", "ocn forcing/coupling grid, all fields on T grid", "``A``" @@ -316,12 +318,11 @@ grid_nml "", "``CD``", "ocn forcing/coupling grid, thermo fields on T grid, dyn fields on N and E grid", "" "``grid_outfile``", "logical", "write one-time grid history file", "``.false.``" "``grid_type``", "``column``", "latlon grid with single column set", "``rectangular``" - "", "``displaced_pole``", "read from file in *popgrid*", "" - "", "``geosmom``", "read in *geosgrid*", "" - "", "``latlon``", "read in *latlongrid*", "" - "", "``rectangular``", "defined in *rectgrid*", "" - "", "``regional``", "read from file in *popgrid*", "" - "", "``tripole``", "read from file in *popgrid*", "" + "", "``displaced_pole``", "read from file of type grid_format", "" + "", "``latlon``", "read in from file in subroutine *latlongrid*", "" + "", "``rectangular``", "defined in subroutine *rectgrid*", "" + "", "``regional``", "read from file of type grid_format", "" + "", "``tripole``", "read from file of type grid_format", "" "``kcatbound``", "``-1``", "single category formulation", "1" "", "``0``", "old formulation", "" "", "``1``", "new formulation with round numbers", "" From bc1b6e3feac09986049bd9d007f638b3960b05cd Mon Sep 17 00:00:00 2001 From: bzhao Date: Thu, 15 May 2025 14:07:17 -0400 Subject: [PATCH 08/11] add missing variable import and definition; fixes due to icepack interface change --- cicecore/drivers/mapl/geos/CICE_FinalMod.F90 | 6 +++--- cicecore/drivers/mapl/geos/CICE_RunMod.F90 | 4 ++-- cicecore/drivers/mapl/geos/ice_import_export.F90 | 11 ++++++++--- 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 b/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 index e9b24ba8e..389f638de 100644 --- a/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 +++ b/cicecore/drivers/mapl/geos/CICE_FinalMod.F90 @@ -101,12 +101,12 @@ subroutine ice_checkpoint(time_stamp) logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + calc_Tsfc, skl_bgc, z_tracers, wave_spec character(len=*), parameter :: subname = '(ice_checkpoint)' call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & + z_tracers_out=z_tracers, ktherm_out=ktherm, & wave_spec_out=wave_spec) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & @@ -135,7 +135,7 @@ subroutine ice_checkpoint(time_stamp) if (tr_fsd) call write_restart_fsd if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & + if (skl_bgc .or. z_tracers) & call write_restart_bgc if (tr_brine) call write_restart_hbrine if (kdyn == 2) call write_restart_eap diff --git a/cicecore/drivers/mapl/geos/CICE_RunMod.F90 b/cicecore/drivers/mapl/geos/CICE_RunMod.F90 index 46b86c865..ca5cf8739 100644 --- a/cicecore/drivers/mapl/geos/CICE_RunMod.F90 +++ b/cicecore/drivers/mapl/geos/CICE_RunMod.F90 @@ -1055,7 +1055,7 @@ subroutine ice_fast_physics logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + calc_Tsfc, skl_bgc, z_tracers, wave_spec character(len=*), parameter :: subname = '(ice_fast_physics)' @@ -1071,7 +1071,7 @@ subroutine ice_fast_physics endif call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & + z_tracers_out=z_tracers, ktherm_out=ktherm, & wave_spec_out=wave_spec) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & diff --git a/cicecore/drivers/mapl/geos/ice_import_export.F90 b/cicecore/drivers/mapl/geos/ice_import_export.F90 index ca3dd626e..6ad27dbad 100644 --- a/cicecore/drivers/mapl/geos/ice_import_export.F90 +++ b/cicecore/drivers/mapl/geos/ice_import_export.F90 @@ -2,7 +2,7 @@ module ice_import_export use ESMF use ice_kinds_mod , only : int_kind, dbl_kind, real_kind, char_len, log_kind - use ice_constants , only : c0, c1, p5, p25, spval_dbl, radius + use ice_constants , only : c0, c1, c2, p5, p25, spval_dbl, radius use ice_constants , only : field_loc_center, field_type_scalar, field_type_vector use ice_blocks , only : block, get_block, nx_block, ny_block, nghost use ice_domain , only : nblocks, blocks_ice, halo_info, distrb_info @@ -30,7 +30,8 @@ module ice_import_export use ice_state , only : Tsfcn_init, aice_init, uvel, vvel use ice_grid , only : tlon, tlat, tarea, tmask, umask, anglet, ocn_gridcell_frac, hm use ice_grid , only : dxu, dyu, dxE, dyE, dxN, dyN, nmask, emask - use ice_grid , only : grid_ice + use ice_grid , only : dxT, dyT + use ice_grid , only : grid_ice, grid_ocn use ice_boundary , only : ice_HaloUpdate use ice_shr_methods , only : chkerr use ice_fileunits , only : nu_diag, flush_fileunit @@ -312,12 +313,14 @@ subroutine ice_import_radiation( importState, rc ) end subroutine ice_import_radiation - subroutine ice_import_dyna( taux, tauy, slv, uob, vob, uoc, voc, rc ) + subroutine ice_import_dyna( taux, tauy, slv, uoa, voa, uob, vob, uoc, voc, rc ) ! input/output variables real(kind=real_kind) , intent(in) :: taux(:,:) real(kind=real_kind) , intent(in) :: tauy(:,:) real(kind=real_kind) , intent(in) :: slv(:,:) + real(kind=real_kind) , intent(in) :: uoa(:,:) + real(kind=real_kind) , intent(in) :: voa(:,:) real(kind=real_kind) , intent(in) :: uob(:,:) real(kind=real_kind) , intent(in) :: vob(:,:) real(kind=real_kind) , intent(in) :: uoc(:,:) @@ -330,6 +333,8 @@ subroutine ice_import_dyna( taux, tauy, slv, uob, vob, uoc, voc, rc ) integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain type(block) :: this_block ! block information for current block real(kind=dbl_kind) :: workx, worky + real(kind=dbl_kind) :: slp_L, slp_R, slp_C + real(kind=dbl_kind) :: u_min, u_max, slope real(kind=dbl_kind) :: ssh(nx_block,ny_block,max_blocks) character(len=*), parameter :: subname = 'ice_import_dyna' character(len=1024) :: msgString From 4bb7d1523332099b4d0fed139605bf8190bdcbd5 Mon Sep 17 00:00:00 2001 From: apcraig Date: Tue, 27 May 2025 20:26:10 -0600 Subject: [PATCH 09/11] Update CICE consistent with latest changes to Icepack for GEOS coupling. Rename geos_heatflux to semi_implicit_Tsfc Rename geos_massflux to vapor_flux_correction Add check to not allow semi_implicit_Tsfc with tr_pond_topo Update documentation --- cicecore/cicedyn/general/ice_init.F90 | 28 ++++++++++++++-------- configuration/scripts/ice_in | 4 ++-- doc/source/user_guide/ug_case_settings.rst | 4 ++-- 3 files changed, 22 insertions(+), 14 deletions(-) diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 532667857..79c69130c 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -167,7 +167,7 @@ subroutine input_data congel_freeze, capping_method, snw_ssp_table logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec, & - sw_redist, calc_dragio, use_smliq_pnd, snwgrain, geos_heatflux, geos_massflux + sw_redist, calc_dragio, use_smliq_pnd, snwgrain, semi_implicit_Tsfc, vapor_flux_correction logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd, tr_snow @@ -290,7 +290,8 @@ subroutine input_data fyear_init, ycycle, wave_spec_file,restart_coszen, & atm_data_dir, ocn_data_dir, bgc_data_dir, & atm_data_format, ocn_data_format, rotate_wind, & - oceanmixed_file, atm_data_version,geos_heatflux,geos_massflux + oceanmixed_file, atm_data_version,semi_implicit_Tsfc, & + vapor_flux_correction !----------------------------------------------------------------- ! default values @@ -477,8 +478,8 @@ subroutine input_data kridge = 1 ! -1 = off, 1 = on ktransport = 1 ! -1 = off, 1 = on calc_Tsfc = .true. ! calculate surface temperature - geos_heatflux = .false. ! geos heatflux coupling - geos_massflux = .false. ! geos massflux coupling + semi_implicit_Tsfc = .false. ! surface temperature coupling option based on d(hf)/dTs + vapor_flux_correction = .false. ! mass/enthalpy correction for evaporation/sublimation update_ocn_f = .false. ! include fresh water and salt fluxes for frazil cpl_frazil = 'fresh_ice_correction' ! type of coupling for frazil ice ustar_min = 0.005 ! minimum friction velocity for ocean heat flux (m/s) @@ -1122,8 +1123,8 @@ subroutine input_data call broadcast_scalar(rotate_wind, master_task) call broadcast_scalar(calc_strair, master_task) call broadcast_scalar(calc_Tsfc, master_task) - call broadcast_scalar(geos_heatflux, master_task) - call broadcast_scalar(geos_massflux, master_task) + call broadcast_scalar(semi_implicit_Tsfc, master_task) + call broadcast_scalar(vapor_flux_correction,master_task) call broadcast_scalar(formdrag, master_task) call broadcast_scalar(highfreq, master_task) call broadcast_scalar(natmiter, master_task) @@ -1508,6 +1509,13 @@ subroutine input_data abort_list = trim(abort_list)//":7" endif + if (semi_implicit_Tsfc .and. tr_pond_topo) then + if (my_task == master_task) then + write(nu_diag,*)'ERROR: semi_implicit_Tsfc and tr_pond_topo not supported together' + endif + abort_list = trim(abort_list)//":57" + endif + if (shortwave(1:4) /= 'dEdd' .and. tr_pond .and. calc_tsfc) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: tr_pond=T, calc_tsfc=T, invalid shortwave' @@ -2293,8 +2301,8 @@ subroutine input_data write(nu_diag,1010) ' rotate_wind = ', rotate_wind,' : rotate wind/stress to computational grid' write(nu_diag,1010) ' formdrag = ', formdrag,' : use form drag parameterization' write(nu_diag,1000) ' iceruf = ', iceruf, ' : ice surface roughness at atmosphere interface (m)' - write(nu_diag,1010) ' geos_heatflux = ', geos_heatflux,' : GEOS heatflux calc based on d(hf)/dTs' - write(nu_diag,1010) ' geos_massflux = ', geos_massflux,' : GEOS mass/enthalpy adjustment' + write(nu_diag,1010) ' semi_implicit_Tsfc = ', semi_implicit_Tsfc,' : surface temperature coupling option based on d(hf)/dTs' + write(nu_diag,1010) ' vapor_flux_correction = ', vapor_flux_correction,' : mass/enthalpy correction for evaporation/sublimation' if (trim(atmbndy) == 'constant') then tmpstr2 = ' : constant-based boundary layer' elseif (trim(atmbndy) == 'similarity' .or. & @@ -2761,8 +2769,8 @@ subroutine input_data atmbndy_in=atmbndy, calc_strair_in=calc_strair, formdrag_in=formdrag, highfreq_in=highfreq, & kitd_in=kitd, kcatbound_in=kcatbound, hs0_in=hs0, dpscale_in=dpscale, frzpnd_in=frzpnd, & rfracmin_in=rfracmin, rfracmax_in=rfracmax, pndaspect_in=pndaspect, hs1_in=hs1, hp1_in=hp1, & - ktherm_in=ktherm, calc_Tsfc_in=calc_Tsfc, conduct_in=conduct, geos_heatflux_in=geos_heatflux, & - a_rapid_mode_in=a_rapid_mode, Rac_rapid_mode_in=Rac_rapid_mode, geos_massflux_in=geos_massflux, & + ktherm_in=ktherm, calc_Tsfc_in=calc_Tsfc, conduct_in=conduct, semi_implicit_Tsfc_in=semi_implicit_Tsfc, & + a_rapid_mode_in=a_rapid_mode, Rac_rapid_mode_in=Rac_rapid_mode, vapor_flux_correction_in=vapor_flux_correction, & floediam_in=floediam, hfrazilmin_in=hfrazilmin, Tliquidus_max_in=Tliquidus_max, & aspect_rapid_mode_in=aspect_rapid_mode, dSdt_slow_mode_in=dSdt_slow_mode, & phi_c_slow_mode_in=phi_c_slow_mode, phi_i_mushy_in=phi_i_mushy, conserv_check_in=conserv_check, & diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 093f647c1..a5f648895 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -302,8 +302,8 @@ ocn_data_format = 'bin' ocn_data_dir = '/unknown_ocn_data_dir' oceanmixed_file = 'unknown_oceanmixed_file' - geos_heatflux = .false. - geos_massflux = .false. + semi_implicit_Tsfc = .false. + vapor_flux_correction = .false. / &domain_nml diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 32d5ce237..228b47228 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -695,8 +695,6 @@ forcing_nml "", "``default``", "default forcing value for iron", "" "``formdrag``", "logical", "calculate form drag", "``.false.``" "``fyear_init``", "integer", "first year of atmospheric forcing data", "1900" - "``geos_heatflux``", "logical", "GEOS heatflux coupling calculation based on d(hf)/dTs", "``.false.``" - "``geos_massflux``", "logical", "GEOS mass/enthalpy coupling adjustment", "``.false.``" "``highfreq``", "logical", "high-frequency atmo coupling", "``.false.``" "``ice_data_conc``", "``box2001``", "ice distribution ramped from 0 to 1 west to east consistent with :ref:`box2001` test (:cite:`Hunke01`)", "``default``" "", "``c1``", "initial ice concentation of 1.0", "" @@ -741,6 +739,7 @@ forcing_nml "``rotate_wind``", "logical", "rotate wind from east/north to computation grid", "``.true.``" "``saltflux_option``", "``constant``", "computed using ice_ref_salinity", "``constant``" "", "``prognostic``", "computed using prognostic salinity", "" + "``semi-implicit_Tsfc``", "logical", "surface temperature coupling option based on d(hf)/dTs", "``.false.``" "``tfrz_option``","``constant``", "constant ocean freezing temperature (Tocnfrz)","``mushy``" "", "``linear_salt``", "linear function of salinity (ktherm=1)", "", "``minus1p8``", "constant ocean freezing temperature (:math:`-1.8^{\circ} C`)", "" @@ -749,6 +748,7 @@ forcing_nml "``ustar_min``", "real", "minimum value of ocean friction velocity in m/s", "0.0005" "``update_ocn_f``", "``.false.``", "do not include frazil water/salt fluxes in ocn fluxes", "``.false.``" "", "``true``", "include frazil water/salt fluxes in ocn fluxes", "" + "``vapor_flux_correction``", "logical", "water vapor deposition/sublimation correction associated with an assumed temperature", "``.false.``" "``wave_spec_file``", "string", "data file containing wave spectrum forcing data", "" "``wave_spec_type``", "``constant``", "wave data file is provided, constant wave spectrum, for testing", "``none``" "", "``none``", "no wave data provided, no wave-ice interactions", "" From 9e1fd4a221908d41ac73b48c086fadbb8fc5c5bf Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 20 Jun 2025 13:50:11 -0600 Subject: [PATCH 10/11] Update Icepack to #ac57a1c48af244 includes GEOS coupling changes and new semi_implicit_Tsfc and vapor_flux_correction namelist settings. Updates to gregorian calendar naming convention --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index cfdf8cc9c..ac57a1c48 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit cfdf8cc9cb73d54d5627714cb35717be4c4eb67b +Subproject commit ac57a1c48af2447f3c1cbdb86b751f788603aac7 From cd726e8fcdce27a4aa40221729543f7e5c442c93 Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 20 Jun 2025 15:17:29 -0600 Subject: [PATCH 11/11] Update Icepack to #f61be9a1bd3578f89 with minor GEOS modifications Rename dflatndTs_f and dfsurfndTs_f to dflatndTsfc_f and dfsurfndTsfc_f Update documentation for distribution_wght settings Update drivers/mapl/geos/CICE_copyright.txt to be consistent with latest version --- cicecore/cicedyn/general/ice_flux.F90 | 8 +++--- cicecore/cicedyn/general/ice_step_mod.F90 | 6 ++--- .../cicedyn/infrastructure/ice_domain.F90 | 6 ++--- cicecore/drivers/mapl/geos/CICE_copyright.txt | 26 +++++++++---------- .../drivers/mapl/geos/ice_import_export.F90 | 6 ++--- doc/source/user_guide/ug_case_settings.rst | 6 ++--- icepack | 2 +- 7 files changed, 30 insertions(+), 30 deletions(-) diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index fa49238d9..65dd72c4f 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -187,8 +187,8 @@ module ice_flux real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & evapn_f, & ! evaporation/sublimation (kg m-2 s-1) - dflatndTs_f, & ! derivative of latent flux w.r.t. Ts - dfsurfndTs_f ! derivative of surface flux w.r.t. Ts + dflatndTsfc_f, & ! derivative of latent flux w.r.t. Tsfc + dfsurfndTsfc_f ! derivative of surface flux w.r.t. Tsfc real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & swuvrdr , & ! vis uvr flux, direct (W m-2) @@ -589,8 +589,8 @@ subroutine alloc_flux fsensn_f (nx_block,ny_block,ncat,max_blocks), & ! sensible heat flux (W m-2) flatn_f (nx_block,ny_block,ncat,max_blocks), & ! latent heat flux (W m-2) evapn_f (nx_block,ny_block,ncat,max_blocks), & ! evaporative water flux (kg/m^2/s) by atmosphere model - dflatndTs_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of flatn with respect to Ts - dfsurfndTs_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of fsurfn with respect to Ts + dflatndTsfc_f (nx_block,ny_block,ncat,max_blocks), & ! derivative of flatn with respect to Tsfc + dfsurfndTsfc_f(nx_block,ny_block,ncat,max_blocks), & ! derivative of fsurfn with respect to Tsfc meltsn (nx_block,ny_block,ncat,max_blocks), & ! snow melt in category n (m) melttn (nx_block,ny_block,ncat,max_blocks), & ! top melt in category n (m) meltbn (nx_block,ny_block,ncat,max_blocks), & ! bottom melt in category n (m) diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index 52504123a..0711ea0cf 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -242,7 +242,7 @@ subroutine step_therm1 (dt, iblk) fswthru_uvrdr, fswthru_uvrdf, fswthru_pardr, fswthru_pardf, & meltt, melts, meltb, congel, snoice, & flatn_f, fsensn_f, fsurfn_f, fcondtopn_f, & - dfsurfndts_f, dflatndts_f, & + dfsurfndTsfc_f, dflatndTsfc_f, & send_i2x_per_cat, fswthrun_ai, dsnow 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 @@ -525,8 +525,8 @@ subroutine step_therm1 (dt, iblk) fsensn_f = fsensn_f (i,j,:,iblk), & fsurfn_f = fsurfn_f (i,j,:,iblk), & fcondtopn_f = fcondtopn_f (i,j,:,iblk), & - dfsurfdT = dfsurfndTs_f(i,j,:,iblk), & - dflatdT = dflatndTs_f (i,j,:,iblk), & + dfsurfdT = dfsurfndTsfc_f(i,j,:,iblk), & + dflatdT = dflatndTsfc_f (i,j,:,iblk), & faero_atm = faero_atm (i,j,1:n_aero,iblk), & faero_ocn = faero_ocn (i,j,1:n_aero,iblk), & fiso_atm = fiso_atm (i,j,:,iblk), & diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index ddf35b6e9..86d6a1939 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -79,9 +79,9 @@ module ice_domain ! 'cartesian', 'roundrobin', 'sectrobin', 'sectcart' ! 'rake', 'spacecurve', etc distribution_wght ! method for weighting work per block - ! 'block' = POP default configuration - ! 'blockall' = no land block elimination - ! 'blockfull'= blockall but all blocks get full weight + ! 'block' = block weighted method with land block elimination + ! 'blockall' = block method with NO land block elimination and minimum weight given to land blocks + ! 'blockfull'= block method with NO land block elimination and full weight given to land blocks ! 'latitude' = no. ocean points * |lat| ! 'file' = read distribution_wgth_file character (char_len_long) :: & diff --git a/cicecore/drivers/mapl/geos/CICE_copyright.txt b/cicecore/drivers/mapl/geos/CICE_copyright.txt index 6eb3c9cca..9ee3d2c60 100644 --- a/cicecore/drivers/mapl/geos/CICE_copyright.txt +++ b/cicecore/drivers/mapl/geos/CICE_copyright.txt @@ -1,17 +1,17 @@ -! Copyright (c) 2022, Triad National Security, LLC +! Copyright (c) 1998, 2017, Triad National Security, LLC ! All rights reserved. -! -! Copyright 2022. Triad National Security, LLC. This software was -! produced under U.S. Government contract DE-AC52-06NA25396 for Los -! Alamos National Laboratory (LANL), which is operated by Triad -! National Security, LLC for the U.S. Department of Energy. The U.S. -! Government has rights to use, reproduce, and distribute this software. -! NEITHER THE GOVERNMENT NOR TRIAD NATIONAL SECURITY, LLC MAKES ANY -! WARRANTY, EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF -! THIS SOFTWARE. If software is modified to produce derivative works, -! such modified software should be clearly marked, so as not to confuse -! it with the version available from LANL. +! +! This program was produced under U.S. Government contract 89233218CNA000001 +! for Los Alamos National Laboratory (LANL), which is operated by Triad +! National Security, LLC for the U.S. Department of Energy/National Nuclear +! Security Administration. All rights in the program are reserved by Triad +! National Security, LLC, and the U.S. Department of Energy/National Nuclear +! Security Administration. The Government is granted for itself and others +! acting on its behalf a nonexclusive, paid-up, irrevocable worldwide +! license in this material to reproduce, prepare. derivative works, +! distribute copies to the public, perform publicly and display publicly, +! and to permit others to do so. ! ! The full license and distribution policy are available from ! https://github.com/CICE-Consortium -! +! diff --git a/cicecore/drivers/mapl/geos/ice_import_export.F90 b/cicecore/drivers/mapl/geos/ice_import_export.F90 index 6ad27dbad..ce87289a7 100644 --- a/cicecore/drivers/mapl/geos/ice_import_export.F90 +++ b/cicecore/drivers/mapl/geos/ice_import_export.F90 @@ -11,7 +11,7 @@ module ice_import_export use ice_flux , only : strairxt, strairyt, strocnxT_iavg, strocnyT_iavg 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 : evapn_f, fsurfn_f, dfsurfndts_f, dflatndts_f + use ice_flux , only : evapn_f, fsurfn_f, dfsurfndTsfc_f, dflatndTsfc_f use ice_flux , only : flatn_f, coszen use ice_flux , only : fswthru_uvrdr, fswthru_uvrdf, fswthru_pardr, fswthru_pardf use ice_flux , only : send_i2x_per_cat, fswthrun_ai @@ -220,8 +220,8 @@ subroutine ice_import_thermo1( importState, rc ) !trcrn (i,j,1,k,iblk) = afldu(i,j,k,1,iblk) - Tffresh evapn_f (i,j,k,iblk) = afldu(i,j,k,1,iblk) fsurfn_f (i,j,k,iblk) = afldu(i,j,k,2,iblk) - dfsurfndts_f(i,j,k,iblk) = afldu(i,j,k,3,iblk) - dflatndts_f(i,j,k,iblk) = afldu(i,j,k,4,iblk) + dfsurfndTsfc_f(i,j,k,iblk) = afldu(i,j,k,3,iblk) + dflatndTsfc_f(i,j,k,iblk) = afldu(i,j,k,4,iblk) flatn_f (i,j,k,iblk) = afldu(i,j,k,5,iblk) end do end do diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 228b47228..4e0542ab9 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -368,9 +368,9 @@ domain_nml "", "``spacecurve``", "distribute blocks via space-filling curves", "" "", "``spiralcenter``", "distribute blocks via roundrobin from center of grid outward in a spiral", "" "", "``wghtfile``", "distribute blocks based on weights specified in ``distribution_wght_file``", "" - "``distribution_wght``", "``block``", "full block weight method with land block elimination", "``latitude``" - "", "``blockall``", "block weight method with NO land block elimination", "" - "", "``blockfull``", "full block weight method with NO land block elimination", "" + "``distribution_wght``", "``block``", "block weighted method with land block elimination", "``latitude``" + "", "``blockall``", "block method with NO land block elimination and minimum weight given to land blocks", "" + "", "``blockfull``", "block method with NO land block elimination and full weight given to land blocks", "" "", "``latitude``", "latitude/ocean sets ``work_per_block``", "" "``distribution_wght_file``", "string", "distribution weight file when distribution_type is ``wghtfile``", "'unknown'" "``ew_boundary_type``", "``cyclic``", "periodic boundary conditions in x-direction", "``cyclic``" diff --git a/icepack b/icepack index ac57a1c48..f61be9a1b 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit ac57a1c48af2447f3c1cbdb86b751f788603aac7 +Subproject commit f61be9a1bd3578f89d559f9a8901252367cca0d7