From 2357a4e529a0297a64fd1f9ff5fcf829e9873146 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 20 Mar 2020 15:30:13 +0100 Subject: [PATCH 01/54] .gitignore updated to exclude icepack repository --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 51a096137..f6fe45381 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,4 @@ *.x *.out *~ +/Icepack From 479721ff91554dbcbf5bd3fdd317d6ff977b999d Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 20 Mar 2020 16:16:12 +0100 Subject: [PATCH 02/54] namelists added or modied for running with icepack --- config/namelist.config | 1 + config/namelist.icepack | 266 ++++++++++++++++++++++++++++++++++++++++ config/namelist.io | 0 config/namelist.oce | 0 4 files changed, 267 insertions(+) create mode 100755 config/namelist.icepack mode change 100644 => 100755 config/namelist.io mode change 100644 => 100755 config/namelist.oce diff --git a/config/namelist.config b/config/namelist.config index cb9f97659..e53f55fc4 100755 --- a/config/namelist.config +++ b/config/namelist.config @@ -52,6 +52,7 @@ include_fleapyear=.false. use_ice=.true. ! ocean+ice use_floatice = .false. use_sw_pene=.true. +use_icepack=.true. / &machine diff --git a/config/namelist.icepack b/config/namelist.icepack new file mode 100755 index 000000000..89f25908a --- /dev/null +++ b/config/namelist.icepack @@ -0,0 +1,266 @@ +&env_nml ! In the original release these variables are defined in the icepack.settings + nicecat = 5 ! number of ice thickness categories + nfsdcat = 1 ! number of floe size categories + nicelyr = 4 ! number of vertical layers in the ice + nsnwlyr = 4 ! number of vertical layers in the snow + ntraero = 0 ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) + trzaero = 0 ! number of z aerosol tracers (up to max_aero = 6) + tralg = 0 ! number of algal tracers (up to max_algae = 3) + trdoc = 0 ! number of dissolve organic carbon (up to max_doc = 3) + trdic = 0 ! number of dissolve inorganic carbon (up to max_dic = 1) + trdon = 0 ! number of dissolve organic nitrogen (up to max_don = 1) + trfed = 0 ! number of dissolved iron tracers (up to max_fe = 2) + trfep = 0 ! number of particulate iron tracers (up to max_fe = 2) + nbgclyr = 0 ! number of zbgc layers + trbgcz = 0 ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) + trzs = 0 ! set to 1 for zsalinity tracer (needs TRBRI = 1) + trbri = 0 ! set to 1 for brine height tracer + trage = 0 ! set to 1 for ice age tracer + trfy = 0 ! set to 1 for first-year ice area tracer + trlvl = 0 ! set to 1 for level and deformed ice tracers + trpnd = 0 ! set to 1 for melt pond tracers + trbgcs = 0 ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) +/ + +&grid_nml + kcatbound = 1 +/ + +&tracer_nml + tr_iage = .false. + tr_FY = .false. + tr_lvl = .true. + tr_pond_cesm = .false. + tr_pond_topo = .false. + tr_pond_lvl = .true. + tr_aero = .false. + tr_fsd = .false. +/ + +&thermo_nml + kitd = 1 + ktherm = 2 + conduct = 'bubbly' + a_rapid_mode = 0.5e-3 + Rac_rapid_mode = 10.0 + aspect_rapid_mode = 1.0 + dSdt_slow_mode = -5.0e-8 + phi_c_slow_mode = 0.05 + phi_i_mushy = 0.85 +/ + +&shortwave_nml + shortwave = 'dEdd' + albedo_type = 'ccsm3' + albicev = 0.78 + albicei = 0.36 + albsnowv = 0.98 + albsnowi = 0.70 + ahmax = 0.3 + R_ice = 0. + R_pnd = 0. + R_snw = 1.5 + dT_mlt = 1.5 + rsnw_mlt = 1500. + kalg = 0.6 +/ + +&ponds_nml + hp1 = 0.01 + hs0 = 0. + hs1 = 0.03 + dpscale = 1.e-3 + frzpnd = 'hlid' + rfracmin = 0.15 + rfracmax = 1. + pndaspect = 0.8 +/ + +&forcing_nml + formdrag = .false. + atmbndy = 'default' + calc_strair = .true. + calc_Tsfc = .true. + highfreq = .false. + natmiter = 5 + ustar_min = 0.0005 + emissivity = 0.95 + fbot_xfer_type = 'constant' + update_ocn_f = .false. + l_mpond_fresh = .false. + tfrz_option = 'mushy' + oceanmixed_ice = .true. + wave_spec_type = 'none' + restore_ocn = .false. + trestore = 90 + precip_units = 'mks' + default_season = 'spring' + atm_data_type = 'clim' + ocn_data_type = 'SHEBA' + bgc_data_type = 'default' + fyear_init = 2015 + ycycle = 1 + data_dir = '/Users/ftuser/Desktop/CICE-Consortium/ICEPACK_DATA/' + atm_data_file = 'unknown_atm_data_file' + ocn_data_file = 'unknown_ocn_data_file' + bgc_data_file = 'unknown_bgc_data_file' + ice_data_file = 'open_clos_lindsay.dat' + atm_data_format = 'bin' + ocn_data_format = 'bin' + bgc_data_format = 'bin' +/ + +&dynamics_nml + kstrength = 1 + krdg_partic = 1 + krdg_redist = 1 + mu_rdg = 3 + Cf = 17. +/ + +&zbgc_nml + tr_brine = .false. + tr_zaero = .false. + modal_aero = .false. + skl_bgc = .false. + z_tracers = .false. + dEdd_algae = .false. + solve_zbgc = .false. + bgc_flux_type = 'Jin2006' + restore_bgc = .false. + scale_bgc = .false. + solve_zsal = .false. + tr_bgc_Nit = .false. + tr_bgc_C = .false. + tr_bgc_chl = .false. + tr_bgc_Am = .false. + tr_bgc_Sil = .false. + tr_bgc_DMS = .false. + tr_bgc_PON = .false. + tr_bgc_hum = .false. + tr_bgc_DON = .false. + tr_bgc_Fe = .false. + grid_o = 0.006 + l_sk = 0.024 + grid_oS = 0.0 + l_skS = 0.028 + phi_snow = -0.3 + initbio_frac = 0.8 + frazil_scav = 0.8 + ratio_Si2N_diatoms = 1.8 + ratio_Si2N_sp = 0.0 + ratio_Si2N_phaeo = 0.0 + ratio_S2N_diatoms = 0.03 + ratio_S2N_sp = 0.03 + ratio_S2N_phaeo = 0.03 + ratio_Fe2C_diatoms = 0.0033 + ratio_Fe2C_sp = 0.0033 + ratio_Fe2C_phaeo = 0.1 + ratio_Fe2N_diatoms = 0.023 + ratio_Fe2N_sp = 0.023 + ratio_Fe2N_phaeo = 0.7 + ratio_Fe2DON = 0.023 + ratio_Fe2DOC_s = 0.1 + ratio_Fe2DOC_l = 0.033 + fr_resp = 0.05 + tau_min = 5200.0 + tau_max = 173000.0 + algal_vel = 0.0000000111 + R_dFe2dust = 0.035 + dustFe_sol = 0.005 + chlabs_diatoms = 0.03 + chlabs_sp = 0.01 + chlabs_phaeo = 0.05 + alpha2max_low_diatoms = 0.8 + alpha2max_low_sp = 0.67 + alpha2max_low_phaeo = 0.67 + beta2max_diatoms = 0.018 + beta2max_sp = 0.0025 + beta2max_phaeo = 0.01 + mu_max_diatoms = 1.44 + mu_max_sp = 0.851 + mu_max_phaeo = 0.851 + grow_Tdep_diatoms = 0.06 + grow_Tdep_sp = 0.06 + grow_Tdep_phaeo = 0.06 + fr_graze_diatoms = 0.0 + fr_graze_sp = 0.1 + fr_graze_phaeo = 0.1 + mort_pre_diatoms = 0.007 + mort_pre_sp = 0.007 + mort_pre_phaeo = 0.007 + mort_Tdep_diatoms = 0.03 + mort_Tdep_sp = 0.03 + mort_Tdep_phaeo = 0.03 + k_exude_diatoms = 0.0 + k_exude_sp = 0.0 + k_exude_phaeo = 0.0 + K_Nit_diatoms = 1.0 + K_Nit_sp = 1.0 + K_Nit_phaeo = 1.0 + K_Am_diatoms = 0.3 + K_Am_sp = 0.3 + K_Am_phaeo = 0.3 + K_Sil_diatoms = 4.0 + K_Sil_sp = 0.0 + K_Sil_phaeo = 0.0 + K_Fe_diatoms = 1.0 + K_Fe_sp = 0.2 + K_Fe_phaeo = 0.1 + f_don_protein = 0.6 + kn_bac_protein = 0.03 + f_don_Am_protein = 0.25 + f_doc_s = 0.4 + f_doc_l = 0.4 + f_exude_s = 1.0 + f_exude_l = 1.0 + k_bac_s = 0.03 + k_bac_l = 0.03 + T_max = 0.0 + fsal = 1.0 + op_dep_min = 0.1 + fr_graze_s = 0.5 + fr_graze_e = 0.5 + fr_mort2min = 0.5 + fr_dFe = 0.3 + k_nitrif = 0.0 + t_iron_conv = 3065.0 + max_loss = 0.9 + max_dfe_doc1 = 0.2 + fr_resp_s = 0.75 + y_sk_DMS = 0.5 + t_sk_conv = 3.0 + t_sk_ox = 10.0 + algaltype_diatoms = 0.0 + algaltype_sp = 0.5 + algaltype_phaeo = 0.5 + nitratetype = -1.0 + ammoniumtype = 1.0 + silicatetype = -1.0 + dmspptype = 0.5 + dmspdtype = -1.0 + humtype = 1.0 + doctype_s = 0.5 + doctype_l = 0.5 + dontype_protein = 0.5 + fedtype_1 = 0.5 + feptype_1 = 0.5 + zaerotype_bc1 = 1.0 + zaerotype_bc2 = 1.0 + zaerotype_dust1 = 1.0 + zaerotype_dust2 = 1.0 + zaerotype_dust3 = 1.0 + zaerotype_dust4 = 1.0 + ratio_C2N_diatoms = 7.0 + ratio_C2N_sp = 7.0 + ratio_C2N_phaeo = 7.0 + ratio_chl2N_diatoms= 2.1 + ratio_chl2N_sp = 1.1 + ratio_chl2N_phaeo = 0.84 + F_abs_chl_diatoms = 2.0 + F_abs_chl_sp = 4.0 + F_abs_chl_phaeo = 5.0 + ratio_C2N_proteins = 7.0 +/ + + diff --git a/config/namelist.io b/config/namelist.io old mode 100644 new mode 100755 diff --git a/config/namelist.oce b/config/namelist.oce old mode 100644 new mode 100755 From 979e662b03634eed29ecdf6940f2d90f2ff228f1 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Sat, 21 Mar 2020 17:31:20 +0100 Subject: [PATCH 03/54] Code refactoring with derived types for icedrv_domain_size (now icepack_settings) --- src/CMakeLists.txt | 4 +- src/gen_model_setup.F90 | 62 +++++++++- src/gen_modules_config.F90 | 15 +-- .../.associate_icepack_settings.h.swp | Bin 0 -> 16384 bytes .../associate_icepack_settings.h | 112 ++++++++++++++++++ src/icepack_drivers/icedrv_kinds.F90 | 25 ++++ src/icepack_drivers/icedrv_settings.F90 | 67 +++++++++++ 7 files changed, 274 insertions(+), 11 deletions(-) create mode 100644 src/icepack_drivers/.associate_icepack_settings.h.swp create mode 100644 src/icepack_drivers/associate_icepack_settings.h create mode 100644 src/icepack_drivers/icedrv_kinds.F90 create mode 100644 src/icepack_drivers/icedrv_settings.F90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index d5aebdca0..510cb73ad 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -5,7 +5,9 @@ project(fesom C Fortran) # get our source files set(src_home ${CMAKE_CURRENT_LIST_DIR}) # path to src directory starting from the dir containing our CMakeLists.txt -file(GLOB sources_Fortran ${src_home}/*.F90) +file(GLOB sources_Fortran ${src_home}/*.F90 + ${src_home}/icepack_drivers/*.F90 + ${src_home}/../Icepack/columnphysics/*.F90) #list(REMOVE_ITEM sources_Fortran ${src_home}/fesom_partition_init.F90) file(GLOB sources_C ${src_home}/*.c) diff --git a/src/gen_model_setup.F90 b/src/gen_model_setup.F90 index e97d23b3c..14a8f171f 100755 --- a/src/gen_model_setup.F90 +++ b/src/gen_model_setup.F90 @@ -1,10 +1,11 @@ ! ============================================================== subroutine setup_model implicit none + call read_namelist ! should be before clock_init end subroutine setup_model ! ============================================================== -subroutine read_namelist +subroutine read_namelist(icepack_settings) ! Reads namelist files and overwrites default parameters. ! ! Coded by Lars Nerger @@ -19,10 +20,15 @@ subroutine read_namelist use diagnostics, only: ldiag_solver,lcurt_stress_surf,lcurt_stress_surf, ldiag_energy, & ldiag_dMOC, ldiag_DVD, diag_list use g_clock, only: timenew, daynew, yearnew - use g_ic3d + use g_ic3d + ! Refactored + use icedrv_settings implicit none - + character(len=100) :: nmlfile + type(t_icepack_settings), intent(inout), target :: icepack_settings +#include "icepack_drivers/associate_icepack_settings.h" + namelist /clockinit/ timenew, daynew, yearnew nmlfile ='namelist.config' ! name of general configuration namelist file @@ -101,6 +107,56 @@ subroutine read_namelist read (20,NML=diag_list) close (20) + if (use_ice .and. use_icepack) then !LZ + + namelist / env_nml / nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & + trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & + trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs + + nmlfile ='namelist.icepack' ! name of icepack namelist file + open (10,file=nmlfile) + read (10,NML=env_nml) + close (10) + + ncat = nicecat ! number of categories + nilyr = nicelyr ! number of ice layers per category + nslyr = nsnwlyr ! number of snow layers per category + n_aero = ntraero ! number of aerosols in use + n_zaero = trzaero ! number of z aerosols in use + n_algae = tralg ! number of algae in use + n_doc = trdoc ! number of DOC pools in use + n_dic = trdic ! number of DIC pools in use + n_don = trdon ! number of DON pools in use + n_fed = trfed ! number of Fe pools in use dissolved Fe + n_fep = trfep ! number of Fe pools in use particulate Fe + nblyr = nbgclyr ! number of bio/brine layers per category + ! maximum number of biology tracers + aerosols + ! *** add to kscavz in icepack_zbgc_shared.F90 + n_bgc = (n_algae*2 + n_doc + n_dic + n_don + n_fed + n_fep + n_zaero & + + 8) ! nit, am, sil, dmspp, dmspd, dms, pon, humic + nltrcr = (n_bgc*trbgcz+trzs)*trbri ! number of zbgc (includes zaero) + ! and zsalinity tracers + max_nsw = (nilyr+nslyr+2) & ! total chlorophyll plus aerosols + * (1+trzaero) ! number of tracers active in shortwave calculation + max_ntrcr = 1 & ! 1 = surface temperature + + nilyr & ! ice salinity + + nilyr & ! ice enthalpy + + nslyr & ! snow enthalpy + !!!!! optional tracers: + + trage & ! age + + trfy & ! first-year area + + trlvl*2 & ! level/deformed ice + + trpnd*3 & ! ponds + + n_aero*4 & ! number of aerosols * 4 aero layers + + trbri & ! brine height + + trbgcs*n_bgc & ! skeletal layer BGC + + trzs *trbri* nblyr & ! zsalinity (off if TRBRI=0) + + n_bgc*trbgcz*trbri*(nblyr+3) & ! zbgc (off if TRBRI=0) + + n_bgc*trbgcz & ! mobile/stationary phase tracer + + 1 ! for unused tracer flags + + endif + if(mype==0) write(*,*) 'Namelist files are read in' ! if ((output_length_unit=='s').or.(int(real(step_per_day)/24.0)<=1)) use_means=.false. diff --git a/src/gen_modules_config.F90 b/src/gen_modules_config.F90 index 707dcbce8..c8b86be84 100755 --- a/src/gen_modules_config.F90 +++ b/src/gen_modules_config.F90 @@ -73,13 +73,14 @@ module g_config namelist /machine/ n_levels, n_part ! *** configuration*** - logical :: use_sw_pene=.true. - logical :: use_ice=.false. - logical :: use_floatice = .false. - logical :: toy_ocean=.false. ! Ersatz forcing has - ! to be supplied - logical :: flag_debug=.false. - namelist /run_config/ use_ice,use_floatice, use_sw_pene, toy_ocean, flag_debug + logical :: use_sw_pene= .true. + logical :: use_ice= .false. + logical :: use_floatice = .false. + logical :: use_icepack = .false. + logical :: toy_ocean= .false. ! Ersatz forcing has + ! to be supplied + logical :: flag_debug= .false. + namelist /run_config/ use_ice,use_floatice, use_sw_pene, use_icepack, toy_ocean, flag_debug ! *** others *** real(kind=WP) :: dt diff --git a/src/icepack_drivers/.associate_icepack_settings.h.swp b/src/icepack_drivers/.associate_icepack_settings.h.swp new file mode 100644 index 0000000000000000000000000000000000000000..5a5e8bac9bf5e584eb3753ec58a08c9ddf51693a GIT binary patch literal 16384 zcmeHOONaN^+Aa55ppue!Q-dwOeTYtR^Ds*^9Xv;VjMU-i}B z_4vEDJn+=`F1mT$27>DrLe4xi^Zdzp+4!?-32}xt4-9PCA}t-Sx*t@z7#tYv$RcEa z>ac%o``(FNrSXyNk8c}!w7FB0S;KLsN?yokSQzy?Q53k`iCHPLL@bWE zs7C8*O9ZoKtAJIYpuj4!erRw&{_@T{dg$s~pDftzSF36|f3e z1*`&Af&ZWajz`F~XxGoOZFv5lo&S&AOvp~)_nQcL4Oj^rT1Ci4;HMi2*#n%vfe-;) zT1m*4z((Ng_4pldJ8l88e$ z%m>RyibKc6OAeF^8V9lCn|qCB^FAq>xX}L0tK-IaheA4!YC#w$-Etk@o%WrW2f`?r z@Qdw7+eP_tA*^ zeblQ*jfVR0k`Fn+qL0?5>)bU9Q}*XthDAoq_p8i<{&L6#qrNjI$EbniaPb~WH3;X- zLX;}3QRqlZh%rXd?7&aPe>!5c;e;_yhKJEHW*o%pDu~DNMvXtiJo6AyqY+tfi;E^8<@lkS0Q4Z`LUdNy)2laXMe^oIL0Wn^u=d0%ukjPkD+gM zOjmOJyID!%urgPSQVdh!VHB^OV@{a3cS7c*F${a+R14FB9PXB$$Yx8HYPz9YtUSf0 z7u>3~sm6Gn z--U%W{2z+9#0sCqqd{181lDbA$HJh>1nphuqV&;4ZY;6<&xhn93+g&y88Px9(UfjN zcHSGzhwKm#9){_9(_zHEpfHLptBu??__}OS`-v_BnQkVu!Q_Tvm~Jxb6wWh?cNqEH zOg9*9BVjeglvwhDy2C|DuC?pNwivESA`-J5?`^y?jvaKi1ge8o4J$hKCr0-=a+_UA z0Q{Mme{4V&Z4vV7={6u{p3#Jko?)kPjk{BVMNw{hL*)72!&&_uoZaR5KYPCa8_xbe z0&f8g;4z>VxCXd@TEJ=GFt8tZ4tM~#4Y-K6|f3e z1^#UX7M`sPKPV3r$v=%|{~CJtyp?26dvvVCMiMTbr|1}|jbx8ObR1jfk{#tYt_WvOpDnwG7yZNY74M0&Ik26<8fZ*+5Yx zQ#}PXFjVPN&wvdKRkhSJDsv#Hnxmco8yKp5sAs?ihAIN;8O=z#NJ@8lLSjQYt3sQO zliJ{?eL^R;gwZacB|~b~KA{tvWVB7_#FqGIm(bFO3x+Dz=z5dbz-XV&sf}dS5uKOR lhJ02<3@u05kkP6Rq2(xBlG8G4wH#GvNc^m!AzW|w08j=72 literal 0 HcmV?d00001 diff --git a/src/icepack_drivers/associate_icepack_settings.h b/src/icepack_drivers/associate_icepack_settings.h new file mode 100644 index 000000000..76a5d0e3a --- /dev/null +++ b/src/icepack_drivers/associate_icepack_settings.h @@ -0,0 +1,112 @@ +integer (kind=int_kind), pointer :: nicecat ! number of ice thickness categories +integer (kind=int_kind), pointer :: nfsdcat ! number of floe size categories +integer (kind=int_kind), pointer :: nicelyr ! number of vertical layers in the ice +integer (kind=int_kind), pointer :: nsnwlyr ! number of vertical layers in the snow +integer (kind=int_kind), pointer :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) +integer (kind=int_kind), pointer :: trzaero ! number of z aerosol tracers (up to max_aero = 6) +integer (kind=int_kind), pointer :: tralg ! number of algal tracers (up to max_algae = 3) +integer (kind=int_kind), pointer :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) +integer (kind=int_kind), pointer :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) +integer (kind=int_kind), pointer :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) +integer (kind=int_kind), pointer :: trfed ! number of dissolved iron tracers (up to max_fe = 2) +integer (kind=int_kind), pointer :: trfep ! number of particulate iron tracers (up to max_fe = 2) +integer (kind=int_kind), pointer :: nbgclyr ! number of zbgc layers +integer (kind=int_kind), pointer :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) +integer (kind=int_kind), pointer :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) +integer (kind=int_kind), pointer :: trbri ! set to 1 for brine height tracer +integer (kind=int_kind), pointer :: trage ! set to 1 for ice age tracer +integer (kind=int_kind), pointer :: trfy ! set to 1 for first-year ice area tracer +integer (kind=int_kind), pointer :: trlvl ! set to 1 for level and deformed ice tracers +integer (kind=int_kind), pointer :: trpnd ! set to 1 for melt pond tracers +integer (kind=int_kind), pointer :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) + + +integer (kind=int_kind), pointer :: ncat ! number of categories in use +integer (kind=int_kind), pointer :: nfsd ! number of floe size categories in use +integer (kind=int_kind), pointer :: nilyr ! number of ice layers per category in use +integer (kind=int_kind), pointer :: nslyr ! number of snow layers per category in use +integer (kind=int_kind), pointer :: n_aero ! number of aerosols in use +integer (kind=int_kind), pointer :: n_zaero ! number of z aerosols in use +integer (kind=int_kind), pointer :: n_algae ! number of algae in use +integer (kind=int_kind), pointer :: n_doc ! number of DOC pools in use +integer (kind=int_kind), pointer :: n_dic ! number of DIC pools in use +integer (kind=int_kind), pointer :: n_don ! number of DON pools in use +integer (kind=int_kind), pointer :: n_fed ! number of Fe pools in use dissolved Fe +integer (kind=int_kind), pointer :: n_fep ! number of Fe pools in use particulate Fe +integer (kind=int_kind), pointer :: nblyr ! number of bio/brine layers per category +integer (kind=int_kind), pointer :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic +integer (kind=int_kind), pointer :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers +integer (kind=int_kind), pointer :: max_nsw ! number of tracers active in shortwave calculation +integer (kind=int_kind), pointer :: max_ntrcr ! number of tracers in total +integer (kind=int_kind), pointer :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW + +nicecat => icepack_settings%nicecat +nfsdcat => icepack_settings%nfsdcat +nicelyr => icepack_settings%nicelyr +nsnwlyr => icepack_settings%nsnwlyr +ntraero => icepack_settings%ntraero +trzaero => icepack_settings%trzaero +tralg => icepack_settings%tralg +trdoc => icepack_settings%trdoc +trdic => icepack_settings%trdic +trdon => icepack_settings%trdon +trfed => icepack_settings%trfed +trfep => icepack_settings%trfep +nbgclyr => icepack_settings%nbgclyr +trbgcz => icepack_settings%trbgcz +trzs => icepack_settings%trzs +trbri => icepack_settings%trbri +trage => icepack_settings%trage +trfy => icepack_settings%trfy +trlvl => icepack_settings%trlvl +trpnd => icepack_settings%trpnd +trbgcs => icepack_settings%trbgcs + +ncat => icepack_settings%ncat +nfsd => icepack_settings%nfsd +nilyr => icepack_settings%nilyr +nslyr => icepack_settings%nslyr +n_aero => icepack_settings%n_aero +n_zaero => icepack_settings%n_zaero +n_algae => icepack_settings%n_algae +n_doc => icepack_settings%n_doc +n_dic => icepack_settings%n_dic +n_don => icepack_settings%n_don +n_fed => icepack_settings%n_fed +n_fep => icepack_settings%n_fep +nblyr => icepack_settings%nblyr +n_bgc => icepack_settings%n_bgc +nltrcr => icepack_settings%nltrcr +max_nsw => icepack_settings%max_nsw +nfreq => icepack_settings%nfreq +max_ntrcr => icepack_settings%max_ntrcr + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/icepack_drivers/icedrv_kinds.F90 b/src/icepack_drivers/icedrv_kinds.F90 new file mode 100644 index 000000000..55a51e8bf --- /dev/null +++ b/src/icepack_drivers/icedrv_kinds.F90 @@ -0,0 +1,25 @@ +!======================================================================= +! +! This module defines the icepack drv kinds +! +! author T. Craig +! +!======================================================================= + + module icedrv_kinds + + use icepack_intfc, only: char_len => icepack_char_len + use icepack_intfc, only: char_len_long => icepack_char_len_long + use icepack_intfc, only: log_kind => icepack_log_kind + use icepack_intfc, only: int_kind => icepack_int_kind + use icepack_intfc, only: real_kind => icepack_real_kind + use icepack_intfc, only: dbl_kind => icepack_dbl_kind + use icepack_intfc, only: r16_kind => icepack_r16_kind + +!======================================================================= + + end module icedrv_kinds + +!======================================================================= + + diff --git a/src/icepack_drivers/icedrv_settings.F90 b/src/icepack_drivers/icedrv_settings.F90 new file mode 100644 index 000000000..ea423408e --- /dev/null +++ b/src/icepack_drivers/icedrv_settings.F90 @@ -0,0 +1,67 @@ +!======================================================================= +! +! Defines the domain size, number of categories and layers. +! +! author L. Zampieri +! +!======================================================================= + + module icedrv_settings + + use icedrv_kinds + +!======================================================================= + + implicit none + + type t_icepack_settings + + integer (kind=int_kind) :: nicecat ! number of ice thickness categories + integer (kind=int_kind) :: nfsdcat ! number of floe size categories + integer (kind=int_kind) :: nicelyr ! number of vertical layers in the ice + integer (kind=int_kind) :: nsnwlyr ! number of vertical layers in the snow + integer (kind=int_kind) :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) + integer (kind=int_kind) :: trzaero ! number of z aerosol tracers (up to max_aero = 6) + integer (kind=int_kind) :: tralg ! number of algal tracers (up to max_algae = 3) + integer (kind=int_kind) :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) + integer (kind=int_kind) :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) + integer (kind=int_kind) :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) + integer (kind=int_kind) :: trfed ! number of dissolved iron tracers (up to max_fe = 2) + integer (kind=int_kind) :: trfep ! number of particulate iron tracers (up to max_fe = 2) + integer (kind=int_kind) :: nbgclyr ! number of zbgc layers + integer (kind=int_kind) :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) + integer (kind=int_kind) :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) + integer (kind=int_kind) :: trbri ! set to 1 for brine height tracer + integer (kind=int_kind) :: trage ! set to 1 for ice age tracer + integer (kind=int_kind) :: trfy ! set to 1 for first-year ice area tracer + integer (kind=int_kind) :: trlvl ! set to 1 for level and deformed ice tracers + integer (kind=int_kind) :: trpnd ! set to 1 for melt pond tracers + integer (kind=int_kind) :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) + + integer (kind=int_kind) :: ncat ! number of categories in use + integer (kind=int_kind) :: nfsd ! number of floe size categories in use + integer (kind=int_kind) :: nilyr ! number of ice layers per category in use + integer (kind=int_kind) :: nslyr ! number of snow layers per category in use + integer (kind=int_kind) :: n_aero ! number of aerosols in use + integer (kind=int_kind) :: n_zaero ! number of z aerosols in use + integer (kind=int_kind) :: n_algae ! number of algae in use + integer (kind=int_kind) :: n_doc ! number of DOC pools in use + integer (kind=int_kind) :: n_dic ! number of DIC pools in use + integer (kind=int_kind) :: n_don ! number of DON pools in use + integer (kind=int_kind) :: n_fed ! number of Fe pools in use dissolved Fe + integer (kind=int_kind) :: n_fep ! number of Fe pools in use particulate Fe + integer (kind=int_kind) :: nblyr ! number of bio/brine layers per category + integer (kind=int_kind) :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic + integer (kind=int_kind) :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers + integer (kind=int_kind) :: max_nsw ! number of tracers active in shortwave calculation + integer (kind=int_kind) :: max_ntrcr ! number of tracers in total + integer (kind=int_kind) :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW + + end type t_icepack_settings + +!======================================================================= + + end module icedrv_settings + +!======================================================================= + From 4639dfc4cb006521c29a6470c208604730417981 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Sat, 21 Mar 2020 17:33:08 +0100 Subject: [PATCH 04/54] Delete .associate_icepack_settings.h.swp --- .../.associate_icepack_settings.h.swp | Bin 16384 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 src/icepack_drivers/.associate_icepack_settings.h.swp diff --git a/src/icepack_drivers/.associate_icepack_settings.h.swp b/src/icepack_drivers/.associate_icepack_settings.h.swp deleted file mode 100644 index 5a5e8bac9bf5e584eb3753ec58a08c9ddf51693a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 16384 zcmeHOONaN^+Aa55ppue!Q-dwOeTYtR^Ds*^9Xv;VjMU-i}B z_4vEDJn+=`F1mT$27>DrLe4xi^Zdzp+4!?-32}xt4-9PCA}t-Sx*t@z7#tYv$RcEa z>ac%o``(FNrSXyNk8c}!w7FB0S;KLsN?yokSQzy?Q53k`iCHPLL@bWE zs7C8*O9ZoKtAJIYpuj4!erRw&{_@T{dg$s~pDftzSF36|f3e z1*`&Af&ZWajz`F~XxGoOZFv5lo&S&AOvp~)_nQcL4Oj^rT1Ci4;HMi2*#n%vfe-;) zT1m*4z((Ng_4pldJ8l88e$ z%m>RyibKc6OAeF^8V9lCn|qCB^FAq>xX}L0tK-IaheA4!YC#w$-Etk@o%WrW2f`?r z@Qdw7+eP_tA*^ zeblQ*jfVR0k`Fn+qL0?5>)bU9Q}*XthDAoq_p8i<{&L6#qrNjI$EbniaPb~WH3;X- zLX;}3QRqlZh%rXd?7&aPe>!5c;e;_yhKJEHW*o%pDu~DNMvXtiJo6AyqY+tfi;E^8<@lkS0Q4Z`LUdNy)2laXMe^oIL0Wn^u=d0%ukjPkD+gM zOjmOJyID!%urgPSQVdh!VHB^OV@{a3cS7c*F${a+R14FB9PXB$$Yx8HYPz9YtUSf0 z7u>3~sm6Gn z--U%W{2z+9#0sCqqd{181lDbA$HJh>1nphuqV&;4ZY;6<&xhn93+g&y88Px9(UfjN zcHSGzhwKm#9){_9(_zHEpfHLptBu??__}OS`-v_BnQkVu!Q_Tvm~Jxb6wWh?cNqEH zOg9*9BVjeglvwhDy2C|DuC?pNwivESA`-J5?`^y?jvaKi1ge8o4J$hKCr0-=a+_UA z0Q{Mme{4V&Z4vV7={6u{p3#Jko?)kPjk{BVMNw{hL*)72!&&_uoZaR5KYPCa8_xbe z0&f8g;4z>VxCXd@TEJ=GFt8tZ4tM~#4Y-K6|f3e z1^#UX7M`sPKPV3r$v=%|{~CJtyp?26dvvVCMiMTbr|1}|jbx8ObR1jfk{#tYt_WvOpDnwG7yZNY74M0&Ik26<8fZ*+5Yx zQ#}PXFjVPN&wvdKRkhSJDsv#Hnxmco8yKp5sAs?ihAIN;8O=z#NJ@8lLSjQYt3sQO zliJ{?eL^R;gwZacB|~b~KA{tvWVB7_#FqGIm(bFO3x+Dz=z5dbz-XV&sf}dS5uKOR lhJ02<3@u05kkP6Rq2(xBlG8G4wH#GvNc^m!AzW|w08j=72 From c980ae665c99d0771a5435ecea5a1375924a4de3 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 25 Mar 2020 14:08:32 +0100 Subject: [PATCH 05/54] New structure for modules in icepack_settings --- .gitignore | 1 + src/fvom_main.F90 | 10 +- src/gen_model_setup.F90 | 76 +++++---------- src/icepack_drivers/icedrv_namelist.F90 | 117 ++++++++++++++++++++++++ src/icepack_drivers/icedrv_settings.F90 | 2 +- 5 files changed, 147 insertions(+), 59 deletions(-) create mode 100644 src/icepack_drivers/icedrv_namelist.F90 diff --git a/.gitignore b/.gitignore index f6fe45381..550e7a2dd 100644 --- a/.gitignore +++ b/.gitignore @@ -4,4 +4,5 @@ *.x *.out *~ +*.swp /Icepack diff --git a/src/fvom_main.F90 b/src/fvom_main.F90 index 41c855dc7..18bd88368 100755 --- a/src/fvom_main.F90 +++ b/src/fvom_main.F90 @@ -21,6 +21,10 @@ program main use io_MEANDATA use io_mesh_info use diagnostics + +! Icepack modules +use icedrv_settings + #if defined (__oasis) use cpl_driver #endif @@ -34,8 +38,8 @@ program main real(kind=real32) :: mean_rtime(14), max_rtime(14), min_rtime(14) real(kind=real32) :: runtime_alltimesteps -type(t_mesh), target, save :: mesh - +type(t_mesh), target, save :: mesh +type(t_icepack_settings), target, save :: icepack_settings #ifndef __oifs !ECHAM6-FESOM2 coupling: cpl_oasis3mct_init is called here in order to avoid circular dependencies between modules (cpl_driver and g_PARSUP) @@ -60,7 +64,7 @@ program main ! load the mesh and fill in ! auxiliary mesh arrays !===================== - call setup_model ! Read Namelists, always before clock_init + call setup_model(icepack_settings) ! Read Namelists, always before clock_init call clock_init ! read the clock file call get_run_steps(nsteps) call mesh_setup(mesh) diff --git a/src/gen_model_setup.F90 b/src/gen_model_setup.F90 index 14a8f171f..9f7047e81 100755 --- a/src/gen_model_setup.F90 +++ b/src/gen_model_setup.F90 @@ -1,10 +1,20 @@ ! ============================================================== -subroutine setup_model + +subroutine setup_model(icepack_settings) + + ! Icepack modules + use icedrv_settings + implicit none - call read_namelist ! should be before clock_init + type(t_icepack_settings), intent(inout), target :: icepack_settings + + call read_namelist(icepack_settings) ! should be before clock_init + end subroutine setup_model + ! ============================================================== + subroutine read_namelist(icepack_settings) ! Reads namelist files and overwrites default parameters. ! @@ -17,17 +27,19 @@ subroutine read_namelist(icepack_settings) use g_forcing_param use g_parsup use g_config - use diagnostics, only: ldiag_solver,lcurt_stress_surf,lcurt_stress_surf, ldiag_energy, & - ldiag_dMOC, ldiag_DVD, diag_list - use g_clock, only: timenew, daynew, yearnew + use diagnostics, only: ldiag_solver,lcurt_stress_surf,lcurt_stress_surf, ldiag_energy, & + ldiag_dMOC, ldiag_DVD, diag_list + use g_clock, only: timenew, daynew, yearnew use g_ic3d - ! Refactored - use icedrv_settings + + ! Icepack modules + use icedrv_settings + use icedrv_namelist, only: namelist_settings + implicit none character(len=100) :: nmlfile type(t_icepack_settings), intent(inout), target :: icepack_settings -#include "icepack_drivers/associate_icepack_settings.h" namelist /clockinit/ timenew, daynew, yearnew @@ -108,53 +120,7 @@ subroutine read_namelist(icepack_settings) close (20) if (use_ice .and. use_icepack) then !LZ - - namelist / env_nml / nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & - trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & - trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs - - nmlfile ='namelist.icepack' ! name of icepack namelist file - open (10,file=nmlfile) - read (10,NML=env_nml) - close (10) - - ncat = nicecat ! number of categories - nilyr = nicelyr ! number of ice layers per category - nslyr = nsnwlyr ! number of snow layers per category - n_aero = ntraero ! number of aerosols in use - n_zaero = trzaero ! number of z aerosols in use - n_algae = tralg ! number of algae in use - n_doc = trdoc ! number of DOC pools in use - n_dic = trdic ! number of DIC pools in use - n_don = trdon ! number of DON pools in use - n_fed = trfed ! number of Fe pools in use dissolved Fe - n_fep = trfep ! number of Fe pools in use particulate Fe - nblyr = nbgclyr ! number of bio/brine layers per category - ! maximum number of biology tracers + aerosols - ! *** add to kscavz in icepack_zbgc_shared.F90 - n_bgc = (n_algae*2 + n_doc + n_dic + n_don + n_fed + n_fep + n_zaero & - + 8) ! nit, am, sil, dmspp, dmspd, dms, pon, humic - nltrcr = (n_bgc*trbgcz+trzs)*trbri ! number of zbgc (includes zaero) - ! and zsalinity tracers - max_nsw = (nilyr+nslyr+2) & ! total chlorophyll plus aerosols - * (1+trzaero) ! number of tracers active in shortwave calculation - max_ntrcr = 1 & ! 1 = surface temperature - + nilyr & ! ice salinity - + nilyr & ! ice enthalpy - + nslyr & ! snow enthalpy - !!!!! optional tracers: - + trage & ! age - + trfy & ! first-year area - + trlvl*2 & ! level/deformed ice - + trpnd*3 & ! ponds - + n_aero*4 & ! number of aerosols * 4 aero layers - + trbri & ! brine height - + trbgcs*n_bgc & ! skeletal layer BGC - + trzs *trbri* nblyr & ! zsalinity (off if TRBRI=0) - + n_bgc*trbgcz*trbri*(nblyr+3) & ! zbgc (off if TRBRI=0) - + n_bgc*trbgcz & ! mobile/stationary phase tracer - + 1 ! for unused tracer flags - + call namelist_settings(icepack_settings) endif if(mype==0) write(*,*) 'Namelist files are read in' diff --git a/src/icepack_drivers/icedrv_namelist.F90 b/src/icepack_drivers/icedrv_namelist.F90 new file mode 100644 index 000000000..addc9027e --- /dev/null +++ b/src/icepack_drivers/icedrv_namelist.F90 @@ -0,0 +1,117 @@ +!======================================================================= +! +! Defines and initializes namelists +! +! author L. Zampieri +! +!======================================================================= + + module icedrv_namelist + + use icedrv_kinds + + implicit none + private + public :: namelist_settings + + contains + + subroutine namelist_settings(icepack_settings) + + use icedrv_settings + + implicit none + character(len=100) :: nmlfile + type(t_icepack_settings), intent(inout), target :: icepack_settings + +#include "associate_icepack_settings.h" + + ! Standard values + + nicecat = 5 ! number of ice thickness categories + nicelyr = 4 ! number of vertical layers in the ice + nsnwlyr = 4 ! number of vertical layers in the snow + nfsdcat = 1 ! number of floe size categories + ntraero = 0 ! number of aerosol tracers (up to max_aero in ice_domain_size.f90) + trzaero = 0 ! number of z aerosol tracers (up to max_aero = 6) + tralg = 0 ! number of algal tracers (up to max_algae = 3) + trdoc = 0 ! number of dissolve organic carbon (up to max_doc = 3) + trdic = 0 ! number of dissolve inorganic carbon (up to max_dic = 1) + trdon = 0 ! number of dissolve organic nitrogen (up to max_don = 1) + trfed = 0 ! number of dissolved iron tracers (up to max_fe = 2) + trfep = 0 ! number of particulate iron tracers (up to max_fe = 2) + nbgclyr = 4 ! number of zbgc layers + trbgcz = 0 ! set to 1 for zbgc tracers (needs trbgcs = 0 and trbri = 1) + trzs = 0 ! set to 1 for zsalinity tracer (needs trbri = 1) + trbri = 0 ! set to 1 for brine height tracer + trage = 0 ! set to 1 for ice age tracer + trfy = 0 ! set to 1 for first-year ice area tracer + trlvl = 0 ! set to 1 for level and deformed ice tracers + trpnd = 0 ! set to 1 for melt pond tracers + trbgcs = 0 ! set to 1 for skeletal layer tracers (needs + + ! Read namelist + + namelist / env_nml / nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & + trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & + trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs + + nmlfile ='namelist.icepack' ! name of icepack namelist file + open (10,file=nmlfile) + read (10,NML=env_nml) + close (10) + + ! Derived quantities used by icepack + + ncat = nicecat ! number of categories + nfsd = nfsdcat ! number of floe size categories + nilyr = nicelyr ! number of ice layers per category + nslyr = nsnwlyr ! number of snow layers per category + n_aero = ntraero ! number of aerosols in use + n_zaero = trzaero ! number of z aerosols in use + n_algae = tralg ! number of algae in use + n_doc = trdoc ! number of DOC pools in use + n_dic = trdic ! number of DIC pools in use + n_don = trdon ! number of DON pools in use + n_fed = trfed ! number of Fe pools in use dissolved Fe + n_fep = trfep ! number of Fe pools in use particulate Fe + nblyr = nbgclyr ! number of bio/brine layers per category + ! maximum number of biology tracers + + ! aerosols + ! *** add to kscavz in + ! icepack_zbgc_shared.F90 + n_bgc = (n_algae*2 + n_doc + n_dic + n_don + n_fed + n_fep +n_zaero & + + 8) ! nit, am, sil, dmspp, dmspd, dms, pon, humic + nltrcr = (n_bgc*trbgcz+trzs)*trbri ! number of zbgc (includes zaero) + ! and zsalinity tracers + max_nsw = (nilyr+nslyr+2) & ! total chlorophyll plus aerosols + * (1+trzaero) ! number of tracers active in shortwave calculation + max_ntrcr = 1 & ! 1 = surface temperature + + nilyr & ! ice salinity + + nilyr & ! ice enthalpy + + nslyr & ! snow enthalpy + !!!!! optional tracers: + + nfsd & ! number of floe size categories + + trage & ! age + + trfy & ! first-year area + + trlvl*2 & ! level/deformed ice + + trpnd*3 & ! ponds + + n_aero*4 & ! number of aerosols * 4 aero layers + + trbri & ! brine height + + trbgcs*n_bgc & ! skeletal layer BGC + + trzs *trbri* nblyr & ! zsalinity (off if TRBRI=0) + + n_bgc*trbgcz*trbri*(nblyr+3) & ! zbgc (off if TRBRI=0) + + n_bgc*trbgcz & ! mobile/stationary phase tracer + + 1 ! for unused tracer flags + + end subroutine namelist_settings +!======================================================================= + + end module icedrv_namelist + + + + + + + diff --git a/src/icepack_drivers/icedrv_settings.F90 b/src/icepack_drivers/icedrv_settings.F90 index ea423408e..ce08053c2 100644 --- a/src/icepack_drivers/icedrv_settings.F90 +++ b/src/icepack_drivers/icedrv_settings.F90 @@ -59,7 +59,7 @@ module icedrv_settings end type t_icepack_settings -!======================================================================= +!======================================================================= end module icedrv_settings From 07cd1336fbcd6f4d513d0f4c9d8cd332960a0104 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 25 Mar 2020 21:44:09 +0100 Subject: [PATCH 06/54] Added namelist variables as type --- .../associate_icepack_settings.h | 122 ++++++++++++- src/icepack_drivers/icedrv_namelist.F90 | 1 + src/icepack_drivers/icedrv_settings.F90 | 161 +++++++++++++----- 3 files changed, 241 insertions(+), 43 deletions(-) diff --git a/src/icepack_drivers/associate_icepack_settings.h b/src/icepack_drivers/associate_icepack_settings.h index 76a5d0e3a..9342458be 100644 --- a/src/icepack_drivers/associate_icepack_settings.h +++ b/src/icepack_drivers/associate_icepack_settings.h @@ -1,3 +1,5 @@ +! env namelist + integer (kind=int_kind), pointer :: nicecat ! number of ice thickness categories integer (kind=int_kind), pointer :: nfsdcat ! number of floe size categories integer (kind=int_kind), pointer :: nicelyr ! number of vertical layers in the ice @@ -20,6 +22,7 @@ integer (kind=int_kind), pointer :: trlvl ! set to 1 for level an integer (kind=int_kind), pointer :: trpnd ! set to 1 for melt pond tracers integer (kind=int_kind), pointer :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) +! setting variables used by the model integer (kind=int_kind), pointer :: ncat ! number of categories in use integer (kind=int_kind), pointer :: nfsd ! number of floe size categories in use @@ -40,6 +43,70 @@ integer (kind=int_kind), pointer :: max_nsw ! number of tracers act integer (kind=int_kind), pointer :: max_ntrcr ! number of tracers in total integer (kind=int_kind), pointer :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW +! tracer namelist + +logical (kind=log_kind), pointer :: tr_iage +logical (kind=log_kind), pointer :: tr_FY +logical (kind=log_kind), pointer :: tr_lvl +logical (kind=log_kind), pointer :: tr_pond_cesm +logical (kind=log_kind), pointer :: tr_pond_topo +logical (kind=log_kind), pointer :: tr_pond_lvl +logical (kind=log_kind), pointer :: tr_aero +logical (kind=log_kind), pointer :: tr_fsd + +! thermo namelist + +integer (kind=int_kind), pointer :: kitd +integer (kind=int_kind), pointer :: ktherm +character (len=char_len), pointer :: conduct +real (kind=dbl_kind), pointer :: a_rapid_mode +real (kind=dbl_kind), pointer :: Rac_rapid_mode +real (kind=dbl_kind), pointer :: aspect_rapid_mode +real (kind=dbl_kind), pointer :: dSdt_slow_mode +real (kind=dbl_kind), pointer :: phi_c_slow_mode +real (kind=dbl_kind), pointer :: phi_i_mushy + +! dynamics namelist + +integer (kind=int_kind), pointer :: kstrength +integer (kind=int_kind), pointer :: krdg_partic +integer (kind=int_kind), pointer :: krdg_redist +integer (kind=int_kind), pointer :: mu_rdg +real (kind=dbl_kind), pointer :: Cf + +! shortwave namelist + +character (len=char_len), pointer :: shortwave +character (len=char_len), pointer :: albedo_type +real (kind=dbl_kind), pointer :: albicev +real (kind=dbl_kind), pointer :: albicei +real (kind=dbl_kind), pointer :: albsnowv +real (kind=dbl_kind), pointer :: albsnowi +real (kind=dbl_kind), pointer :: ahmax +real (kind=dbl_kind), pointer :: R_ice +real (kind=dbl_kind), pointer :: R_pnd +real (kind=dbl_kind), pointer :: R_snw +real (kind=dbl_kind), pointer :: dT_mlt +real (kind=dbl_kind), pointer :: rsnw_mlt +real (kind=dbl_kind), pointer :: kalg + +! forcing namelist + +logical (kind=log_kind), pointer :: formdrag +character (len=char_len), pointer :: atmbndy +logical (kind=log_kind), pointer :: calc_strair +logical (kind=log_kind), pointer :: calc_Tsfc +logical (kind=log_kind), pointer :: highfreq +integer (kind=int_kind), pointer :: natmiter +real (kind=dbl_kind), pointer :: ustar_min +real (kind=dbl_kind), pointer :: emissivity +character (len=char_len), pointer :: fbot_xfer_type +logical (kind=log_kind), pointer :: update_ocn_f +logical (kind=log_kind), pointer :: l_mpond_fresh +character (len=char_len), pointer :: tfrz_option +logical (kind=log_kind), pointer :: oceanmixed_ice +character (len=char_len), pointer :: wave_spec_type + nicecat => icepack_settings%nicecat nfsdcat => icepack_settings%nfsdcat nicelyr => icepack_settings%nicelyr @@ -81,8 +148,59 @@ max_nsw => icepack_settings%max_nsw nfreq => icepack_settings%nfreq max_ntrcr => icepack_settings%max_ntrcr - - +tr_iage => icepack_settings%tr_iage +tr_FY => icepack_settings%tr_FY +tr_lvl => icepack_settings%tr_lvl +tr_pond_cesm => icepack_settings%tr_pond_cesm +tr_pond_topo => icepack_settings%tr_pond_topo +tr_pond_lvl => icepack_settings%tr_pond_lvl +tr_aero => icepack_settings%tr_aero +tr_fsd => icepack_settings%tr_fsd + +kitd => icepack_settings%kitd +ktherm => icepack_settings%ktherm +conduct => icepack_settings%conduct +a_rapid_mode => icepack_settings%a_rapid_mode +Rac_rapid_mode => icepack_settings%Rac_rapid_mode +aspect_rapid_mode => icepack_settings%aspect_rapid_mode +dSdt_slow_mode => icepack_settings%dSdt_slow_mode +phi_c_slow_mode => icepack_settings%phi_c_slow_mode +phi_i_mushy => icepack_settings%phi_i_mushy + +kstrength => icepack_settings%kstrength +krdg_partic => icepack_settings%krdg_partic +krdg_redist => icepack_settings%krdg_redist +mu_rdg => icepack_settings%mu_rdg +Cf => icepack_settings%Cf + +shortwave => icepack_settings%shortwave +albedo_type => icepack_settings%albedo_type +albicev => icepack_settings%albicev +albicei => icepack_settings%albicei +albsnowv => icepack_settings%albsnowv +albsnowi => icepack_settings%albsnowi +ahmax => icepack_settings%ahmax +R_ice => icepack_settings%R_ice +R_pnd => icepack_settings%R_pnd +R_snw => icepack_settings%R_snw +dT_mlt => icepack_settings%dT_mlt +rsnw_mlt => icepack_settings%rsnw_mlt +kalg => icepack_settings%kalg + +formdrag => icepack_settings%formdrag +atmbndy => icepack_settings%atmbndy +calc_strair => icepack_settings%calc_strair +calc_Tsfc => icepack_settings%calc_Tsfc +highfreq => icepack_settings%highfreq +natmiter => icepack_settings%natmiter +ustar_min => icepack_settings%ustar_min +emissivity => icepack_settings%emissivity +fbot_xfer_type => icepack_settings%fbot_xfer_type +update_ocn_f => icepack_settings%update_ocn_f +l_mpond_fresh => icepack_settings%l_mpond_fresh +tfrz_option => icepack_settings%tfrz_option +oceanmixed_ice => icepack_settings%oceanmixed_ice +wave_spec_type => icepack_settings%wave_spec_type diff --git a/src/icepack_drivers/icedrv_namelist.F90 b/src/icepack_drivers/icedrv_namelist.F90 index addc9027e..e60c65c25 100644 --- a/src/icepack_drivers/icedrv_namelist.F90 +++ b/src/icepack_drivers/icedrv_namelist.F90 @@ -75,6 +75,7 @@ subroutine namelist_settings(icepack_settings) n_don = trdon ! number of DON pools in use n_fed = trfed ! number of Fe pools in use dissolved Fe n_fep = trfep ! number of Fe pools in use particulate Fe + nfreq = 25 ! number of wave frequencies ! HARDWIRED FOR NOW nblyr = nbgclyr ! number of bio/brine layers per category ! maximum number of biology tracers + ! aerosols diff --git a/src/icepack_drivers/icedrv_settings.F90 b/src/icepack_drivers/icedrv_settings.F90 index ce08053c2..e0e9e3ef9 100644 --- a/src/icepack_drivers/icedrv_settings.F90 +++ b/src/icepack_drivers/icedrv_settings.F90 @@ -3,7 +3,7 @@ ! Defines the domain size, number of categories and layers. ! ! author L. Zampieri -! +!a !======================================================================= module icedrv_settings @@ -16,46 +16,125 @@ module icedrv_settings type t_icepack_settings - integer (kind=int_kind) :: nicecat ! number of ice thickness categories - integer (kind=int_kind) :: nfsdcat ! number of floe size categories - integer (kind=int_kind) :: nicelyr ! number of vertical layers in the ice - integer (kind=int_kind) :: nsnwlyr ! number of vertical layers in the snow - integer (kind=int_kind) :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) - integer (kind=int_kind) :: trzaero ! number of z aerosol tracers (up to max_aero = 6) - integer (kind=int_kind) :: tralg ! number of algal tracers (up to max_algae = 3) - integer (kind=int_kind) :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) - integer (kind=int_kind) :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) - integer (kind=int_kind) :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) - integer (kind=int_kind) :: trfed ! number of dissolved iron tracers (up to max_fe = 2) - integer (kind=int_kind) :: trfep ! number of particulate iron tracers (up to max_fe = 2) - integer (kind=int_kind) :: nbgclyr ! number of zbgc layers - integer (kind=int_kind) :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) - integer (kind=int_kind) :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) - integer (kind=int_kind) :: trbri ! set to 1 for brine height tracer - integer (kind=int_kind) :: trage ! set to 1 for ice age tracer - integer (kind=int_kind) :: trfy ! set to 1 for first-year ice area tracer - integer (kind=int_kind) :: trlvl ! set to 1 for level and deformed ice tracers - integer (kind=int_kind) :: trpnd ! set to 1 for melt pond tracers - integer (kind=int_kind) :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) - - integer (kind=int_kind) :: ncat ! number of categories in use - integer (kind=int_kind) :: nfsd ! number of floe size categories in use - integer (kind=int_kind) :: nilyr ! number of ice layers per category in use - integer (kind=int_kind) :: nslyr ! number of snow layers per category in use - integer (kind=int_kind) :: n_aero ! number of aerosols in use - integer (kind=int_kind) :: n_zaero ! number of z aerosols in use - integer (kind=int_kind) :: n_algae ! number of algae in use - integer (kind=int_kind) :: n_doc ! number of DOC pools in use - integer (kind=int_kind) :: n_dic ! number of DIC pools in use - integer (kind=int_kind) :: n_don ! number of DON pools in use - integer (kind=int_kind) :: n_fed ! number of Fe pools in use dissolved Fe - integer (kind=int_kind) :: n_fep ! number of Fe pools in use particulate Fe - integer (kind=int_kind) :: nblyr ! number of bio/brine layers per category - integer (kind=int_kind) :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic - integer (kind=int_kind) :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers - integer (kind=int_kind) :: max_nsw ! number of tracers active in shortwave calculation - integer (kind=int_kind) :: max_ntrcr ! number of tracers in total - integer (kind=int_kind) :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW + ! env namelist + + integer (kind=int_kind) :: nicecat ! number of ice thickness categories + integer (kind=int_kind) :: nfsdcat ! number of floe size categories + integer (kind=int_kind) :: nicelyr ! number of vertical layers in the ice + integer (kind=int_kind) :: nsnwlyr ! number of vertical layers in the snow + integer (kind=int_kind) :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) + integer (kind=int_kind) :: trzaero ! number of z aerosol tracers (up to max_aero = 6) + integer (kind=int_kind) :: tralg ! number of algal tracers (up to max_algae = 3) + integer (kind=int_kind) :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) + integer (kind=int_kind) :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) + integer (kind=int_kind) :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) + integer (kind=int_kind) :: trfed ! number of dissolved iron tracers (up to max_fe = 2) + integer (kind=int_kind) :: trfep ! number of particulate iron tracers (up to max_fe = 2) + integer (kind=int_kind) :: nbgclyr ! number of zbgc layers + integer (kind=int_kind) :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) + integer (kind=int_kind) :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) + integer (kind=int_kind) :: trbri ! set to 1 for brine height tracer + integer (kind=int_kind) :: trage ! set to 1 for ice age tracer + integer (kind=int_kind) :: trfy ! set to 1 for first-year ice area tracer + integer (kind=int_kind) :: trlvl ! set to 1 for level and deformed ice tracers + integer (kind=int_kind) :: trpnd ! set to 1 for melt pond tracers + integer (kind=int_kind) :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) + + ! setting variables used by the model + + integer (kind=int_kind) :: ncat ! number of categories in use + integer (kind=int_kind) :: nfsd ! number of floe size categories in use + integer (kind=int_kind) :: nilyr ! number of ice layers per category in use + integer (kind=int_kind) :: nslyr ! number of snow layers per category in use + integer (kind=int_kind) :: n_aero ! number of aerosols in use + integer (kind=int_kind) :: n_zaero ! number of z aerosols in use + integer (kind=int_kind) :: n_algae ! number of algae in use + integer (kind=int_kind) :: n_doc ! number of DOC pools in use + integer (kind=int_kind) :: n_dic ! number of DIC pools in use + integer (kind=int_kind) :: n_don ! number of DON pools in use + integer (kind=int_kind) :: n_fed ! number of Fe pools in use dissolved Fe + integer (kind=int_kind) :: n_fep ! number of Fe pools in use particulate Fe + integer (kind=int_kind) :: nblyr ! number of bio/brine layers per category + integer (kind=int_kind) :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic + integer (kind=int_kind) :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers + integer (kind=int_kind) :: max_nsw ! number of tracers active in shortwave calculation + integer (kind=int_kind) :: max_ntrcr ! number of tracers in total + integer (kind=int_kind) :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW + + ! tracer namelist + + logical (kind=log_kind) :: tr_iage + logical (kind=log_kind) :: tr_FY + logical (kind=log_kind) :: tr_lvl + logical (kind=log_kind) :: tr_pond_cesm + logical (kind=log_kind) :: tr_pond_topo + logical (kind=log_kind) :: tr_pond_lvl + logical (kind=log_kind) :: tr_aero + logical (kind=log_kind) :: tr_fsd + + ! thermo namelist + + integer (kind=int_kind) :: kitd + integer (kind=int_kind) :: ktherm + character (len=char_len) :: conduct + real (kind=dbl_kind) :: a_rapid_mode + real (kind=dbl_kind) :: Rac_rapid_mode + real (kind=dbl_kind) :: aspect_rapid_mode + real (kind=dbl_kind) :: dSdt_slow_mode + real (kind=dbl_kind) :: phi_c_slow_mode + real (kind=dbl_kind) :: phi_i_mushy + + ! dynamics namelist + + integer (kind=int_kind) :: kstrength + integer (kind=int_kind) :: krdg_partic + integer (kind=int_kind) :: krdg_redist + integer (kind=int_kind) :: mu_rdg + real (kind=dbl_kind) :: Cf + + ! shortwave namelist + + character (len=char_len) :: shortwave + character (len=char_len) :: albedo_type + real (kind=dbl_kind) :: albicev + real (kind=dbl_kind) :: albicei + real (kind=dbl_kind) :: albsnowv + real (kind=dbl_kind) :: albsnowi + real (kind=dbl_kind) :: ahmax + real (kind=dbl_kind) :: R_ice + real (kind=dbl_kind) :: R_pnd + real (kind=dbl_kind) :: R_snw + real (kind=dbl_kind) :: dT_mlt + real (kind=dbl_kind) :: rsnw_mlt + real (kind=dbl_kind) :: kalg + + ! ponds namelist + + real (kind=dbl_kind) :: hp1 + real (kind=dbl_kind) :: hs0 + real (kind=dbl_kind) :: hs1 + real (kind=dbl_kind) :: dpscale + character (len=char_len) :: frzpnd + real (kind=dbl_kind) :: rfracmin + real (kind=dbl_kind) :: rfracmax + real (kind=dbl_kind) :: pndaspect + + ! forcing namelist + + logical (kind=log_kind) :: formdrag + character (len=char_len) :: atmbndy + logical (kind=log_kind) :: calc_strair + logical (kind=log_kind) :: calc_Tsfc + logical (kind=log_kind) :: highfreq + integer (kind=int_kind) :: natmiter + real (kind=dbl_kind) :: ustar_min + real (kind=dbl_kind) :: emissivity + character (len=char_len) :: fbot_xfer_type + logical (kind=log_kind) :: update_ocn_f + logical (kind=log_kind) :: l_mpond_fresh + character (len=char_len) :: tfrz_option + logical (kind=log_kind) :: oceanmixed_ice + character (len=char_len) :: wave_spec_type end type t_icepack_settings From 1bd541e7b8ae802665c5715cb27fa45c879bcb44 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 19 May 2020 14:22:08 +0200 Subject: [PATCH 07/54] Code status before merging changes from master --- src/gen_model_setup.F90 | 6 +- src/icepack_drivers/icedrv_constants.F90 | 107 ++++++++ src/icepack_drivers/icedrv_init.F90 | 299 +++++++++++++++++++++++ src/icepack_drivers/icedrv_namelist.F90 | 118 --------- src/icepack_drivers/icedrv_system.F90 | 57 +++++ 5 files changed, 466 insertions(+), 121 deletions(-) create mode 100644 src/icepack_drivers/icedrv_constants.F90 create mode 100644 src/icepack_drivers/icedrv_init.F90 delete mode 100644 src/icepack_drivers/icedrv_namelist.F90 create mode 100644 src/icepack_drivers/icedrv_system.F90 diff --git a/src/gen_model_setup.F90 b/src/gen_model_setup.F90 index 9f7047e81..d58a04ae9 100755 --- a/src/gen_model_setup.F90 +++ b/src/gen_model_setup.F90 @@ -3,7 +3,7 @@ subroutine setup_model(icepack_settings) ! Icepack modules - use icedrv_settings + use icedrv_init implicit none @@ -34,7 +34,7 @@ subroutine read_namelist(icepack_settings) ! Icepack modules use icedrv_settings - use icedrv_namelist, only: namelist_settings + use icedrv_init, only: read_namelist_icepack implicit none @@ -120,7 +120,7 @@ subroutine read_namelist(icepack_settings) close (20) if (use_ice .and. use_icepack) then !LZ - call namelist_settings(icepack_settings) + call read_namelist_icepack(icepack_settings) endif if(mype==0) write(*,*) 'Namelist files are read in' diff --git a/src/icepack_drivers/icedrv_constants.F90 b/src/icepack_drivers/icedrv_constants.F90 new file mode 100644 index 000000000..43d212c27 --- /dev/null +++ b/src/icepack_drivers/icedrv_constants.F90 @@ -0,0 +1,107 @@ +!======================================================================= +! +! This module defines a variety of physical and numerical constants +! used throughout the ice model +! +! author Elizabeth C. Hunke, LANL + + module icedrv_constants + + use icedrv_kinds + + implicit none + + !----------------------------------------------------------------- + ! file units + !----------------------------------------------------------------- + + integer (kind=int_kind), parameter, public :: & + ice_stdin = 5, & ! reserved unit for standard input + ice_stdout = 6, & ! reserved unit for standard output + ice_stderr = 6, & ! reserved unit for standard error + nu_nml = 10, & ! unit for namelist + nu_restart = 12, & ! unit for restart file + nu_dump = 13, & ! unit for dump file + nu_forcing = 14, & ! unit for forcing file + nu_open_clos = 15, & ! unit for SHEBA forcing file + nu_diag = ice_stdout, & ! unit for diagnostic output + nu_diag_out = 103 + + !----------------------------------------------------------------- + ! numerical constants + !----------------------------------------------------------------- + + real (kind=dbl_kind), parameter, public :: & + c0 = 0.0_dbl_kind, & + c1 = 1.0_dbl_kind, & + c1p5 = 1.5_dbl_kind, & + c2 = 2.0_dbl_kind, & + c3 = 3.0_dbl_kind, & + c4 = 4.0_dbl_kind, & + c5 = 5.0_dbl_kind, & + c6 = 6.0_dbl_kind, & + c8 = 8.0_dbl_kind, & + c10 = 10.0_dbl_kind, & + c15 = 15.0_dbl_kind, & + c16 = 16.0_dbl_kind, & + c20 = 20.0_dbl_kind, & + c24 = 24.0_dbl_kind, & + c25 = 25.0_dbl_kind, & + c100 = 100.0_dbl_kind, & + c1000= 1000.0_dbl_kind, & + p001 = 0.001_dbl_kind, & + p01 = 0.01_dbl_kind, & + p1 = 0.1_dbl_kind, & + p2 = 0.2_dbl_kind, & + p4 = 0.4_dbl_kind, & + p5 = 0.5_dbl_kind, & + p6 = 0.6_dbl_kind, & + p05 = 0.05_dbl_kind, & + p15 = 0.15_dbl_kind, & + p25 = 0.25_dbl_kind, & + p75 = 0.75_dbl_kind, & + p333 = c1/c3, & + p666 = c2/c3, & + puny = 10.0e-11_dbl_kind + + !----------------------------------------------------------------- + ! physical constants + !----------------------------------------------------------------- + + real (kind=dbl_kind), parameter, public :: & + omega = 7.292e-5_dbl_kind ! angular velocity of earth(rad/sec) + + !----------------------------------------------------------------- + ! numbers used outside the column package + !----------------------------------------------------------------- + + real (kind=dbl_kind), parameter, public :: & + c9 = 9.0_dbl_kind, & + c12 = 12.0_dbl_kind, & + c30 = 30.0_dbl_kind, & + c180 = 180.0_dbl_kind, & + c360 = 360.0_dbl_kind, & + c365 = 365.0_dbl_kind, & + c400 = 400.0_dbl_kind, & + c3600= 3600.0_dbl_kind, & + p025 = 0.025_dbl_kind, & + p166 = c1/c6, & + p111 = c1/c9, & + p055 = p111*p5, & + p027 = p055*p5, & + p222 = c2/c9, & + eps13 = 1.0e-13_dbl_kind, & + eps16 = 1.0e-16_dbl_kind + + !----------------------------------------------------------------- + ! conversion factors + !----------------------------------------------------------------- + + real (kind=dbl_kind), parameter, public :: & + mps_to_cmpdy = 8.64e6_dbl_kind ! m per s to cm per day + +!======================================================================= + + end module icedrv_constants + +!======================================================================= diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 new file mode 100644 index 000000000..56fcc1b74 --- /dev/null +++ b/src/icepack_drivers/icedrv_init.F90 @@ -0,0 +1,299 @@ +!======================================================================= +! +! This module defines and and initializes the namelists +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + + module icedrv_init + + use icedrv_kinds + use icedrv_constants, only: nu_diag, ice_stdout, nu_diag_out, nu_nml + use icedrv_constants, only: c0, c1, c2, c3, p2, p5, puny + use icepack_intfc, only: icepack_init_parameters + use icepack_intfc, only: icepack_init_fsd + use icepack_intfc, only: icepack_init_tracer_flags + use icepack_intfc, only: icepack_init_tracer_sizes + use icepack_intfc, only: icepack_init_tracer_indices + use icepack_intfc, only: icepack_init_trcr + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_tracer_indices + use icepack_intfc, only: icepack_warnings_flush + use icepack_intfc, only: icepack_warnings_aborted + use icedrv_system, only: icedrv_system_abort + + implicit none + private + public :: read_namelist_icepack + + contains + + subroutine read_namelist_icepack(icepack_settings) + + use icedrv_settings + + implicit none + + character(len=char_len) :: nml_filename + integer (kind=int_kind) :: nml_error, & ! namelist i/o error flag + n ! loop index + type(t_icepack_settings), intent(inout), target :: icepack_settings + +#include "associate_icepack_settings.h" + + !----------------------------------------------------------------- + ! Namelist definition + !----------------------------------------------------------------- + + nml_filename = 'namelist.icepack' ! name of icepack namelist file + + namelist / env_nml / & + nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & + trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & + trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs + + namelist /thermo_nml/ & + kitd, ktherm, conduct, & + a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, & + dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy + + namelist /dynamics_nml/ & + kstrength, krdg_partic, krdg_redist, mu_rdg, & + Cf + + namelist /shortwave_nml/ & + shortwave, albedo_type, & + albicev, albicei, albsnowv, albsnowi, & + ahmax, R_ice, R_pnd, R_snw,& + dT_mlt, rsnw_mlt, kalg + + namelist /ponds_nml/ & + hs0, dpscale, frzpnd, & + rfracmin, rfracmax, pndaspect, hs1, & + hp1 + + namelist /tracer_nml/ & + tr_iage, tr_FY, tr_lvl, tr_pond_cesm, & + tr_pond_lvl, tr_pond_topo, tr_aero, tr_fsd + + namelist /forcing_nml/ & + atmbndy, calc_strair, calc_Tsfc, & + update_ocn_f, l_mpond_fresh, ustar_min, & + fbot_xfer_type, oceanmixed_ice, emissivity, & + formdrag, highfreq, natmiter, & + tfrz_option, wave_spec_type + + !----------------------------------------------------------------- + ! env namelist - STANDARD VALUES + !----------------------------------------------------------------- + + nicecat = 5 ! number of ice thickness categories + nicelyr = 4 ! number of vertical layers in the ice + nsnwlyr = 4 ! number of vertical layers in the snow + nfsdcat = 1 ! number of floe size categories + ntraero = 0 ! number of aerosol tracers (up to max_aero in ice_domain_size.f90) + trzaero = 0 ! number of z aerosol tracers (up to max_aero = 6) + tralg = 0 ! number of algal tracers (up to max_algae = 3) + trdoc = 0 ! number of dissolve organic carbon (up to max_doc = 3) + trdic = 0 ! number of dissolve inorganic carbon (up to max_dic = 1) + trdon = 0 ! number of dissolve organic nitrogen (up to max_don = 1) + trfed = 0 ! number of dissolved iron tracers (up to max_fe = 2) + trfep = 0 ! number of particulate iron tracers (up to max_fe = 2) + nbgclyr = 4 ! number of zbgc layers + trbgcz = 0 ! set to 1 for zbgc tracers (needs trbgcs = 0 and trbri = 1) + trzs = 0 ! set to 1 for zsalinity tracer (needs trbri = 1) + trbri = 0 ! set to 1 for brine height tracer + trage = 0 ! set to 1 for ice age tracer + trfy = 0 ! set to 1 for first-year ice area tracer + trlvl = 0 ! set to 1 for level and deformed ice tracers + trpnd = 0 ! set to 1 for melt pond tracers + trbgcs = 0 ! set to 1 for skeletal layer tracers (needs + + !----------------------------------------------------------------- + ! Read namelist env_nml + !----------------------------------------------------------------- + + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + end if + + if (nml_error > 0) + print*,'Reading namelist file ',nml_filename + + print*,'Reading setup_nml' + read(nu_nml, nml=env_nml,iostat=nml_error) + end if + + if (nml_error == 0) close(nu_nml) + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + close(nu_nml) + end if + + !----------------------------------------------------------------- + ! Derived quantities used by the icepack model + !----------------------------------------------------------------- + + ncat = nicecat ! number of categories + nfsd = nfsdcat ! number of floe size categories + nilyr = nicelyr ! number of ice layers per category + nslyr = nsnwlyr ! number of snow layers per category + n_aero = ntraero ! number of aerosols in use + n_zaero = trzaero ! number of z aerosols in use + n_algae = tralg ! number of algae in use + n_doc = trdoc ! number of DOC pools in use + n_dic = trdic ! number of DIC pools in use + n_don = trdon ! number of DON pools in use + n_fed = trfed ! number of Fe pools in use dissolved Fe + n_fep = trfep ! number of Fe pools in use particulate Fe + nfreq = 25 ! number of wave frequencies ! HARDWIRED FOR NOW + nblyr = nbgclyr ! number of bio/brine layers per category + ! maximum number of biology tracers + + ! aerosols + ! *** add to kscavz in + ! icepack_zbgc_shared.F90 + n_bgc = (n_algae*2 + n_doc + n_dic + n_don + n_fed + n_fep +n_zaero & + + 8) ! nit, am, sil, dmspp, dmspd, dms, pon, humic + nltrcr = (n_bgc*trbgcz+trzs)*trbri ! number of zbgc (includes zaero) + ! and zsalinity tracers + max_nsw = (nilyr+nslyr+2) & ! total chlorophyll plus aerosols + * (1+trzaero) ! number of tracers active in shortwave calculation + max_ntrcr = 1 & ! 1 = surface temperature + + nilyr & ! ice salinity + + nilyr & ! ice enthalpy + + nslyr & ! snow enthalpy + !!!!! optional tracers: + + nfsd & ! number of floe size categories + + trage & ! age + + trfy & ! first-year area + + trlvl*2 & ! level/deformed ice + + trpnd*3 & ! ponds + + n_aero*4 & ! number of aerosols * 4 aero layers + + trbri & ! brine height + + trbgcs*n_bgc & ! skeletal layer BGC + + trzs *trbri* nblyr & ! zsalinity (off if TRBRI=0) + + n_bgc*trbgcz*trbri*(nblyr+3) & ! zbgc (off if TRBRI=0) + + n_bgc*trbgcz & ! mobile/stationary phase tracer + + 1 ! for unused tracer flags + + !----------------------------------------------------------------- + ! query Icepack default values + !----------------------------------------------------------------- + + call icepack_query_parameters(ustar_min_out=ustar_min, Cf_out=Cf, & + albicev_out=albicev, albicei_out=albicei, & + albsnowv_out=albsnowv, albsnowi_out=albsnowi, & + natmiter_out=natmiter, ahmax_out=ahmax, shortwave_out=shortwave, & + albedo_type_out=albedo_type, R_ice_out=R_ice, R_pnd_out=R_pnd, & + R_snw_out=R_snw, dT_mlt_out=dT_mlt, rsnw_mlt_out=rsnw_mlt, & + kstrength_out=kstrength, krdg_partic_out=krdg_partic, & + krdg_redist_out=krdg_redist, mu_rdg_out=mu_rdg, & + atmbndy_out=atmbndy, calc_strair_out=calc_strair, & + formdrag_out=formdrag, highfreq_out=highfreq, & + emissivity_out=emissivity, & + kitd_out=kitd, kcatbound_out=kcatbound, hs0_out=hs0, & + dpscale_out=dpscale, frzpnd_out=frzpnd, & + rfracmin_out=rfracmin, rfracmax_out=rfracmax, & + pndaspect_out=pndaspect, hs1_out=hs1, hp1_out=hp1, & + ktherm_out=ktherm, calc_Tsfc_out=calc_Tsfc, & + update_ocn_f_out = update_ocn_f, & + conduct_out=conduct, a_rapid_mode_out=a_rapid_mode, & + Rac_rapid_mode_out=Rac_rapid_mode, & + aspect_rapid_mode_out=aspect_rapid_mode, & + dSdt_slow_mode_out=dSdt_slow_mode, & + phi_c_slow_mode_out=phi_c_slow_mode, & + phi_i_mushy_out=phi_i_mushy, & + tfrz_option_out=tfrz_option, kalg_out=kalg, & + fbot_xfer_type_out=fbot_xfer_type, puny_out=puny, & + wave_spec_type_out=wave_spec_type) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! other default values + !----------------------------------------------------------------- + + ndtd = 1 ! dynamic time steps per thermodynamic time step + l_mpond_fresh = .false. ! logical switch for including meltpond freshwater + ! flux feedback to ocean model + oceanmixed_ice = .false. ! if true, use internal ocean mixed layer + wave_spec_type = 'none' ! type of wave spectrum forcing + + tr_iage = .false. ! ice age + tr_FY = .false. ! ice age + tr_lvl = .false. ! level ice + tr_pond_cesm = .false. ! CESM melt ponds + tr_pond_lvl = .false. ! level-ice melt ponds + tr_pond_topo = .false. ! explicit melt ponds (topographic) + tr_aero = .false. ! aerosols + tr_fsd = .false. ! floe size distribution + + + !----------------------------------------------------------------- + ! read from input file + !----------------------------------------------------------------- + + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + + do while (nml_error > 0) + print*,'Reading namelist file ',nml_filename + + print*,'Reading setup_nml' + read(nu_nml, nml=setup_nml,iostat=nml_error) + if (nml_error /= 0) exit + + print*,'Reading grid_nml' + read(nu_nml, nml=grid_nml,iostat=nml_error) + if (nml_error /= 0) exit + + print*,'Reading tracer_nml' + read(nu_nml, nml=tracer_nml,iostat=nml_error) + if (nml_error /= 0) exit + + print*,'Reading thermo_nml' + read(nu_nml, nml=thermo_nml,iostat=nml_error) + if (nml_error /= 0) exit + + print*,'Reading shortwave_nml' + read(nu_nml, nml=shortwave_nml,iostat=nml_error) + if (nml_error /= 0) exit + + print*,'Reading ponds_nml' + read(nu_nml, nml=ponds_nml,iostat=nml_error) + if (nml_error /= 0) exit + + print*,'Reading forcing_nml' + read(nu_nml, nml=forcing_nml,iostat=nml_error) + if (nml_error /= 0) exit + end do + if (nml_error == 0) close(nu_nml) + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) + + end subroutine read_namelist_icepack +!======================================================================= + + end module icedrv_init + + + + + + + diff --git a/src/icepack_drivers/icedrv_namelist.F90 b/src/icepack_drivers/icedrv_namelist.F90 deleted file mode 100644 index e60c65c25..000000000 --- a/src/icepack_drivers/icedrv_namelist.F90 +++ /dev/null @@ -1,118 +0,0 @@ -!======================================================================= -! -! Defines and initializes namelists -! -! author L. Zampieri -! -!======================================================================= - - module icedrv_namelist - - use icedrv_kinds - - implicit none - private - public :: namelist_settings - - contains - - subroutine namelist_settings(icepack_settings) - - use icedrv_settings - - implicit none - character(len=100) :: nmlfile - type(t_icepack_settings), intent(inout), target :: icepack_settings - -#include "associate_icepack_settings.h" - - ! Standard values - - nicecat = 5 ! number of ice thickness categories - nicelyr = 4 ! number of vertical layers in the ice - nsnwlyr = 4 ! number of vertical layers in the snow - nfsdcat = 1 ! number of floe size categories - ntraero = 0 ! number of aerosol tracers (up to max_aero in ice_domain_size.f90) - trzaero = 0 ! number of z aerosol tracers (up to max_aero = 6) - tralg = 0 ! number of algal tracers (up to max_algae = 3) - trdoc = 0 ! number of dissolve organic carbon (up to max_doc = 3) - trdic = 0 ! number of dissolve inorganic carbon (up to max_dic = 1) - trdon = 0 ! number of dissolve organic nitrogen (up to max_don = 1) - trfed = 0 ! number of dissolved iron tracers (up to max_fe = 2) - trfep = 0 ! number of particulate iron tracers (up to max_fe = 2) - nbgclyr = 4 ! number of zbgc layers - trbgcz = 0 ! set to 1 for zbgc tracers (needs trbgcs = 0 and trbri = 1) - trzs = 0 ! set to 1 for zsalinity tracer (needs trbri = 1) - trbri = 0 ! set to 1 for brine height tracer - trage = 0 ! set to 1 for ice age tracer - trfy = 0 ! set to 1 for first-year ice area tracer - trlvl = 0 ! set to 1 for level and deformed ice tracers - trpnd = 0 ! set to 1 for melt pond tracers - trbgcs = 0 ! set to 1 for skeletal layer tracers (needs - - ! Read namelist - - namelist / env_nml / nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & - trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & - trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs - - nmlfile ='namelist.icepack' ! name of icepack namelist file - open (10,file=nmlfile) - read (10,NML=env_nml) - close (10) - - ! Derived quantities used by icepack - - ncat = nicecat ! number of categories - nfsd = nfsdcat ! number of floe size categories - nilyr = nicelyr ! number of ice layers per category - nslyr = nsnwlyr ! number of snow layers per category - n_aero = ntraero ! number of aerosols in use - n_zaero = trzaero ! number of z aerosols in use - n_algae = tralg ! number of algae in use - n_doc = trdoc ! number of DOC pools in use - n_dic = trdic ! number of DIC pools in use - n_don = trdon ! number of DON pools in use - n_fed = trfed ! number of Fe pools in use dissolved Fe - n_fep = trfep ! number of Fe pools in use particulate Fe - nfreq = 25 ! number of wave frequencies ! HARDWIRED FOR NOW - nblyr = nbgclyr ! number of bio/brine layers per category - ! maximum number of biology tracers + - ! aerosols - ! *** add to kscavz in - ! icepack_zbgc_shared.F90 - n_bgc = (n_algae*2 + n_doc + n_dic + n_don + n_fed + n_fep +n_zaero & - + 8) ! nit, am, sil, dmspp, dmspd, dms, pon, humic - nltrcr = (n_bgc*trbgcz+trzs)*trbri ! number of zbgc (includes zaero) - ! and zsalinity tracers - max_nsw = (nilyr+nslyr+2) & ! total chlorophyll plus aerosols - * (1+trzaero) ! number of tracers active in shortwave calculation - max_ntrcr = 1 & ! 1 = surface temperature - + nilyr & ! ice salinity - + nilyr & ! ice enthalpy - + nslyr & ! snow enthalpy - !!!!! optional tracers: - + nfsd & ! number of floe size categories - + trage & ! age - + trfy & ! first-year area - + trlvl*2 & ! level/deformed ice - + trpnd*3 & ! ponds - + n_aero*4 & ! number of aerosols * 4 aero layers - + trbri & ! brine height - + trbgcs*n_bgc & ! skeletal layer BGC - + trzs *trbri* nblyr & ! zsalinity (off if TRBRI=0) - + n_bgc*trbgcz*trbri*(nblyr+3) & ! zbgc (off if TRBRI=0) - + n_bgc*trbgcz & ! mobile/stationary phase tracer - + 1 ! for unused tracer flags - - end subroutine namelist_settings -!======================================================================= - - end module icedrv_namelist - - - - - - - diff --git a/src/icepack_drivers/icedrv_system.F90 b/src/icepack_drivers/icedrv_system.F90 new file mode 100644 index 000000000..8ad5871fb --- /dev/null +++ b/src/icepack_drivers/icedrv_system.F90 @@ -0,0 +1,57 @@ +!======================================================================= +! +! Diagnostic information output during run +! +! author: Tony Craig + + module icedrv_system + + use icedrv_kinds + use icedrv_constants, only: nu_diag + !use icedrv_state, only: aice + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + + implicit none + private + public :: icedrv_system_abort + +!======================================================================= + + contains + +!======================================================================= + + subroutine icedrv_system_abort(icell, istep, string, file, line) + + integer (kind=int_kind), intent(in), optional :: & + icell , & ! indices of grid cell where model aborts + istep , & ! time step number + line ! line number + + character (len=*), intent(in), optional :: string, file + + ! local variables + + character(len=*), parameter :: subname='(icedrv_system_abort)' + + write(nu_diag,*) ' ' + + call icepack_warnings_flush(nu_diag) + + write(nu_diag,*) ' ' + write(nu_diag,*) subname,' ABORTED: ' + if (present(file)) write (nu_diag,*) subname,' called from', trim(file) + if (present(line)) write (nu_diag,*) subname,' line number', line + if (present(istep)) write (nu_diag,*) subname,' istep =', istep + !if (present(icell)) write (nu_diag,*) subname,' i, aice =', icell, aice(icell) + if (present(string)) write (nu_diag,*) subname,' string =', trim(string) + stop + + end subroutine icedrv_system_abort + +!======================================================================= + + end module icedrv_system + +!======================================================================= + From b2a3217bfd43888c7a9accca4a8b3083f0f678f6 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 19 May 2020 15:04:09 +0200 Subject: [PATCH 08/54] USE_ICEPACK flag added to cmake --- CMakeLists.txt | 3 ++- config/namelist.config | 1 - 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 1f1b82626..122359626 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -9,8 +9,9 @@ endif() project(FESOM2.0) set(TOPLEVEL_DIR ${CMAKE_CURRENT_LIST_DIR}) set(FESOM_COUPLED OFF CACHE BOOL "compile fesom standalone or with oasis support (i.e. coupled)") -set(OIFS_COUPLED OFF CACHE BOOL "compile fesom coupled to OpenIFS. Also needs FESOM_COUPLED to work)") +set(OIFS_COUPLED OFF CACHE BOOL "compile fesom coupled to OpenIFS. (Also needs FESOM_COUPLED to work)") set(CRAY OFF CACHE BOOL "compile with cray ftn") +set(USE_ICEPACK ON CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") #set(VERBOSE OFF CACHE BOOL "toggle debug output") #add_subdirectory(oasis3-mct/lib/psmile) add_subdirectory(src) diff --git a/config/namelist.config b/config/namelist.config index aaf939c33..5c1d25e0d 100755 --- a/config/namelist.config +++ b/config/namelist.config @@ -52,7 +52,6 @@ include_fleapyear=.false. use_ice=.true. ! ocean+ice use_floatice = .false. use_sw_pene=.true. -use_icepack=.true. / &machine From 55b3f923d9aeb628680da768f22f2600766c1d53 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 19 May 2020 23:53:01 +0200 Subject: [PATCH 09/54] Before going to bed... --- config/namelist.icepack | 1 + src/fvom_main.F90 | 17 +- src/gen_model_setup.F90 | 12 +- .../associate_icepack_domain_size.h | 45 + .../associate_icepack_namelists.h | 193 +++++ .../associate_icepack_settings.h | 230 ----- src/icepack_drivers/icedrv_constants.F90 | 24 +- src/icepack_drivers/icedrv_init.F90 | 299 ------- src/icepack_drivers/icedrv_set.F90 | 784 ++++++++++++++++++ src/icepack_drivers/icedrv_settings.F90 | 63 +- 10 files changed, 1094 insertions(+), 574 deletions(-) create mode 100644 src/icepack_drivers/associate_icepack_domain_size.h create mode 100644 src/icepack_drivers/associate_icepack_namelists.h delete mode 100644 src/icepack_drivers/associate_icepack_settings.h delete mode 100644 src/icepack_drivers/icedrv_init.F90 create mode 100644 src/icepack_drivers/icedrv_set.F90 diff --git a/config/namelist.icepack b/config/namelist.icepack index 89f25908a..bd1678624 100755 --- a/config/namelist.icepack +++ b/config/namelist.icepack @@ -20,6 +20,7 @@ trlvl = 0 ! set to 1 for level and deformed ice tracers trpnd = 0 ! set to 1 for melt pond tracers trbgcs = 0 ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) + ndtd = 1 ! dynamic time steps per thermodynamic time step / &grid_nml diff --git a/src/fvom_main.F90 b/src/fvom_main.F90 index 0e06cb676..b4a6747a9 100755 --- a/src/fvom_main.F90 +++ b/src/fvom_main.F90 @@ -27,6 +27,7 @@ program main ! Define icepack modules #if defined (__icepack) use icedrv_settings +use icedrv_set, only: set_icepack #endif #if defined (__oasis) @@ -43,7 +44,11 @@ program main real(kind=real32) :: runtime_alltimesteps type(t_mesh), target, save :: mesh -type(t_icepack_settings), target, save :: icepack_settings + +#if defined (__icepack) +type(t_icepack_namelists), target, save :: icepack_namelists +type(t_icepack_domain_size), target, save :: icepack_domain_size +#endif #ifndef __oifs !ECHAM6-FESOM2 coupling: cpl_oasis3mct_init is called here in order to avoid circular dependencies between modules (cpl_driver and g_PARSUP) @@ -74,6 +79,16 @@ program main call mesh_setup(mesh) if (mype==0) write(*,*) 'FESOM mesh_setup... complete' + +#if defined (__icepack) + !===================== + ! Setup icepack + !===================== + if (mype==0) write(*,*) 'Icepack: reading namelists from namelist.icepack' + call set_icepack(icepack_namelists, icepack_domain_size) + call set_grid_icepack(mesh, icepack_domain_size) + if (mype==0) write(*,*) 'Icepack: setup complete' +#endif !===================== ! Allocate field variables diff --git a/src/gen_model_setup.F90 b/src/gen_model_setup.F90 index 58e860792..78553ab17 100755 --- a/src/gen_model_setup.F90 +++ b/src/gen_model_setup.F90 @@ -1,12 +1,9 @@ ! ============================================================== - subroutine setup_model implicit none call read_namelist ! should be before clock_init end subroutine setup_model - ! ============================================================== - subroutine read_namelist ! Reads namelist files and overwrites default parameters. ! @@ -19,12 +16,13 @@ subroutine read_namelist use g_forcing_param use g_parsup use g_config - use diagnostics, only: ldiag_solver,lcurt_stress_surf,lcurt_stress_surf, ldiag_energy, & - ldiag_dMOC, ldiag_DVD, diag_list - use g_clock, only: timenew, daynew, yearnew - use g_ic3d + use diagnostics, only: ldiag_solver,lcurt_stress_surf,lcurt_stress_surf, ldiag_energy, & + ldiag_dMOC, ldiag_DVD, diag_list + use g_clock, only: timenew, daynew, yearnew + use g_ic3d implicit none + character(len=100) :: nmlfile namelist /clockinit/ timenew, daynew, yearnew nmlfile ='namelist.config' ! name of general configuration namelist file diff --git a/src/icepack_drivers/associate_icepack_domain_size.h b/src/icepack_drivers/associate_icepack_domain_size.h new file mode 100644 index 000000000..5f0b7cb37 --- /dev/null +++ b/src/icepack_drivers/associate_icepack_domain_size.h @@ -0,0 +1,45 @@ +! setting variables used by the model + +integer (kind=int_kind), pointer :: nx ! number of grid cells and gost cells for each mesh partition +integer (kind=int_kind), pointer :: ncat ! number of categories in use +integer (kind=int_kind), pointer :: nfsd ! number of floe size categories in use +integer (kind=int_kind), pointer :: nilyr ! number of ice layers per category in use +integer (kind=int_kind), pointer :: nslyr ! number of snow layers per category in use +integer (kind=int_kind), pointer :: n_aero ! number of aerosols in use +integer (kind=int_kind), pointer :: n_zaero ! number of z aerosols in use +integer (kind=int_kind), pointer :: n_algae ! number of algae in use +integer (kind=int_kind), pointer :: n_doc ! number of DOC pools in use +integer (kind=int_kind), pointer :: n_dic ! number of DIC pools in use +integer (kind=int_kind), pointer :: n_don ! number of DON pools in use +integer (kind=int_kind), pointer :: n_fed ! number of Fe pools in use dissolved Fe +integer (kind=int_kind), pointer :: n_fep ! number of Fe pools in use particulate Fe +integer (kind=int_kind), pointer :: nblyr ! number of bio/brine layers per category +integer (kind=int_kind), pointer :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic +integer (kind=int_kind), pointer :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers +integer (kind=int_kind), pointer :: max_nsw ! number of tracers active in shortwave calculation +integer (kind=int_kind), pointer :: max_ntrcr ! number of tracers in total +integer (kind=int_kind), pointer :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW + +!===================================================== +!===================================================== + +nx => icepack_domain_size%nx +ncat => icepack_domain_size%ncat +nfsd => icepack_domain_size%nfsd +nilyr => icepack_domain_size%nilyr +nslyr => icepack_domain_size%nslyr +n_aero => icepack_domain_size%n_aero +n_zaero => icepack_domain_size%n_zaero +n_algae => icepack_domain_size%n_algae +n_doc => icepack_domain_size%n_doc +n_dic => icepack_domain_size%n_dic +n_don => icepack_domain_size%n_don +n_fed => icepack_domain_size%n_fed +n_fep => icepack_domain_size%n_fep +nblyr => icepack_domain_size%nblyr +n_bgc => icepack_domain_size%n_bgc +nltrcr => icepack_domain_size%nltrcr +max_nsw => icepack_domain_size%max_nsw +nfreq => icepack_domain_size%nfreq +max_ntrcr => icepack_domain_size%max_ntrcr + diff --git a/src/icepack_drivers/associate_icepack_namelists.h b/src/icepack_drivers/associate_icepack_namelists.h new file mode 100644 index 000000000..dacea562e --- /dev/null +++ b/src/icepack_drivers/associate_icepack_namelists.h @@ -0,0 +1,193 @@ +! env namelist + +integer (kind=int_kind), pointer :: nicecat ! number of ice thickness categories +integer (kind=int_kind), pointer :: nfsdcat ! number of floe size categories +integer (kind=int_kind), pointer :: nicelyr ! number of vertical layers in the ice +integer (kind=int_kind), pointer :: nsnwlyr ! number of vertical layers in the snow +integer (kind=int_kind), pointer :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) +integer (kind=int_kind), pointer :: trzaero ! number of z aerosol tracers (up to max_aero = 6) +integer (kind=int_kind), pointer :: tralg ! number of algal tracers (up to max_algae = 3) +integer (kind=int_kind), pointer :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) +integer (kind=int_kind), pointer :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) +integer (kind=int_kind), pointer :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) +integer (kind=int_kind), pointer :: trfed ! number of dissolved iron tracers (up to max_fe = 2) +integer (kind=int_kind), pointer :: trfep ! number of particulate iron tracers (up to max_fe = 2) +integer (kind=int_kind), pointer :: nbgclyr ! number of zbgc layers +integer (kind=int_kind), pointer :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) +integer (kind=int_kind), pointer :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) +integer (kind=int_kind), pointer :: trbri ! set to 1 for brine height tracer +integer (kind=int_kind), pointer :: trage ! set to 1 for ice age tracer +integer (kind=int_kind), pointer :: trfy ! set to 1 for first-year ice area tracer +integer (kind=int_kind), pointer :: trlvl ! set to 1 for level and deformed ice tracers +integer (kind=int_kind), pointer :: trpnd ! set to 1 for melt pond tracers +integer (kind=int_kind), pointer :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) +integer (kind=int_kind), pointer :: ndtd ! dynamic time steps per thermodynamic time step + +! tracer namelist + +logical (kind=log_kind), pointer :: tr_iage +logical (kind=log_kind), pointer :: tr_FY +logical (kind=log_kind), pointer :: tr_lvl +logical (kind=log_kind), pointer :: tr_pond_cesm +logical (kind=log_kind), pointer :: tr_pond_topo +logical (kind=log_kind), pointer :: tr_pond_lvl +logical (kind=log_kind), pointer :: tr_aero +logical (kind=log_kind), pointer :: tr_fsd + +! grid namelist + +integer (kind=int_kind), pointer :: kcatbound + +! thermo namelist + +integer (kind=int_kind), pointer :: kitd +integer (kind=int_kind), pointer :: ktherm +character (len=char_len), pointer :: conduct +real (kind=dbl_kind), pointer :: a_rapid_mode +real (kind=dbl_kind), pointer :: Rac_rapid_mode +real (kind=dbl_kind), pointer :: aspect_rapid_mode +real (kind=dbl_kind), pointer :: dSdt_slow_mode +real (kind=dbl_kind), pointer :: phi_c_slow_mode +real (kind=dbl_kind), pointer :: phi_i_mushy + +! dynamics namelist + +integer (kind=int_kind), pointer :: kstrength +integer (kind=int_kind), pointer :: krdg_partic +integer (kind=int_kind), pointer :: krdg_redist +real (kind=dbl_kind), pointer :: mu_rdg +real (kind=dbl_kind), pointer :: Cf + +! shortwave namelist + +character (len=char_len), pointer :: shortwave +character (len=char_len), pointer :: albedo_type +real (kind=dbl_kind), pointer :: albicev +real (kind=dbl_kind), pointer :: albicei +real (kind=dbl_kind), pointer :: albsnowv +real (kind=dbl_kind), pointer :: albsnowi +real (kind=dbl_kind), pointer :: ahmax +real (kind=dbl_kind), pointer :: R_ice +real (kind=dbl_kind), pointer :: R_pnd +real (kind=dbl_kind), pointer :: R_snw +real (kind=dbl_kind), pointer :: dT_mlt +real (kind=dbl_kind), pointer :: rsnw_mlt +real (kind=dbl_kind), pointer :: kalg + +! forcing namelist + +logical (kind=log_kind), pointer :: formdrag +character (len=char_len), pointer :: atmbndy +logical (kind=log_kind), pointer :: calc_strair +logical (kind=log_kind), pointer :: calc_Tsfc +logical (kind=log_kind), pointer :: highfreq +integer (kind=int_kind), pointer :: natmiter +real (kind=dbl_kind), pointer :: ustar_min +real (kind=dbl_kind), pointer :: emissivity +character (len=char_len), pointer :: fbot_xfer_type +logical (kind=log_kind), pointer :: update_ocn_f +logical (kind=log_kind), pointer :: l_mpond_fresh +character (len=char_len), pointer :: tfrz_option +logical (kind=log_kind), pointer :: oceanmixed_ice +character (len=char_len), pointer :: wave_spec_type + +! pond namelist + +real (kind=dbl_kind), pointer :: hp1 +real (kind=dbl_kind), pointer :: hs0 +real (kind=dbl_kind), pointer :: hs1 +real (kind=dbl_kind), pointer :: dpscale +real (kind=dbl_kind), pointer :: rfracmin +real (kind=dbl_kind), pointer :: rfracmax +real (kind=dbl_kind), pointer :: pndaspect +character (len=char_len), pointer :: frzpnd + +!===================================================== +!===================================================== + +nicecat => icepack_namelists%nicecat +nfsdcat => icepack_namelists%nfsdcat +nicelyr => icepack_namelists%nicelyr +nsnwlyr => icepack_namelists%nsnwlyr +ntraero => icepack_namelists%ntraero +trzaero => icepack_namelists%trzaero +tralg => icepack_namelists%tralg +trdoc => icepack_namelists%trdoc +trdic => icepack_namelists%trdic +trdon => icepack_namelists%trdon +trfed => icepack_namelists%trfed +trfep => icepack_namelists%trfep +nbgclyr => icepack_namelists%nbgclyr +trbgcz => icepack_namelists%trbgcz +trzs => icepack_namelists%trzs +trbri => icepack_namelists%trbri +trage => icepack_namelists%trage +trfy => icepack_namelists%trfy +trlvl => icepack_namelists%trlvl +trpnd => icepack_namelists%trpnd +trbgcs => icepack_namelists%trbgcs + +tr_iage => icepack_namelists%tr_iage +tr_FY => icepack_namelists%tr_FY +tr_lvl => icepack_namelists%tr_lvl +tr_pond_cesm => icepack_namelists%tr_pond_cesm +tr_pond_topo => icepack_namelists%tr_pond_topo +tr_pond_lvl => icepack_namelists%tr_pond_lvl +tr_aero => icepack_namelists%tr_aero +tr_fsd => icepack_namelists%tr_fsd + +kcatbound => icepack_namelists%kcatbound + +kitd => icepack_namelists%kitd +ktherm => icepack_namelists%ktherm +conduct => icepack_namelists%conduct +a_rapid_mode => icepack_namelists%a_rapid_mode +Rac_rapid_mode => icepack_namelists%Rac_rapid_mode +aspect_rapid_mode => icepack_namelists%aspect_rapid_mode +dSdt_slow_mode => icepack_namelists%dSdt_slow_mode +phi_c_slow_mode => icepack_namelists%phi_c_slow_mode +phi_i_mushy => icepack_namelists%phi_i_mushy + +kstrength => icepack_namelists%kstrength +krdg_partic => icepack_namelists%krdg_partic +krdg_redist => icepack_namelists%krdg_redist +mu_rdg => icepack_namelists%mu_rdg +Cf => icepack_namelists%Cf + +shortwave => icepack_namelists%shortwave +albedo_type => icepack_namelists%albedo_type +albicev => icepack_namelists%albicev +albicei => icepack_namelists%albicei +albsnowv => icepack_namelists%albsnowv +albsnowi => icepack_namelists%albsnowi +ahmax => icepack_namelists%ahmax +R_ice => icepack_namelists%R_ice +R_pnd => icepack_namelists%R_pnd +R_snw => icepack_namelists%R_snw +dT_mlt => icepack_namelists%dT_mlt +rsnw_mlt => icepack_namelists%rsnw_mlt +kalg => icepack_namelists%kalg + +formdrag => icepack_namelists%formdrag +atmbndy => icepack_namelists%atmbndy +calc_strair => icepack_namelists%calc_strair +calc_Tsfc => icepack_namelists%calc_Tsfc +highfreq => icepack_namelists%highfreq +natmiter => icepack_namelists%natmiter +ustar_min => icepack_namelists%ustar_min +emissivity => icepack_namelists%emissivity +fbot_xfer_type => icepack_namelists%fbot_xfer_type +update_ocn_f => icepack_namelists%update_ocn_f +l_mpond_fresh => icepack_namelists%l_mpond_fresh +tfrz_option => icepack_namelists%tfrz_option +oceanmixed_ice => icepack_namelists%oceanmixed_ice +wave_spec_type => icepack_namelists%wave_spec_type + +hp1 => icepack_namelists%hp1 +hs0 => icepack_namelists%hs0 +hs1 => icepack_namelists%hs1 +dpscale => icepack_namelists%dpscale +rfracmin => icepack_namelists%rfracmin +rfracmax => icepack_namelists%rfracmax +pndaspect => icepack_namelists%pndaspect +frzpnd => icepack_namelists%frzpnd diff --git a/src/icepack_drivers/associate_icepack_settings.h b/src/icepack_drivers/associate_icepack_settings.h deleted file mode 100644 index 9342458be..000000000 --- a/src/icepack_drivers/associate_icepack_settings.h +++ /dev/null @@ -1,230 +0,0 @@ -! env namelist - -integer (kind=int_kind), pointer :: nicecat ! number of ice thickness categories -integer (kind=int_kind), pointer :: nfsdcat ! number of floe size categories -integer (kind=int_kind), pointer :: nicelyr ! number of vertical layers in the ice -integer (kind=int_kind), pointer :: nsnwlyr ! number of vertical layers in the snow -integer (kind=int_kind), pointer :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) -integer (kind=int_kind), pointer :: trzaero ! number of z aerosol tracers (up to max_aero = 6) -integer (kind=int_kind), pointer :: tralg ! number of algal tracers (up to max_algae = 3) -integer (kind=int_kind), pointer :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) -integer (kind=int_kind), pointer :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) -integer (kind=int_kind), pointer :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) -integer (kind=int_kind), pointer :: trfed ! number of dissolved iron tracers (up to max_fe = 2) -integer (kind=int_kind), pointer :: trfep ! number of particulate iron tracers (up to max_fe = 2) -integer (kind=int_kind), pointer :: nbgclyr ! number of zbgc layers -integer (kind=int_kind), pointer :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) -integer (kind=int_kind), pointer :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) -integer (kind=int_kind), pointer :: trbri ! set to 1 for brine height tracer -integer (kind=int_kind), pointer :: trage ! set to 1 for ice age tracer -integer (kind=int_kind), pointer :: trfy ! set to 1 for first-year ice area tracer -integer (kind=int_kind), pointer :: trlvl ! set to 1 for level and deformed ice tracers -integer (kind=int_kind), pointer :: trpnd ! set to 1 for melt pond tracers -integer (kind=int_kind), pointer :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) - -! setting variables used by the model - -integer (kind=int_kind), pointer :: ncat ! number of categories in use -integer (kind=int_kind), pointer :: nfsd ! number of floe size categories in use -integer (kind=int_kind), pointer :: nilyr ! number of ice layers per category in use -integer (kind=int_kind), pointer :: nslyr ! number of snow layers per category in use -integer (kind=int_kind), pointer :: n_aero ! number of aerosols in use -integer (kind=int_kind), pointer :: n_zaero ! number of z aerosols in use -integer (kind=int_kind), pointer :: n_algae ! number of algae in use -integer (kind=int_kind), pointer :: n_doc ! number of DOC pools in use -integer (kind=int_kind), pointer :: n_dic ! number of DIC pools in use -integer (kind=int_kind), pointer :: n_don ! number of DON pools in use -integer (kind=int_kind), pointer :: n_fed ! number of Fe pools in use dissolved Fe -integer (kind=int_kind), pointer :: n_fep ! number of Fe pools in use particulate Fe -integer (kind=int_kind), pointer :: nblyr ! number of bio/brine layers per category -integer (kind=int_kind), pointer :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic -integer (kind=int_kind), pointer :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers -integer (kind=int_kind), pointer :: max_nsw ! number of tracers active in shortwave calculation -integer (kind=int_kind), pointer :: max_ntrcr ! number of tracers in total -integer (kind=int_kind), pointer :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW - -! tracer namelist - -logical (kind=log_kind), pointer :: tr_iage -logical (kind=log_kind), pointer :: tr_FY -logical (kind=log_kind), pointer :: tr_lvl -logical (kind=log_kind), pointer :: tr_pond_cesm -logical (kind=log_kind), pointer :: tr_pond_topo -logical (kind=log_kind), pointer :: tr_pond_lvl -logical (kind=log_kind), pointer :: tr_aero -logical (kind=log_kind), pointer :: tr_fsd - -! thermo namelist - -integer (kind=int_kind), pointer :: kitd -integer (kind=int_kind), pointer :: ktherm -character (len=char_len), pointer :: conduct -real (kind=dbl_kind), pointer :: a_rapid_mode -real (kind=dbl_kind), pointer :: Rac_rapid_mode -real (kind=dbl_kind), pointer :: aspect_rapid_mode -real (kind=dbl_kind), pointer :: dSdt_slow_mode -real (kind=dbl_kind), pointer :: phi_c_slow_mode -real (kind=dbl_kind), pointer :: phi_i_mushy - -! dynamics namelist - -integer (kind=int_kind), pointer :: kstrength -integer (kind=int_kind), pointer :: krdg_partic -integer (kind=int_kind), pointer :: krdg_redist -integer (kind=int_kind), pointer :: mu_rdg -real (kind=dbl_kind), pointer :: Cf - -! shortwave namelist - -character (len=char_len), pointer :: shortwave -character (len=char_len), pointer :: albedo_type -real (kind=dbl_kind), pointer :: albicev -real (kind=dbl_kind), pointer :: albicei -real (kind=dbl_kind), pointer :: albsnowv -real (kind=dbl_kind), pointer :: albsnowi -real (kind=dbl_kind), pointer :: ahmax -real (kind=dbl_kind), pointer :: R_ice -real (kind=dbl_kind), pointer :: R_pnd -real (kind=dbl_kind), pointer :: R_snw -real (kind=dbl_kind), pointer :: dT_mlt -real (kind=dbl_kind), pointer :: rsnw_mlt -real (kind=dbl_kind), pointer :: kalg - -! forcing namelist - -logical (kind=log_kind), pointer :: formdrag -character (len=char_len), pointer :: atmbndy -logical (kind=log_kind), pointer :: calc_strair -logical (kind=log_kind), pointer :: calc_Tsfc -logical (kind=log_kind), pointer :: highfreq -integer (kind=int_kind), pointer :: natmiter -real (kind=dbl_kind), pointer :: ustar_min -real (kind=dbl_kind), pointer :: emissivity -character (len=char_len), pointer :: fbot_xfer_type -logical (kind=log_kind), pointer :: update_ocn_f -logical (kind=log_kind), pointer :: l_mpond_fresh -character (len=char_len), pointer :: tfrz_option -logical (kind=log_kind), pointer :: oceanmixed_ice -character (len=char_len), pointer :: wave_spec_type - -nicecat => icepack_settings%nicecat -nfsdcat => icepack_settings%nfsdcat -nicelyr => icepack_settings%nicelyr -nsnwlyr => icepack_settings%nsnwlyr -ntraero => icepack_settings%ntraero -trzaero => icepack_settings%trzaero -tralg => icepack_settings%tralg -trdoc => icepack_settings%trdoc -trdic => icepack_settings%trdic -trdon => icepack_settings%trdon -trfed => icepack_settings%trfed -trfep => icepack_settings%trfep -nbgclyr => icepack_settings%nbgclyr -trbgcz => icepack_settings%trbgcz -trzs => icepack_settings%trzs -trbri => icepack_settings%trbri -trage => icepack_settings%trage -trfy => icepack_settings%trfy -trlvl => icepack_settings%trlvl -trpnd => icepack_settings%trpnd -trbgcs => icepack_settings%trbgcs - -ncat => icepack_settings%ncat -nfsd => icepack_settings%nfsd -nilyr => icepack_settings%nilyr -nslyr => icepack_settings%nslyr -n_aero => icepack_settings%n_aero -n_zaero => icepack_settings%n_zaero -n_algae => icepack_settings%n_algae -n_doc => icepack_settings%n_doc -n_dic => icepack_settings%n_dic -n_don => icepack_settings%n_don -n_fed => icepack_settings%n_fed -n_fep => icepack_settings%n_fep -nblyr => icepack_settings%nblyr -n_bgc => icepack_settings%n_bgc -nltrcr => icepack_settings%nltrcr -max_nsw => icepack_settings%max_nsw -nfreq => icepack_settings%nfreq -max_ntrcr => icepack_settings%max_ntrcr - -tr_iage => icepack_settings%tr_iage -tr_FY => icepack_settings%tr_FY -tr_lvl => icepack_settings%tr_lvl -tr_pond_cesm => icepack_settings%tr_pond_cesm -tr_pond_topo => icepack_settings%tr_pond_topo -tr_pond_lvl => icepack_settings%tr_pond_lvl -tr_aero => icepack_settings%tr_aero -tr_fsd => icepack_settings%tr_fsd - -kitd => icepack_settings%kitd -ktherm => icepack_settings%ktherm -conduct => icepack_settings%conduct -a_rapid_mode => icepack_settings%a_rapid_mode -Rac_rapid_mode => icepack_settings%Rac_rapid_mode -aspect_rapid_mode => icepack_settings%aspect_rapid_mode -dSdt_slow_mode => icepack_settings%dSdt_slow_mode -phi_c_slow_mode => icepack_settings%phi_c_slow_mode -phi_i_mushy => icepack_settings%phi_i_mushy - -kstrength => icepack_settings%kstrength -krdg_partic => icepack_settings%krdg_partic -krdg_redist => icepack_settings%krdg_redist -mu_rdg => icepack_settings%mu_rdg -Cf => icepack_settings%Cf - -shortwave => icepack_settings%shortwave -albedo_type => icepack_settings%albedo_type -albicev => icepack_settings%albicev -albicei => icepack_settings%albicei -albsnowv => icepack_settings%albsnowv -albsnowi => icepack_settings%albsnowi -ahmax => icepack_settings%ahmax -R_ice => icepack_settings%R_ice -R_pnd => icepack_settings%R_pnd -R_snw => icepack_settings%R_snw -dT_mlt => icepack_settings%dT_mlt -rsnw_mlt => icepack_settings%rsnw_mlt -kalg => icepack_settings%kalg - -formdrag => icepack_settings%formdrag -atmbndy => icepack_settings%atmbndy -calc_strair => icepack_settings%calc_strair -calc_Tsfc => icepack_settings%calc_Tsfc -highfreq => icepack_settings%highfreq -natmiter => icepack_settings%natmiter -ustar_min => icepack_settings%ustar_min -emissivity => icepack_settings%emissivity -fbot_xfer_type => icepack_settings%fbot_xfer_type -update_ocn_f => icepack_settings%update_ocn_f -l_mpond_fresh => icepack_settings%l_mpond_fresh -tfrz_option => icepack_settings%tfrz_option -oceanmixed_ice => icepack_settings%oceanmixed_ice -wave_spec_type => icepack_settings%wave_spec_type - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/icepack_drivers/icedrv_constants.F90 b/src/icepack_drivers/icedrv_constants.F90 index 43d212c27..cfb44c5ae 100644 --- a/src/icepack_drivers/icedrv_constants.F90 +++ b/src/icepack_drivers/icedrv_constants.F90 @@ -16,15 +16,15 @@ module icedrv_constants !----------------------------------------------------------------- integer (kind=int_kind), parameter, public :: & - ice_stdin = 5, & ! reserved unit for standard input - ice_stdout = 6, & ! reserved unit for standard output - ice_stderr = 6, & ! reserved unit for standard error - nu_nml = 10, & ! unit for namelist - nu_restart = 12, & ! unit for restart file - nu_dump = 13, & ! unit for dump file - nu_forcing = 14, & ! unit for forcing file - nu_open_clos = 15, & ! unit for SHEBA forcing file - nu_diag = ice_stdout, & ! unit for diagnostic output + ice_stdin = 5, & ! reserved unit for standard input + ice_stdout = 88, & ! reserved unit for standard output + ice_stderr = 87, & ! reserved unit for standard error + nu_nml = 10, & ! unit for namelist + nu_restart = 12, & ! unit for restart file + nu_dump = 13, & ! unit for dump file + nu_forcing = 14, & ! unit for forcing file + nu_open_clos = 15, & ! unit for SHEBA forcing file + nu_diag = 86, & ! unit for diagnostic output nu_diag_out = 103 !----------------------------------------------------------------- @@ -61,8 +61,10 @@ module icedrv_constants p25 = 0.25_dbl_kind, & p75 = 0.75_dbl_kind, & p333 = c1/c3, & - p666 = c2/c3, & - puny = 10.0e-11_dbl_kind + p666 = c2/c3 + + real (kind=dbl_kind), public :: puny=10.0e-11_dbl_kind + !----------------------------------------------------------------- ! physical constants diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 deleted file mode 100644 index 56fcc1b74..000000000 --- a/src/icepack_drivers/icedrv_init.F90 +++ /dev/null @@ -1,299 +0,0 @@ -!======================================================================= -! -! This module defines and and initializes the namelists -! -! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) -! -!======================================================================= - - module icedrv_init - - use icedrv_kinds - use icedrv_constants, only: nu_diag, ice_stdout, nu_diag_out, nu_nml - use icedrv_constants, only: c0, c1, c2, c3, p2, p5, puny - use icepack_intfc, only: icepack_init_parameters - use icepack_intfc, only: icepack_init_fsd - use icepack_intfc, only: icepack_init_tracer_flags - use icepack_intfc, only: icepack_init_tracer_sizes - use icepack_intfc, only: icepack_init_tracer_indices - use icepack_intfc, only: icepack_init_trcr - use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_query_tracer_flags - use icepack_intfc, only: icepack_query_tracer_sizes - use icepack_intfc, only: icepack_query_tracer_indices - use icepack_intfc, only: icepack_warnings_flush - use icepack_intfc, only: icepack_warnings_aborted - use icedrv_system, only: icedrv_system_abort - - implicit none - private - public :: read_namelist_icepack - - contains - - subroutine read_namelist_icepack(icepack_settings) - - use icedrv_settings - - implicit none - - character(len=char_len) :: nml_filename - integer (kind=int_kind) :: nml_error, & ! namelist i/o error flag - n ! loop index - type(t_icepack_settings), intent(inout), target :: icepack_settings - -#include "associate_icepack_settings.h" - - !----------------------------------------------------------------- - ! Namelist definition - !----------------------------------------------------------------- - - nml_filename = 'namelist.icepack' ! name of icepack namelist file - - namelist / env_nml / & - nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & - trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & - trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs - - namelist /thermo_nml/ & - kitd, ktherm, conduct, & - a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, & - dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy - - namelist /dynamics_nml/ & - kstrength, krdg_partic, krdg_redist, mu_rdg, & - Cf - - namelist /shortwave_nml/ & - shortwave, albedo_type, & - albicev, albicei, albsnowv, albsnowi, & - ahmax, R_ice, R_pnd, R_snw,& - dT_mlt, rsnw_mlt, kalg - - namelist /ponds_nml/ & - hs0, dpscale, frzpnd, & - rfracmin, rfracmax, pndaspect, hs1, & - hp1 - - namelist /tracer_nml/ & - tr_iage, tr_FY, tr_lvl, tr_pond_cesm, & - tr_pond_lvl, tr_pond_topo, tr_aero, tr_fsd - - namelist /forcing_nml/ & - atmbndy, calc_strair, calc_Tsfc, & - update_ocn_f, l_mpond_fresh, ustar_min, & - fbot_xfer_type, oceanmixed_ice, emissivity, & - formdrag, highfreq, natmiter, & - tfrz_option, wave_spec_type - - !----------------------------------------------------------------- - ! env namelist - STANDARD VALUES - !----------------------------------------------------------------- - - nicecat = 5 ! number of ice thickness categories - nicelyr = 4 ! number of vertical layers in the ice - nsnwlyr = 4 ! number of vertical layers in the snow - nfsdcat = 1 ! number of floe size categories - ntraero = 0 ! number of aerosol tracers (up to max_aero in ice_domain_size.f90) - trzaero = 0 ! number of z aerosol tracers (up to max_aero = 6) - tralg = 0 ! number of algal tracers (up to max_algae = 3) - trdoc = 0 ! number of dissolve organic carbon (up to max_doc = 3) - trdic = 0 ! number of dissolve inorganic carbon (up to max_dic = 1) - trdon = 0 ! number of dissolve organic nitrogen (up to max_don = 1) - trfed = 0 ! number of dissolved iron tracers (up to max_fe = 2) - trfep = 0 ! number of particulate iron tracers (up to max_fe = 2) - nbgclyr = 4 ! number of zbgc layers - trbgcz = 0 ! set to 1 for zbgc tracers (needs trbgcs = 0 and trbri = 1) - trzs = 0 ! set to 1 for zsalinity tracer (needs trbri = 1) - trbri = 0 ! set to 1 for brine height tracer - trage = 0 ! set to 1 for ice age tracer - trfy = 0 ! set to 1 for first-year ice area tracer - trlvl = 0 ! set to 1 for level and deformed ice tracers - trpnd = 0 ! set to 1 for melt pond tracers - trbgcs = 0 ! set to 1 for skeletal layer tracers (needs - - !----------------------------------------------------------------- - ! Read namelist env_nml - !----------------------------------------------------------------- - - open (nu_nml, file=nml_filename, status='old',iostat=nml_error) - if (nml_error /= 0) then - nml_error = -1 - else - nml_error = 1 - end if - - if (nml_error > 0) - print*,'Reading namelist file ',nml_filename - - print*,'Reading setup_nml' - read(nu_nml, nml=env_nml,iostat=nml_error) - end if - - if (nml_error == 0) close(nu_nml) - if (nml_error /= 0) then - write(ice_stdout,*) 'error reading namelist' - call icedrv_system_abort(file=__FILE__,line=__LINE__) - close(nu_nml) - end if - - !----------------------------------------------------------------- - ! Derived quantities used by the icepack model - !----------------------------------------------------------------- - - ncat = nicecat ! number of categories - nfsd = nfsdcat ! number of floe size categories - nilyr = nicelyr ! number of ice layers per category - nslyr = nsnwlyr ! number of snow layers per category - n_aero = ntraero ! number of aerosols in use - n_zaero = trzaero ! number of z aerosols in use - n_algae = tralg ! number of algae in use - n_doc = trdoc ! number of DOC pools in use - n_dic = trdic ! number of DIC pools in use - n_don = trdon ! number of DON pools in use - n_fed = trfed ! number of Fe pools in use dissolved Fe - n_fep = trfep ! number of Fe pools in use particulate Fe - nfreq = 25 ! number of wave frequencies ! HARDWIRED FOR NOW - nblyr = nbgclyr ! number of bio/brine layers per category - ! maximum number of biology tracers + - ! aerosols - ! *** add to kscavz in - ! icepack_zbgc_shared.F90 - n_bgc = (n_algae*2 + n_doc + n_dic + n_don + n_fed + n_fep +n_zaero & - + 8) ! nit, am, sil, dmspp, dmspd, dms, pon, humic - nltrcr = (n_bgc*trbgcz+trzs)*trbri ! number of zbgc (includes zaero) - ! and zsalinity tracers - max_nsw = (nilyr+nslyr+2) & ! total chlorophyll plus aerosols - * (1+trzaero) ! number of tracers active in shortwave calculation - max_ntrcr = 1 & ! 1 = surface temperature - + nilyr & ! ice salinity - + nilyr & ! ice enthalpy - + nslyr & ! snow enthalpy - !!!!! optional tracers: - + nfsd & ! number of floe size categories - + trage & ! age - + trfy & ! first-year area - + trlvl*2 & ! level/deformed ice - + trpnd*3 & ! ponds - + n_aero*4 & ! number of aerosols * 4 aero layers - + trbri & ! brine height - + trbgcs*n_bgc & ! skeletal layer BGC - + trzs *trbri* nblyr & ! zsalinity (off if TRBRI=0) - + n_bgc*trbgcz*trbri*(nblyr+3) & ! zbgc (off if TRBRI=0) - + n_bgc*trbgcz & ! mobile/stationary phase tracer - + 1 ! for unused tracer flags - - !----------------------------------------------------------------- - ! query Icepack default values - !----------------------------------------------------------------- - - call icepack_query_parameters(ustar_min_out=ustar_min, Cf_out=Cf, & - albicev_out=albicev, albicei_out=albicei, & - albsnowv_out=albsnowv, albsnowi_out=albsnowi, & - natmiter_out=natmiter, ahmax_out=ahmax, shortwave_out=shortwave, & - albedo_type_out=albedo_type, R_ice_out=R_ice, R_pnd_out=R_pnd, & - R_snw_out=R_snw, dT_mlt_out=dT_mlt, rsnw_mlt_out=rsnw_mlt, & - kstrength_out=kstrength, krdg_partic_out=krdg_partic, & - krdg_redist_out=krdg_redist, mu_rdg_out=mu_rdg, & - atmbndy_out=atmbndy, calc_strair_out=calc_strair, & - formdrag_out=formdrag, highfreq_out=highfreq, & - emissivity_out=emissivity, & - kitd_out=kitd, kcatbound_out=kcatbound, hs0_out=hs0, & - dpscale_out=dpscale, frzpnd_out=frzpnd, & - rfracmin_out=rfracmin, rfracmax_out=rfracmax, & - pndaspect_out=pndaspect, hs1_out=hs1, hp1_out=hp1, & - ktherm_out=ktherm, calc_Tsfc_out=calc_Tsfc, & - update_ocn_f_out = update_ocn_f, & - conduct_out=conduct, a_rapid_mode_out=a_rapid_mode, & - Rac_rapid_mode_out=Rac_rapid_mode, & - aspect_rapid_mode_out=aspect_rapid_mode, & - dSdt_slow_mode_out=dSdt_slow_mode, & - phi_c_slow_mode_out=phi_c_slow_mode, & - phi_i_mushy_out=phi_i_mushy, & - tfrz_option_out=tfrz_option, kalg_out=kalg, & - fbot_xfer_type_out=fbot_xfer_type, puny_out=puny, & - wave_spec_type_out=wave_spec_type) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! other default values - !----------------------------------------------------------------- - - ndtd = 1 ! dynamic time steps per thermodynamic time step - l_mpond_fresh = .false. ! logical switch for including meltpond freshwater - ! flux feedback to ocean model - oceanmixed_ice = .false. ! if true, use internal ocean mixed layer - wave_spec_type = 'none' ! type of wave spectrum forcing - - tr_iage = .false. ! ice age - tr_FY = .false. ! ice age - tr_lvl = .false. ! level ice - tr_pond_cesm = .false. ! CESM melt ponds - tr_pond_lvl = .false. ! level-ice melt ponds - tr_pond_topo = .false. ! explicit melt ponds (topographic) - tr_aero = .false. ! aerosols - tr_fsd = .false. ! floe size distribution - - - !----------------------------------------------------------------- - ! read from input file - !----------------------------------------------------------------- - - open (nu_nml, file=nml_filename, status='old',iostat=nml_error) - if (nml_error /= 0) then - nml_error = -1 - else - nml_error = 1 - endif - - do while (nml_error > 0) - print*,'Reading namelist file ',nml_filename - - print*,'Reading setup_nml' - read(nu_nml, nml=setup_nml,iostat=nml_error) - if (nml_error /= 0) exit - - print*,'Reading grid_nml' - read(nu_nml, nml=grid_nml,iostat=nml_error) - if (nml_error /= 0) exit - - print*,'Reading tracer_nml' - read(nu_nml, nml=tracer_nml,iostat=nml_error) - if (nml_error /= 0) exit - - print*,'Reading thermo_nml' - read(nu_nml, nml=thermo_nml,iostat=nml_error) - if (nml_error /= 0) exit - - print*,'Reading shortwave_nml' - read(nu_nml, nml=shortwave_nml,iostat=nml_error) - if (nml_error /= 0) exit - - print*,'Reading ponds_nml' - read(nu_nml, nml=ponds_nml,iostat=nml_error) - if (nml_error /= 0) exit - - print*,'Reading forcing_nml' - read(nu_nml, nml=forcing_nml,iostat=nml_error) - if (nml_error /= 0) exit - end do - if (nml_error == 0) close(nu_nml) - if (nml_error /= 0) then - write(ice_stdout,*) 'error reading namelist' - call icedrv_system_abort(file=__FILE__,line=__LINE__) - endif - close(nu_nml) - - end subroutine read_namelist_icepack -!======================================================================= - - end module icedrv_init - - - - - - - diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 new file mode 100644 index 000000000..4e563e267 --- /dev/null +++ b/src/icepack_drivers/icedrv_set.F90 @@ -0,0 +1,784 @@ +!======================================================================= +! +! This module defines and and initializes the namelists +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + + module icedrv_set + + use icedrv_kinds + use icedrv_constants, only: nu_diag, ice_stdout, nu_diag_out, nu_nml + use icedrv_constants, only: c0, c1, c2, c3, p2, p5, puny + use icepack_intfc, only: icepack_init_parameters + use icepack_intfc, only: icepack_init_fsd + use icepack_intfc, only: icepack_init_tracer_flags + use icepack_intfc, only: icepack_init_tracer_sizes + use icepack_intfc, only: icepack_init_tracer_indices + use icepack_intfc, only: icepack_init_trcr + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_tracer_indices + use icepack_intfc, only: icepack_warnings_flush + use icepack_intfc, only: icepack_warnings_aborted + use icedrv_system, only: icedrv_system_abort + + implicit none + private + public :: set_icepack, set_grid_icepack + + contains + + subroutine set_icepack(icepack_namelists, icepack_domain_size) + + use icedrv_settings + use g_parsup, only: mype, myDim_nod2D, eDim_nod2D + + implicit none + + ! CHARACTER + character(len=char_len) :: nml_filename, diag_filename + character(len=*), parameter :: subname = '(set_icepack)' + ! INTEGER + integer (kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno + integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd + integer (kind=int_kind) :: nt_ipnd, nt_aero, nt_fsd, nt_FY + integer (kind=int_kind) :: ntrcr, nt_iage + integer (kind=int_kind) :: nml_error, diag_error ! i/o error flag + integer (kind=int_kind) :: n ! loop index + ! REAL + real (kind=real_kind) :: rpcesm, rplvl, rptopo + ! LOGICAL + logical (kind=log_kind) :: tr_pond, wave_spec + ! TYPE + type(t_icepack_namelists), intent(inout), target :: icepack_namelists + type(t_icepack_domain_size), intent(inout), target :: icepack_domain_size + +#include "associate_icepack_namelists.h" +#include "associate_icepack_domain_size.h" + + !----------------------------------------------------------------- + ! Namelist definition + !----------------------------------------------------------------- + + nml_filename = 'namelist.icepack' ! name of icepack namelist file + + namelist / env_nml / & + nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & + trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & + trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs + + namelist / grid_nml / & + kcatbound + + namelist / thermo_nml / & + kitd, ktherm, conduct, & + a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, & + dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy + + namelist / dynamics_nml / & + kstrength, krdg_partic, krdg_redist, mu_rdg, & + Cf + + namelist / shortwave_nml / & + shortwave, albedo_type, & + albicev, albicei, albsnowv, albsnowi, & + ahmax, R_ice, R_pnd, R_snw, & + dT_mlt, rsnw_mlt, kalg + + namelist / ponds_nml / & + hs0, dpscale, frzpnd, & + rfracmin, rfracmax, pndaspect, hs1, & + hp1 + + namelist / tracer_nml / & + tr_iage, tr_FY, tr_lvl, tr_pond_cesm, & + tr_pond_lvl, tr_pond_topo, tr_aero, tr_fsd + + namelist / forcing_nml / & + atmbndy, calc_strair, calc_Tsfc, & + update_ocn_f, l_mpond_fresh, ustar_min, & + fbot_xfer_type, oceanmixed_ice, emissivity, & + formdrag, highfreq, natmiter, & + tfrz_option, wave_spec_type + + !----------------------------------------------------------------- + ! env namelist - STANDARD VALUES + !----------------------------------------------------------------- + + nicecat = 5 ! number of ice thickness categories + nicelyr = 4 ! number of vertical layers in the ice + nsnwlyr = 4 ! number of vertical layers in the snow + nfsdcat = 1 ! number of floe size categories + ntraero = 0 ! number of aerosol tracers (up to max_aero in ice_domain_size.f90) + trzaero = 0 ! number of z aerosol tracers (up to max_aero = 6) + tralg = 0 ! number of algal tracers (up to max_algae = 3) + trdoc = 0 ! number of dissolve organic carbon (up to max_doc = 3) + trdic = 0 ! number of dissolve inorganic carbon (up to max_dic = 1) + trdon = 0 ! number of dissolve organic nitrogen (up to max_don = 1) + trfed = 0 ! number of dissolved iron tracers (up to max_fe = 2) + trfep = 0 ! number of particulate iron tracers (up to max_fe = 2) + nbgclyr = 4 ! number of zbgc layers + trbgcz = 0 ! set to 1 for zbgc tracers (needs trbgcs = 0 and trbri = 1) + trzs = 0 ! set to 1 for zsalinity tracer (needs trbri = 1) + trbri = 0 ! set to 1 for brine height tracer + trage = 0 ! set to 1 for ice age tracer + trfy = 0 ! set to 1 for first-year ice area tracer + trlvl = 0 ! set to 1 for level and deformed ice tracers + trpnd = 0 ! set to 1 for melt pond tracers + trbgcs = 0 ! set to 1 for skeletal layer tracers (needs + + !----------------------------------------------------------------- + ! Read namelist env_nml + !----------------------------------------------------------------- + + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + end if + + do while (nml_error > 0) + if (mype == 0) print*,'Reading namelist file ',nml_filename + + if (mype == 0) print*,'Reading env_nml' + read(nu_nml, nml=env_nml,iostat=nml_error) + if (nml_error /= 0) exit + end do + + if (nml_error == 0) close(nu_nml) + if (nml_error /= 0) then + if (mype == 0) write(*,*) 'Error reading env namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + close(nu_nml) + end if + + !----------------------------------------------------------------- + ! Derived quantities used by the icepack model + !----------------------------------------------------------------- + + nx = myDim_nod2D + eDim_nod2D + + ncat = nicecat ! number of categories + nfsd = nfsdcat ! number of floe size categories + nilyr = nicelyr ! number of ice layers per category + nslyr = nsnwlyr ! number of snow layers per category + n_aero = ntraero ! number of aerosols in use + n_zaero = trzaero ! number of z aerosols in use + n_algae = tralg ! number of algae in use + n_doc = trdoc ! number of DOC pools in use + n_dic = trdic ! number of DIC pools in use + n_don = trdon ! number of DON pools in use + n_fed = trfed ! number of Fe pools in use dissolved Fe + n_fep = trfep ! number of Fe pools in use particulate Fe + nfreq = 25 ! number of wave frequencies ! HARDWIRED FOR NOW + nblyr = nbgclyr ! number of bio/brine layers per category + ! maximum number of biology tracers + + ! aerosols + ! *** add to kscavz in + ! icepack_zbgc_shared.F90 + n_bgc = (n_algae*2 + n_doc + n_dic + n_don + n_fed + n_fep +n_zaero & + + 8) ! nit, am, sil, dmspp, dmspd, dms, pon, humic + nltrcr = (n_bgc*trbgcz+trzs)*trbri ! number of zbgc (includes zaero) + ! and zsalinity tracers + max_nsw = (nilyr+nslyr+2) & ! total chlorophyll plus aerosols + * (1+trzaero) ! number of tracers active in shortwave calculation + max_ntrcr = 1 & ! 1 = surface temperature + + nilyr & ! ice salinity + + nilyr & ! ice enthalpy + + nslyr & ! snow enthalpy + !!!!! optional tracers: + + nfsd & ! number of floe size categories + + trage & ! age + + trfy & ! first-year area + + trlvl*2 & ! level/deformed ice + + trpnd*3 & ! ponds + + n_aero*4 & ! number of aerosols * 4 aero layers + + trbri & ! brine height + + trbgcs*n_bgc & ! skeletal layer BGC + + trzs *trbri* nblyr & ! zsalinity (off if TRBRI=0) + + n_bgc*trbgcz*trbri*(nblyr+3) & ! zbgc (off if TRBRI=0) + + n_bgc*trbgcz & ! mobile/stationary phase tracer + + 1 ! for unused tracer flags + + !----------------------------------------------------------------- + ! query Icepack default values + !----------------------------------------------------------------- + + call icepack_query_parameters(ustar_min_out=ustar_min, Cf_out=Cf, & + albicev_out=albicev, albicei_out=albicei, & + albsnowv_out=albsnowv, albsnowi_out=albsnowi, & + natmiter_out=natmiter, ahmax_out=ahmax, shortwave_out=shortwave, & + albedo_type_out=albedo_type, R_ice_out=R_ice, R_pnd_out=R_pnd, & + R_snw_out=R_snw, dT_mlt_out=dT_mlt, rsnw_mlt_out=rsnw_mlt, & + kstrength_out=kstrength, krdg_partic_out=krdg_partic, & + krdg_redist_out=krdg_redist, mu_rdg_out=mu_rdg, & + atmbndy_out=atmbndy, calc_strair_out=calc_strair, & + formdrag_out=formdrag, highfreq_out=highfreq, & + emissivity_out=emissivity, & + kitd_out=kitd, kcatbound_out=kcatbound, hs0_out=hs0, & + dpscale_out=dpscale, frzpnd_out=frzpnd, & + rfracmin_out=rfracmin, rfracmax_out=rfracmax, & + pndaspect_out=pndaspect, hs1_out=hs1, hp1_out=hp1, & + ktherm_out=ktherm, calc_Tsfc_out=calc_Tsfc, & + update_ocn_f_out = update_ocn_f, & + conduct_out=conduct, a_rapid_mode_out=a_rapid_mode, & + Rac_rapid_mode_out=Rac_rapid_mode, & + aspect_rapid_mode_out=aspect_rapid_mode, & + dSdt_slow_mode_out=dSdt_slow_mode, & + phi_c_slow_mode_out=phi_c_slow_mode, & + phi_i_mushy_out=phi_i_mushy, & + tfrz_option_out=tfrz_option, kalg_out=kalg, & + fbot_xfer_type_out=fbot_xfer_type, puny_out=puny, & + wave_spec_type_out=wave_spec_type) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! other default values + !----------------------------------------------------------------- + + ndtd = 1 ! dynamic time steps per thermodynamic time step + l_mpond_fresh = .false. ! logical switch for including meltpond freshwater + ! flux feedback to ocean model + oceanmixed_ice = .false. ! if true, use internal ocean mixed layer + wave_spec_type = 'none' ! type of wave spectrum forcing + + tr_iage = .false. ! ice age + tr_FY = .false. ! ice age + tr_lvl = .false. ! level ice + tr_pond_cesm = .false. ! CESM melt ponds + tr_pond_lvl = .false. ! level-ice melt ponds + tr_pond_topo = .false. ! explicit melt ponds (topographic) + tr_aero = .false. ! aerosols + tr_fsd = .false. ! floe size distribution + + + !----------------------------------------------------------------- + ! read from input file + !----------------------------------------------------------------- + + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + + do while (nml_error > 0) + if (mype == 0) print*,'Reading grid_nml' + read(nu_nml, nml=grid_nml,iostat=nml_error) + if (nml_error /= 0) exit + + if (mype == 0) print*,'Reading tracer_nml' + read(nu_nml, nml=tracer_nml,iostat=nml_error) + if (nml_error /= 0) exit + + if (mype == 0) print*,'Reading thermo_nml' + read(nu_nml, nml=thermo_nml,iostat=nml_error) + if (nml_error /= 0) exit + + if (mype == 0) print*,'Reading shortwave_nml' + read(nu_nml, nml=shortwave_nml,iostat=nml_error) + if (nml_error /= 0) exit + + if (mype == 0) print*,'Reading ponds_nml' + read(nu_nml, nml=ponds_nml,iostat=nml_error) + if (nml_error /= 0) exit + + if (mype == 0) print*,'Reading forcing_nml' + read(nu_nml, nml=forcing_nml,iostat=nml_error) + if (nml_error /= 0) exit + end do + + if (nml_error == 0) close(nu_nml) + if (nml_error /= 0) then + if (mype == 0) write(*,*) 'Error reading iecpack namelists' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) + + !----------------------------------------------------------------- + ! set up diagnostics output and resolve conflicts + !----------------------------------------------------------------- + + if (mype == 0) write(*,*) 'Diagnostic output will be in files ' + if (mype == 0) write(*,*) ' ','icepack.diagnostics' + if (mype == 0) write(*,*) ' Error output will be in files ' + if (mype == 0) write(*,*) ' ','icepack.errors' + + diag_filename = 'icepack.diagnostics' + open (nu_diag, file=diag_filename, status='unknown', iostat=diag_error) + if (diag_error /= 0) then + if (mype == 0) write(*,*) 'Error while opening diagnostic file' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (mype == 0) write(nu_diag,*) '-----------------------------------' + if (mype == 0) write(nu_diag,*) ' ICEPACK model diagnostic output ' + if (mype == 0) write(nu_diag,*) '-----------------------------------' + if (mype == 0) write(nu_diag,*) ' ' + + if (ncat == 1 .and. kitd == 1) then + if (mype == 0) write (nu_diag,*) 'Remapping the ITD is not allowed for ncat=1.' + if (mype == 0) write (nu_diag,*) 'Use kitd = 0 (delta function ITD) with kcatbound = 0' + if (mype == 0) write (nu_diag,*) 'or for column configurations use kcatbound = -1' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (ncat /= 1 .and. kcatbound == -1) then + if (mype == 0) write (nu_diag,*) 'WARNING: ITD required for ncat > 1' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting kitd and kcatbound to default values' + kitd = 1 + kcatbound = 0 + endif + + rpcesm = c0 + rplvl = c0 + rptopo = c0 + if (tr_pond_cesm) rpcesm = c1 + if (tr_pond_lvl ) rplvl = c1 + if (tr_pond_topo) rptopo = c1 + + tr_pond = .false. ! explicit melt ponds + if (rpcesm + rplvl + rptopo > puny) tr_pond = .true. + + if (rpcesm + rplvl + rptopo > c1 + puny) then + if (mype == 0) write (nu_diag,*) 'WARNING: Must use only one melt pond scheme' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (tr_pond_lvl .and. .not. tr_lvl) then + if (mype == 0) write (nu_diag,*) 'WARNING: tr_pond_lvl=T but tr_lvl=F' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting tr_lvl=T' + tr_lvl = .true. + endif + + if (tr_pond_lvl .and. abs(hs0) > puny) then + if (mype == 0) write (nu_diag,*) 'WARNING: tr_pond_lvl=T and hs0/=0' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting hs0=0' + hs0 = c0 + endif + + if (tr_pond_cesm .and. trim(frzpnd) /= 'cesm') then + if (mype == 0) write (nu_diag,*) 'WARNING: tr_pond_cesm=T' + if (mype == 0) write (nu_diag,*) 'WARNING: frzpnd, dpscale not used' + frzpnd = 'cesm' + endif + + if (trim(shortwave) /= 'dEdd' .and. tr_pond .and. calc_tsfc) then + if (mype == 0) write (nu_diag,*) 'WARNING: Must use dEdd shortwave' + if (mype == 0) write (nu_diag,*) 'WARNING: with tr_pond and calc_tsfc=T.' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting shortwave = dEdd' + shortwave = 'dEdd' + endif + + if (tr_aero .and. n_aero==0) then + if (mype == 0) write (nu_diag,*) 'WARNING: aerosols activated but' + if (mype == 0) write (nu_diag,*) 'WARNING: not allocated in tracer array.' + if (mype == 0) write (nu_diag,*) 'WARNING: Activate in compilation script.' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (tr_aero .and. trim(shortwave) /= 'dEdd') then + if (mype == 0) write (nu_diag,*) 'WARNING: aerosols activated but dEdd' + if (mype == 0) write (nu_diag,*) 'WARNING: shortwave is not.' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting shortwave = dEdd' + shortwave = 'dEdd' + endif + + rfracmin = min(max(rfracmin,c0),c1) + rfracmax = min(max(rfracmax,c0),c1) + + if (ktherm == 2 .and. .not. calc_Tsfc) then + if (mype == 0) write (nu_diag,*) 'WARNING: ktherm = 2 and calc_Tsfc = F' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting calc_Tsfc = T' + calc_Tsfc = .true. + endif + + if (ktherm == 1 .and. trim(tfrz_option) /= 'linear_salt') then + if (mype == 0) write (nu_diag,*) & + 'WARNING: ktherm = 1 and tfrz_option = ',trim(tfrz_option) + if (mype == 0) write (nu_diag,*) & + 'WARNING: For consistency, set tfrz_option = linear_salt' + endif + if (ktherm == 2 .and. trim(tfrz_option) /= 'mushy') then + if (mype == 0) write (nu_diag,*) & + 'WARNING: ktherm = 2 and tfrz_option = ',trim(tfrz_option) + if (mype == 0) write (nu_diag,*) & + 'WARNING: For consistency, set tfrz_option = mushy' + endif + + if (formdrag) then + if (trim(atmbndy) == 'constant') then + if (mype == 0) write (nu_diag,*) 'WARNING: atmbndy = constant not allowed with formdrag' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting atmbndy = default' + atmbndy = 'default' + endif + + if (.not. calc_strair) then + if (mype == 0) write (nu_diag,*) 'WARNING: formdrag=T but calc_strair=F' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting calc_strair=T' + calc_strair = .true. + endif + + if (tr_pond_cesm) then + if (mype == 0) write (nu_diag,*) 'ERROR: formdrag=T but frzpnd=cesm' + if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (.not. tr_lvl) then + if (mype == 0) write (nu_diag,*) 'WARNING: formdrag=T but tr_lvl=F' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting tr_lvl=T' + tr_lvl = .true. + endif + endif + + if (trim(fbot_xfer_type) == 'Cdn_ocn' .and. .not. formdrag) then + if (mype == 0) write (nu_diag,*) 'WARNING: formdrag=F but fbot_xfer_type=Cdn_ocn' + if (mype == 0) write (nu_diag,*) 'WARNING: Setting fbot_xfer_type = constant' + fbot_xfer_type = 'constant' + endif + + wave_spec = .false. + if (tr_fsd .and. (trim(wave_spec_type) /= 'none')) wave_spec = .true. + + !----------------------------------------------------------------- + ! Write Icepack configuration + !----------------------------------------------------------------- + + if (mype == 0) then + + write(nu_diag,*) ' Document ice_in namelist parameters:' + write(nu_diag,*) ' ==================================== ' + write(nu_diag,*) ' ' + write(nu_diag,1020) ' kitd = ', kitd + write(nu_diag,1020) ' kcatbound = ', kcatbound + write(nu_diag,1020) ' ndtd = ', ndtd + write(nu_diag,1020) ' kstrength = ', kstrength + write(nu_diag,1020) ' krdg_partic = ', krdg_partic + write(nu_diag,1020) ' krdg_redist = ', krdg_redist + + if (krdg_redist == 1) then + write(nu_diag,1000) ' mu_rdg = ', mu_rdg + endif + + if (kstrength == 1) then + write(nu_diag,1000) ' Cf = ', Cf + end if + + write(nu_diag,1030) ' shortwave = ', trim(shortwave) + write(nu_diag,1000) ' -------------------------------' + write(nu_diag,1000) ' BGC coupling is switched OFF ' + write(nu_diag,1000) ' not implemented in this version' + write(nu_diag,1000) ' -------------------------------' + + if (trim(shortwave) == 'dEdd') then + write(nu_diag,1000) ' R_ice = ', R_ice + write(nu_diag,1000) ' R_pnd = ', R_pnd + write(nu_diag,1000) ' R_snw = ', R_snw + write(nu_diag,1000) ' dT_mlt = ', dT_mlt + write(nu_diag,1000) ' rsnw_mlt = ', rsnw_mlt + write(nu_diag,1000) ' kalg = ', kalg + write(nu_diag,1000) ' hp1 = ', hp1 + write(nu_diag,1000) ' hs0 = ', hs0 + else + write(nu_diag,1030) ' albedo_type = ', trim(albedo_type) + write(nu_diag,1000) ' albicev = ', albicev + write(nu_diag,1000) ' albicei = ', albicei + write(nu_diag,1000) ' albsnowv = ', albsnowv + write(nu_diag,1000) ' albsnowi = ', albsnowi + write(nu_diag,1000) ' ahmax = ', ahmax + endif + + write(nu_diag,1000) ' rfracmin = ', rfracmin + write(nu_diag,1000) ' rfracmax = ', rfracmax + + if (tr_pond_lvl) then + write(nu_diag,1000) ' hs1 = ', hs1 + write(nu_diag,1000) ' dpscale = ', dpscale + write(nu_diag,1030) ' frzpnd = ', trim(frzpnd) + endif + + if (tr_pond .and. .not. tr_pond_lvl) then + write(nu_diag,1000) ' pndaspect = ', pndaspect + end if + + write(nu_diag,1020) ' ktherm = ', ktherm + + if (ktherm == 1) then + write(nu_diag,1030) ' conduct = ', conduct + end if + + write(nu_diag,1005) ' emissivity = ', emissivity + + if (ktherm == 2) then + write(nu_diag,1005) ' a_rapid_mode = ', a_rapid_mode + write(nu_diag,1005) ' Rac_rapid_mode = ', Rac_rapid_mode + write(nu_diag,1005) ' aspect_rapid_mode = ', aspect_rapid_mode + write(nu_diag,1005) ' dSdt_slow_mode = ', dSdt_slow_mode + write(nu_diag,1005) ' phi_c_slow_mode = ', phi_c_slow_mode + write(nu_diag,1005) ' phi_i_mushy = ', phi_i_mushy + endif + + write(nu_diag,1030) ' atmbndy = ', trim(atmbndy) + write(nu_diag,1010) ' formdrag = ', formdrag + write(nu_diag,1010) ' highfreq = ', highfreq + write(nu_diag,1020) ' natmiter = ', natmiter + write(nu_diag,1010) ' calc_strair = ', calc_strair + write(nu_diag,1010) ' calc_Tsfc = ', calc_Tsfc + write(nu_diag,1010) ' update_ocn_f = ', update_ocn_f + write(nu_diag,1010) ' wave_spec = ', wave_spec + + if (wave_spec) then + write(nu_diag,*) ' wave_spec_type = ', wave_spec_type + endif + + write(nu_diag,1010) ' l_mpond_fresh = ', l_mpond_fresh + write(nu_diag,1005) ' ustar_min = ', ustar_min + write(nu_diag,*) ' fbot_xfer_type = ', trim(fbot_xfer_type) + write(nu_diag,1010) ' oceanmixed_ice = ', oceanmixed_ice + write(nu_diag,*) ' tfrz_option = ', trim(tfrz_option) + + ! tracers + write(nu_diag,1010) ' tr_iage = ', tr_iage + write(nu_diag,1010) ' tr_FY = ', tr_FY + write(nu_diag,1010) ' tr_lvl = ', tr_lvl + write(nu_diag,1010) ' tr_pond_cesm = ', tr_pond_cesm + write(nu_diag,1010) ' tr_pond_lvl = ', tr_pond_lvl + write(nu_diag,1010) ' tr_pond_topo = ', tr_pond_topo + write(nu_diag,1010) ' tr_aero = ', tr_aero + write(nu_diag,1010) ' tr_fsd = ', tr_fsd + + endif + + !----------------------------------------------------------------- + ! Compute number of tracers + !----------------------------------------------------------------- + + nt_Tsfc = 1 ! index tracers, starting with Tsfc = 1 + ntrcr = 1 ! count tracers, starting with Tsfc = 1 + + nt_qice = ntrcr + 1 + ntrcr = ntrcr + nilyr ! qice in nilyr layers + + nt_qsno = ntrcr + 1 + ntrcr = ntrcr + nslyr ! qsno in nslyr layers + + nt_sice = ntrcr + 1 + ntrcr = ntrcr + nilyr ! sice in nilyr layers + + nt_iage = max_ntrcr + if (tr_iage) then + ntrcr = ntrcr + 1 + nt_iage = ntrcr ! chronological ice age + endif + + nt_FY = max_ntrcr + if (tr_FY) then + ntrcr = ntrcr + 1 + nt_FY = ntrcr ! area of first year ice + endif + + nt_alvl = max_ntrcr + nt_vlvl = max_ntrcr + if (tr_lvl) then + ntrcr = ntrcr + 1 + nt_alvl = ntrcr ! area of level ice + ntrcr = ntrcr + 1 + nt_vlvl = ntrcr ! volume of level ice + endif + + nt_apnd = max_ntrcr + nt_hpnd = max_ntrcr + nt_ipnd = max_ntrcr + if (tr_pond) then ! all explicit melt pond schemes + ntrcr = ntrcr + 1 + nt_apnd = ntrcr + ntrcr = ntrcr + 1 + nt_hpnd = ntrcr + if (tr_pond_lvl) then + ntrcr = ntrcr + 1 ! refrozen pond ice lid thickness + nt_ipnd = ntrcr ! on level-ice ponds (if frzpnd='hlid') + endif + if (tr_pond_topo) then + ntrcr = ntrcr + 1 ! + nt_ipnd = ntrcr ! refrozen pond ice lid thickness + endif + endif + + nt_fsd = max_ntrcr + if (tr_fsd) then + nt_fsd = ntrcr + 1 ! floe size distribution + ntrcr = ntrcr + nfsd + end if + + nt_fsd = max_ntrcr + if (tr_fsd) then + nt_fsd = ntrcr + 1 ! floe size distribution + ntrcr = ntrcr + nfsd + end if + + nt_aero = max_ntrcr - 4*n_aero + if (tr_aero) then + nt_aero = ntrcr + 1 + ntrcr = ntrcr + 4*n_aero ! 4 dEdd layers, n_aero species + endif + + if (ntrcr > max_ntrcr-1) then + write(nu_diag,*) 'max_ntrcr-1 < number of namelist tracers' + write(nu_diag,*) 'max_ntrcr-1 = ',max_ntrcr-1,' ntrcr = ',ntrcr + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + write(nu_diag,*) ' ' + write(nu_diag,1020) 'max_ntrcr = ', max_ntrcr + write(nu_diag,1020) 'ntrcr = ' , ntrcr + write(nu_diag,*) ' ' + write(nu_diag,1020) 'nt_sice = ', nt_sice + write(nu_diag,1020) 'nt_qice = ', nt_qice + write(nu_diag,1020) 'nt_qsno = ', nt_qsno + write(nu_diag,*)' ' + write(nu_diag,1020) 'ncat = ', ncat + write(nu_diag,1020) 'nilyr = ', nilyr + write(nu_diag,1020) 'nslyr = ', nslyr + write(nu_diag,1020) 'nblyr = ', nblyr + write(nu_diag,1020) 'nfsd = ', nfsd + write(nu_diag,1020) 'n_aero = ', n_aero + + if (formdrag) then + if (nt_apnd==0) then + write(nu_diag,*)'ERROR: nt_apnd:',nt_apnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_hpnd==0) then + write(nu_diag,*)'ERROR: nt_hpnd:',nt_hpnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_ipnd==0) then + write(nu_diag,*)'ERROR: nt_ipnd:',nt_ipnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_alvl==0) then + write(nu_diag,*)'ERROR: nt_alvl:',nt_alvl + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_vlvl==0) then + write(nu_diag,*)'ERROR: nt_vlvl:',nt_vlvl + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + endif + + 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements + 1005 format (a30,2x,f9.6) ! float + 1010 format (a30,2x,l6) ! logical + 1020 format (a30,2x,i6) ! integer + 1030 format (a30, a8) ! character + 1040 format (a30,2x,6i6) ! integer + 1050 format (a30,2x,6a6) ! character + + !----------------------------------------------------------------- + ! set Icepack values + !----------------------------------------------------------------- + + call icepack_init_parameters(ustar_min_in=ustar_min, Cf_in=Cf, & + albicev_in=albicev, albicei_in=albicei, & + albsnowv_in=albsnowv, albsnowi_in=albsnowi, & + natmiter_in=natmiter, ahmax_in=ahmax, shortwave_in=shortwave, & + albedo_type_in=albedo_type, R_ice_in=R_ice, R_pnd_in=R_pnd, & + R_snw_in=R_snw, dT_mlt_in=dT_mlt, rsnw_mlt_in=rsnw_mlt, & + kstrength_in=kstrength, krdg_partic_in=krdg_partic, & + krdg_redist_in=krdg_redist, mu_rdg_in=mu_rdg, & + atmbndy_in=atmbndy, calc_strair_in=calc_strair, & + formdrag_in=formdrag, highfreq_in=highfreq, & + emissivity_in=emissivity, & + 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, & + 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, & + tfrz_option_in=tfrz_option, kalg_in=kalg, & + fbot_xfer_type_in=fbot_xfer_type, & + wave_spec_type_in=wave_spec_type, wave_spec_in=wave_spec) + call icepack_init_tracer_sizes(ntrcr_in=ntrcr, & + ncat_in=ncat, nilyr_in=nilyr, nslyr_in=nslyr, nblyr_in=nblyr, & + nfsd_in=nfsd, n_aero_in=n_aero) + call icepack_init_tracer_flags(tr_iage_in=tr_iage, & + tr_FY_in=tr_FY, tr_lvl_in=tr_lvl, tr_aero_in=tr_aero, & + tr_pond_in=tr_pond, tr_pond_cesm_in=tr_pond_cesm, & + tr_pond_lvl_in=tr_pond_lvl, & + tr_pond_topo_in=tr_pond_topo, tr_fsd_in=tr_fsd) + call icepack_init_tracer_indices(nt_Tsfc_in=nt_Tsfc, & + nt_sice_in=nt_sice, nt_qice_in=nt_qice, & + nt_qsno_in=nt_qsno, nt_iage_in=nt_iage, & + nt_fy_in=nt_fy, nt_alvl_in=nt_alvl, nt_vlvl_in=nt_vlvl, & + nt_apnd_in=nt_apnd, nt_hpnd_in=nt_hpnd, nt_ipnd_in=nt_ipnd, & + nt_aero_in=nt_aero, nt_fsd_in=nt_fsd) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + end subroutine set_icepack + +!======================================================================= + + subroutine set_grid_icepack(mesh, icepack_domain_size) + + use mod_mesh + use icedrv_settings + + implicit none + + ! INTEGER + integer :: i + !REAL + real (kind=dbl_kind) :: pi, puny + ! CHARACTER + character(len=*), parameter :: subname='(init_grid_icepack)' + ! TYPES + type(t_icepack_domain_size), intent(in), target :: icepack_domain_size + type(t_mesh), intent(in), target :: mesh + +#include "associate_icepack_domain_size.h" +#include "../associate_mesh.h" + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(pi_out=pi,puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! create hemisphereic masks + !----------------------------------------------------------------- + + !lmask_n(:) = .false. + !lmask_s(:) = .false. + ! + !do i = 1, nx + ! if (coord_nod2D(2,:) >= -puny) lmask_n(i) = .true. ! N. Hem. + ! if (coord_nod2D(2,:) < -puny) lmask_s(i) = .true. ! S. Hem. + !enddo + + end subroutine set_grid_icepack + +!======================================================================= + + end module icedrv_set + + + + + + + diff --git a/src/icepack_drivers/icedrv_settings.F90 b/src/icepack_drivers/icedrv_settings.F90 index e0e9e3ef9..dd26a3f35 100644 --- a/src/icepack_drivers/icedrv_settings.F90 +++ b/src/icepack_drivers/icedrv_settings.F90 @@ -14,7 +14,35 @@ module icedrv_settings implicit none - type t_icepack_settings + type t_icepack_domain_size + + ! setting variables used by the model + + integer (kind=int_kind) :: nx ! number of grid cells and gost cells for each mesh partition + integer (kind=int_kind) :: ncat ! number of categories in use + integer (kind=int_kind) :: nfsd ! number of floe size categories in use + integer (kind=int_kind) :: nilyr ! number of ice layers per category in use + integer (kind=int_kind) :: nslyr ! number of snow layers per category in use + integer (kind=int_kind) :: n_aero ! number of aerosols in use + integer (kind=int_kind) :: n_zaero ! number of z aerosols in use + integer (kind=int_kind) :: n_algae ! number of algae in use + integer (kind=int_kind) :: n_doc ! number of DOC pools in use + integer (kind=int_kind) :: n_dic ! number of DIC pools in use + integer (kind=int_kind) :: n_don ! number of DON pools in use + integer (kind=int_kind) :: n_fed ! number of Fe pools in use dissolved Fe + integer (kind=int_kind) :: n_fep ! number of Fe pools in use particulate Fe + integer (kind=int_kind) :: nblyr ! number of bio/brine layers per category + integer (kind=int_kind) :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic + integer (kind=int_kind) :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers + integer (kind=int_kind) :: max_nsw ! number of tracers active in shortwave calculation + integer (kind=int_kind) :: max_ntrcr ! number of tracers in total + integer (kind=int_kind) :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW + + end type t_icepack_domain_size + +!======================================================================= + + type t_icepack_namelists ! env namelist @@ -40,27 +68,6 @@ module icedrv_settings integer (kind=int_kind) :: trpnd ! set to 1 for melt pond tracers integer (kind=int_kind) :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) - ! setting variables used by the model - - integer (kind=int_kind) :: ncat ! number of categories in use - integer (kind=int_kind) :: nfsd ! number of floe size categories in use - integer (kind=int_kind) :: nilyr ! number of ice layers per category in use - integer (kind=int_kind) :: nslyr ! number of snow layers per category in use - integer (kind=int_kind) :: n_aero ! number of aerosols in use - integer (kind=int_kind) :: n_zaero ! number of z aerosols in use - integer (kind=int_kind) :: n_algae ! number of algae in use - integer (kind=int_kind) :: n_doc ! number of DOC pools in use - integer (kind=int_kind) :: n_dic ! number of DIC pools in use - integer (kind=int_kind) :: n_don ! number of DON pools in use - integer (kind=int_kind) :: n_fed ! number of Fe pools in use dissolved Fe - integer (kind=int_kind) :: n_fep ! number of Fe pools in use particulate Fe - integer (kind=int_kind) :: nblyr ! number of bio/brine layers per category - integer (kind=int_kind) :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic - integer (kind=int_kind) :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers - integer (kind=int_kind) :: max_nsw ! number of tracers active in shortwave calculation - integer (kind=int_kind) :: max_ntrcr ! number of tracers in total - integer (kind=int_kind) :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW - ! tracer namelist logical (kind=log_kind) :: tr_iage @@ -71,6 +78,10 @@ module icedrv_settings logical (kind=log_kind) :: tr_pond_lvl logical (kind=log_kind) :: tr_aero logical (kind=log_kind) :: tr_fsd + + ! grid namelist + + integer (kind=int_kind) :: kcatbound ! thermo namelist @@ -89,7 +100,7 @@ module icedrv_settings integer (kind=int_kind) :: kstrength integer (kind=int_kind) :: krdg_partic integer (kind=int_kind) :: krdg_redist - integer (kind=int_kind) :: mu_rdg + real (kind=dbl_kind) :: mu_rdg real (kind=dbl_kind) :: Cf ! shortwave namelist @@ -114,10 +125,10 @@ module icedrv_settings real (kind=dbl_kind) :: hs0 real (kind=dbl_kind) :: hs1 real (kind=dbl_kind) :: dpscale - character (len=char_len) :: frzpnd real (kind=dbl_kind) :: rfracmin real (kind=dbl_kind) :: rfracmax real (kind=dbl_kind) :: pndaspect + character (len=char_len) :: frzpnd ! forcing namelist @@ -134,9 +145,9 @@ module icedrv_settings logical (kind=log_kind) :: l_mpond_fresh character (len=char_len) :: tfrz_option logical (kind=log_kind) :: oceanmixed_ice - character (len=char_len) :: wave_spec_type + character (len=char_len) :: wave_spec_type - end type t_icepack_settings + end type t_icepack_namelists !======================================================================= From 50ac49b78e1f29d8690242b019c492a896802102 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 20 May 2020 15:50:27 +0200 Subject: [PATCH 10/54] Before attempting submodule implementation --- src/fvom_main.F90 | 13 +- .../associate_icepack_domain_size.h | 45 ---- .../associate_icepack_namelists.h | 193 ------------------ src/icepack_drivers/icedrv_constants.F90 | 3 - src/icepack_drivers/icedrv_domain_size.F90 | 52 +++++ src/icepack_drivers/icedrv_set.F90 | 165 +++++++++++---- src/icepack_drivers/icedrv_settings.F90 | 157 -------------- src/icepack_drivers/icedrv_state.F90 | 124 +++++++++++ 8 files changed, 310 insertions(+), 442 deletions(-) delete mode 100644 src/icepack_drivers/associate_icepack_domain_size.h delete mode 100644 src/icepack_drivers/associate_icepack_namelists.h create mode 100644 src/icepack_drivers/icedrv_domain_size.F90 delete mode 100644 src/icepack_drivers/icedrv_settings.F90 create mode 100644 src/icepack_drivers/icedrv_state.F90 diff --git a/src/fvom_main.F90 b/src/fvom_main.F90 index b4a6747a9..72a7aa87d 100755 --- a/src/fvom_main.F90 +++ b/src/fvom_main.F90 @@ -26,13 +26,13 @@ program main ! Define icepack modules #if defined (__icepack) -use icedrv_settings -use icedrv_set, only: set_icepack +use icedrv_set, only: set_icepack, set_grid_icepack #endif #if defined (__oasis) use cpl_driver #endif + IMPLICIT NONE integer :: n, nsteps, offset, row, i @@ -45,11 +45,6 @@ program main type(t_mesh), target, save :: mesh -#if defined (__icepack) -type(t_icepack_namelists), target, save :: icepack_namelists -type(t_icepack_domain_size), target, save :: icepack_domain_size -#endif - #ifndef __oifs !ECHAM6-FESOM2 coupling: cpl_oasis3mct_init is called here in order to avoid circular dependencies between modules (cpl_driver and g_PARSUP) !OIFS-FESOM2 coupling: does not require MPI_INIT here as this is done by OASIS @@ -85,8 +80,8 @@ program main ! Setup icepack !===================== if (mype==0) write(*,*) 'Icepack: reading namelists from namelist.icepack' - call set_icepack(icepack_namelists, icepack_domain_size) - call set_grid_icepack(mesh, icepack_domain_size) + call set_icepack + call set_grid_icepack(mesh) if (mype==0) write(*,*) 'Icepack: setup complete' #endif diff --git a/src/icepack_drivers/associate_icepack_domain_size.h b/src/icepack_drivers/associate_icepack_domain_size.h deleted file mode 100644 index 5f0b7cb37..000000000 --- a/src/icepack_drivers/associate_icepack_domain_size.h +++ /dev/null @@ -1,45 +0,0 @@ -! setting variables used by the model - -integer (kind=int_kind), pointer :: nx ! number of grid cells and gost cells for each mesh partition -integer (kind=int_kind), pointer :: ncat ! number of categories in use -integer (kind=int_kind), pointer :: nfsd ! number of floe size categories in use -integer (kind=int_kind), pointer :: nilyr ! number of ice layers per category in use -integer (kind=int_kind), pointer :: nslyr ! number of snow layers per category in use -integer (kind=int_kind), pointer :: n_aero ! number of aerosols in use -integer (kind=int_kind), pointer :: n_zaero ! number of z aerosols in use -integer (kind=int_kind), pointer :: n_algae ! number of algae in use -integer (kind=int_kind), pointer :: n_doc ! number of DOC pools in use -integer (kind=int_kind), pointer :: n_dic ! number of DIC pools in use -integer (kind=int_kind), pointer :: n_don ! number of DON pools in use -integer (kind=int_kind), pointer :: n_fed ! number of Fe pools in use dissolved Fe -integer (kind=int_kind), pointer :: n_fep ! number of Fe pools in use particulate Fe -integer (kind=int_kind), pointer :: nblyr ! number of bio/brine layers per category -integer (kind=int_kind), pointer :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic -integer (kind=int_kind), pointer :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers -integer (kind=int_kind), pointer :: max_nsw ! number of tracers active in shortwave calculation -integer (kind=int_kind), pointer :: max_ntrcr ! number of tracers in total -integer (kind=int_kind), pointer :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW - -!===================================================== -!===================================================== - -nx => icepack_domain_size%nx -ncat => icepack_domain_size%ncat -nfsd => icepack_domain_size%nfsd -nilyr => icepack_domain_size%nilyr -nslyr => icepack_domain_size%nslyr -n_aero => icepack_domain_size%n_aero -n_zaero => icepack_domain_size%n_zaero -n_algae => icepack_domain_size%n_algae -n_doc => icepack_domain_size%n_doc -n_dic => icepack_domain_size%n_dic -n_don => icepack_domain_size%n_don -n_fed => icepack_domain_size%n_fed -n_fep => icepack_domain_size%n_fep -nblyr => icepack_domain_size%nblyr -n_bgc => icepack_domain_size%n_bgc -nltrcr => icepack_domain_size%nltrcr -max_nsw => icepack_domain_size%max_nsw -nfreq => icepack_domain_size%nfreq -max_ntrcr => icepack_domain_size%max_ntrcr - diff --git a/src/icepack_drivers/associate_icepack_namelists.h b/src/icepack_drivers/associate_icepack_namelists.h deleted file mode 100644 index dacea562e..000000000 --- a/src/icepack_drivers/associate_icepack_namelists.h +++ /dev/null @@ -1,193 +0,0 @@ -! env namelist - -integer (kind=int_kind), pointer :: nicecat ! number of ice thickness categories -integer (kind=int_kind), pointer :: nfsdcat ! number of floe size categories -integer (kind=int_kind), pointer :: nicelyr ! number of vertical layers in the ice -integer (kind=int_kind), pointer :: nsnwlyr ! number of vertical layers in the snow -integer (kind=int_kind), pointer :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) -integer (kind=int_kind), pointer :: trzaero ! number of z aerosol tracers (up to max_aero = 6) -integer (kind=int_kind), pointer :: tralg ! number of algal tracers (up to max_algae = 3) -integer (kind=int_kind), pointer :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) -integer (kind=int_kind), pointer :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) -integer (kind=int_kind), pointer :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) -integer (kind=int_kind), pointer :: trfed ! number of dissolved iron tracers (up to max_fe = 2) -integer (kind=int_kind), pointer :: trfep ! number of particulate iron tracers (up to max_fe = 2) -integer (kind=int_kind), pointer :: nbgclyr ! number of zbgc layers -integer (kind=int_kind), pointer :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) -integer (kind=int_kind), pointer :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) -integer (kind=int_kind), pointer :: trbri ! set to 1 for brine height tracer -integer (kind=int_kind), pointer :: trage ! set to 1 for ice age tracer -integer (kind=int_kind), pointer :: trfy ! set to 1 for first-year ice area tracer -integer (kind=int_kind), pointer :: trlvl ! set to 1 for level and deformed ice tracers -integer (kind=int_kind), pointer :: trpnd ! set to 1 for melt pond tracers -integer (kind=int_kind), pointer :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) -integer (kind=int_kind), pointer :: ndtd ! dynamic time steps per thermodynamic time step - -! tracer namelist - -logical (kind=log_kind), pointer :: tr_iage -logical (kind=log_kind), pointer :: tr_FY -logical (kind=log_kind), pointer :: tr_lvl -logical (kind=log_kind), pointer :: tr_pond_cesm -logical (kind=log_kind), pointer :: tr_pond_topo -logical (kind=log_kind), pointer :: tr_pond_lvl -logical (kind=log_kind), pointer :: tr_aero -logical (kind=log_kind), pointer :: tr_fsd - -! grid namelist - -integer (kind=int_kind), pointer :: kcatbound - -! thermo namelist - -integer (kind=int_kind), pointer :: kitd -integer (kind=int_kind), pointer :: ktherm -character (len=char_len), pointer :: conduct -real (kind=dbl_kind), pointer :: a_rapid_mode -real (kind=dbl_kind), pointer :: Rac_rapid_mode -real (kind=dbl_kind), pointer :: aspect_rapid_mode -real (kind=dbl_kind), pointer :: dSdt_slow_mode -real (kind=dbl_kind), pointer :: phi_c_slow_mode -real (kind=dbl_kind), pointer :: phi_i_mushy - -! dynamics namelist - -integer (kind=int_kind), pointer :: kstrength -integer (kind=int_kind), pointer :: krdg_partic -integer (kind=int_kind), pointer :: krdg_redist -real (kind=dbl_kind), pointer :: mu_rdg -real (kind=dbl_kind), pointer :: Cf - -! shortwave namelist - -character (len=char_len), pointer :: shortwave -character (len=char_len), pointer :: albedo_type -real (kind=dbl_kind), pointer :: albicev -real (kind=dbl_kind), pointer :: albicei -real (kind=dbl_kind), pointer :: albsnowv -real (kind=dbl_kind), pointer :: albsnowi -real (kind=dbl_kind), pointer :: ahmax -real (kind=dbl_kind), pointer :: R_ice -real (kind=dbl_kind), pointer :: R_pnd -real (kind=dbl_kind), pointer :: R_snw -real (kind=dbl_kind), pointer :: dT_mlt -real (kind=dbl_kind), pointer :: rsnw_mlt -real (kind=dbl_kind), pointer :: kalg - -! forcing namelist - -logical (kind=log_kind), pointer :: formdrag -character (len=char_len), pointer :: atmbndy -logical (kind=log_kind), pointer :: calc_strair -logical (kind=log_kind), pointer :: calc_Tsfc -logical (kind=log_kind), pointer :: highfreq -integer (kind=int_kind), pointer :: natmiter -real (kind=dbl_kind), pointer :: ustar_min -real (kind=dbl_kind), pointer :: emissivity -character (len=char_len), pointer :: fbot_xfer_type -logical (kind=log_kind), pointer :: update_ocn_f -logical (kind=log_kind), pointer :: l_mpond_fresh -character (len=char_len), pointer :: tfrz_option -logical (kind=log_kind), pointer :: oceanmixed_ice -character (len=char_len), pointer :: wave_spec_type - -! pond namelist - -real (kind=dbl_kind), pointer :: hp1 -real (kind=dbl_kind), pointer :: hs0 -real (kind=dbl_kind), pointer :: hs1 -real (kind=dbl_kind), pointer :: dpscale -real (kind=dbl_kind), pointer :: rfracmin -real (kind=dbl_kind), pointer :: rfracmax -real (kind=dbl_kind), pointer :: pndaspect -character (len=char_len), pointer :: frzpnd - -!===================================================== -!===================================================== - -nicecat => icepack_namelists%nicecat -nfsdcat => icepack_namelists%nfsdcat -nicelyr => icepack_namelists%nicelyr -nsnwlyr => icepack_namelists%nsnwlyr -ntraero => icepack_namelists%ntraero -trzaero => icepack_namelists%trzaero -tralg => icepack_namelists%tralg -trdoc => icepack_namelists%trdoc -trdic => icepack_namelists%trdic -trdon => icepack_namelists%trdon -trfed => icepack_namelists%trfed -trfep => icepack_namelists%trfep -nbgclyr => icepack_namelists%nbgclyr -trbgcz => icepack_namelists%trbgcz -trzs => icepack_namelists%trzs -trbri => icepack_namelists%trbri -trage => icepack_namelists%trage -trfy => icepack_namelists%trfy -trlvl => icepack_namelists%trlvl -trpnd => icepack_namelists%trpnd -trbgcs => icepack_namelists%trbgcs - -tr_iage => icepack_namelists%tr_iage -tr_FY => icepack_namelists%tr_FY -tr_lvl => icepack_namelists%tr_lvl -tr_pond_cesm => icepack_namelists%tr_pond_cesm -tr_pond_topo => icepack_namelists%tr_pond_topo -tr_pond_lvl => icepack_namelists%tr_pond_lvl -tr_aero => icepack_namelists%tr_aero -tr_fsd => icepack_namelists%tr_fsd - -kcatbound => icepack_namelists%kcatbound - -kitd => icepack_namelists%kitd -ktherm => icepack_namelists%ktherm -conduct => icepack_namelists%conduct -a_rapid_mode => icepack_namelists%a_rapid_mode -Rac_rapid_mode => icepack_namelists%Rac_rapid_mode -aspect_rapid_mode => icepack_namelists%aspect_rapid_mode -dSdt_slow_mode => icepack_namelists%dSdt_slow_mode -phi_c_slow_mode => icepack_namelists%phi_c_slow_mode -phi_i_mushy => icepack_namelists%phi_i_mushy - -kstrength => icepack_namelists%kstrength -krdg_partic => icepack_namelists%krdg_partic -krdg_redist => icepack_namelists%krdg_redist -mu_rdg => icepack_namelists%mu_rdg -Cf => icepack_namelists%Cf - -shortwave => icepack_namelists%shortwave -albedo_type => icepack_namelists%albedo_type -albicev => icepack_namelists%albicev -albicei => icepack_namelists%albicei -albsnowv => icepack_namelists%albsnowv -albsnowi => icepack_namelists%albsnowi -ahmax => icepack_namelists%ahmax -R_ice => icepack_namelists%R_ice -R_pnd => icepack_namelists%R_pnd -R_snw => icepack_namelists%R_snw -dT_mlt => icepack_namelists%dT_mlt -rsnw_mlt => icepack_namelists%rsnw_mlt -kalg => icepack_namelists%kalg - -formdrag => icepack_namelists%formdrag -atmbndy => icepack_namelists%atmbndy -calc_strair => icepack_namelists%calc_strair -calc_Tsfc => icepack_namelists%calc_Tsfc -highfreq => icepack_namelists%highfreq -natmiter => icepack_namelists%natmiter -ustar_min => icepack_namelists%ustar_min -emissivity => icepack_namelists%emissivity -fbot_xfer_type => icepack_namelists%fbot_xfer_type -update_ocn_f => icepack_namelists%update_ocn_f -l_mpond_fresh => icepack_namelists%l_mpond_fresh -tfrz_option => icepack_namelists%tfrz_option -oceanmixed_ice => icepack_namelists%oceanmixed_ice -wave_spec_type => icepack_namelists%wave_spec_type - -hp1 => icepack_namelists%hp1 -hs0 => icepack_namelists%hs0 -hs1 => icepack_namelists%hs1 -dpscale => icepack_namelists%dpscale -rfracmin => icepack_namelists%rfracmin -rfracmax => icepack_namelists%rfracmax -pndaspect => icepack_namelists%pndaspect -frzpnd => icepack_namelists%frzpnd diff --git a/src/icepack_drivers/icedrv_constants.F90 b/src/icepack_drivers/icedrv_constants.F90 index cfb44c5ae..733253456 100644 --- a/src/icepack_drivers/icedrv_constants.F90 +++ b/src/icepack_drivers/icedrv_constants.F90 @@ -62,10 +62,7 @@ module icedrv_constants p75 = 0.75_dbl_kind, & p333 = c1/c3, & p666 = c2/c3 - - real (kind=dbl_kind), public :: puny=10.0e-11_dbl_kind - !----------------------------------------------------------------- ! physical constants !----------------------------------------------------------------- diff --git a/src/icepack_drivers/icedrv_domain_size.F90 b/src/icepack_drivers/icedrv_domain_size.F90 new file mode 100644 index 000000000..f2345bca5 --- /dev/null +++ b/src/icepack_drivers/icedrv_domain_size.F90 @@ -0,0 +1,52 @@ +!======================================================================= +! +! Defines the domain size, number of categories and layers. +! +! author L. Zampieri +! +!======================================================================= + + module icedrv_domain_size + + use icedrv_kinds + +!======================================================================= + + implicit none + + public & + nx, ncat, nfsd, nilyr, nslyr, n_aero, n_zaero, n_algae, & + n_doc, n_dic, n_don, n_fed, n_fep, nblyr, n_bgc, nltrcr, & + max_nsw, max_ntrcr, nfreq, ndtd + + private + + ! setting variables used by the model + + integer (kind=int_kind), save :: nx ! number of grid cells and gost cells for each mesh partition + integer (kind=int_kind), save :: ncat ! number of categories in use + integer (kind=int_kind), save :: nfsd ! number of floe size categories in use + integer (kind=int_kind), save :: nilyr ! number of ice layers per category in use + integer (kind=int_kind), save :: nslyr ! number of snow layers per category in use + integer (kind=int_kind), save :: n_aero ! number of aerosols in use + integer (kind=int_kind), save :: n_zaero ! number of z aerosols in use + integer (kind=int_kind), save :: n_algae ! number of algae in use + integer (kind=int_kind), save :: n_doc ! number of DOC pools in use + integer (kind=int_kind), save :: n_dic ! number of DIC pools in use + integer (kind=int_kind), save :: n_don ! number of DON pools in use + integer (kind=int_kind), save :: n_fed ! number of Fe pools in use dissolved Fe + integer (kind=int_kind), save :: n_fep ! number of Fe pools in use particulate Fe + integer (kind=int_kind), save :: nblyr ! number of bio/brine layers per category + integer (kind=int_kind), save :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic + integer (kind=int_kind), save :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers + integer (kind=int_kind), save :: max_nsw ! number of tracers active in shortwave calculation + integer (kind=int_kind), save :: max_ntrcr ! number of tracers in total + integer (kind=int_kind), save :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW + integer (kind=int_kind), save :: ndtd ! dynamic time steps per thermodynamic time step + +!======================================================================= + + end module icedrv_domain_size + +!======================================================================= + diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 4e563e267..590ffd534 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -10,7 +10,7 @@ module icedrv_set use icedrv_kinds use icedrv_constants, only: nu_diag, ice_stdout, nu_diag_out, nu_nml - use icedrv_constants, only: c0, c1, c2, c3, p2, p5, puny + use icedrv_constants, only: c0, c1, c2, c3, p2, p5 use icepack_intfc, only: icepack_init_parameters use icepack_intfc, only: icepack_init_fsd use icepack_intfc, only: icepack_init_tracer_flags @@ -26,38 +26,136 @@ module icedrv_set use icedrv_system, only: icedrv_system_abort implicit none + + public set_icepack, set_grid_icepack + private - public :: set_icepack, set_grid_icepack contains - subroutine set_icepack(icepack_namelists, icepack_domain_size) + subroutine set_icepack - use icedrv_settings - use g_parsup, only: mype, myDim_nod2D, eDim_nod2D + use icedrv_domain_size + use g_parsup, only: mype, myDim_nod2D, eDim_nod2D implicit none - ! CHARACTER + ! local variables + character(len=char_len) :: nml_filename, diag_filename character(len=*), parameter :: subname = '(set_icepack)' - ! INTEGER integer (kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd integer (kind=int_kind) :: nt_ipnd, nt_aero, nt_fsd, nt_FY integer (kind=int_kind) :: ntrcr, nt_iage - integer (kind=int_kind) :: nml_error, diag_error ! i/o error flag - integer (kind=int_kind) :: n ! loop index - ! REAL - real (kind=real_kind) :: rpcesm, rplvl, rptopo - ! LOGICAL + integer (kind=int_kind) :: nml_error, diag_error + integer (kind=int_kind) :: n + real (kind=dbl_kind) :: rpcesm, rplvl, rptopo, puny logical (kind=log_kind) :: tr_pond, wave_spec - ! TYPE - type(t_icepack_namelists), intent(inout), target :: icepack_namelists - type(t_icepack_domain_size), intent(inout), target :: icepack_domain_size -#include "associate_icepack_namelists.h" -#include "associate_icepack_domain_size.h" + ! env namelist + + integer (kind=int_kind) :: nicecat ! number of ice thickness categories + integer (kind=int_kind) :: nfsdcat ! number of floe size categories + integer (kind=int_kind) :: nicelyr ! number of vertical layers in the ice + integer (kind=int_kind) :: nsnwlyr ! number of vertical layers in the snow + integer (kind=int_kind) :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) + integer (kind=int_kind) :: trzaero ! number of z aerosol tracers (up to max_aero = 6) + integer (kind=int_kind) :: tralg ! number of algal tracers (up to max_algae = 3) + integer (kind=int_kind) :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) + integer (kind=int_kind) :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) + integer (kind=int_kind) :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) + integer (kind=int_kind) :: trfed ! number of dissolved iron tracers (up to max_fe = 2) + integer (kind=int_kind) :: trfep ! number of particulate iron tracers (up to max_fe = 2) + integer (kind=int_kind) :: nbgclyr ! number of zbgc layers + integer (kind=int_kind) :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) + integer (kind=int_kind) :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) + integer (kind=int_kind) :: trbri ! set to 1 for brine height tracer + integer (kind=int_kind) :: trage ! set to 1 for ice age tracer + integer (kind=int_kind) :: trfy ! set to 1 for first-year ice area tracer + integer (kind=int_kind) :: trlvl ! set to 1 for level and deformed ice tracers + integer (kind=int_kind) :: trpnd ! set to 1 for melt pond tracers + integer (kind=int_kind) :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) + + ! tracer namelist + + logical (kind=log_kind) :: tr_iage + logical (kind=log_kind) :: tr_FY + logical (kind=log_kind) :: tr_lvl + logical (kind=log_kind) :: tr_pond_cesm + logical (kind=log_kind) :: tr_pond_topo + logical (kind=log_kind) :: tr_pond_lvl + logical (kind=log_kind) :: tr_aero + logical (kind=log_kind) :: tr_fsd + + ! grid namelist + + integer (kind=int_kind) :: kcatbound + + ! thermo namelist + + integer (kind=int_kind) :: kitd + integer (kind=int_kind) :: ktherm + character (len=char_len) :: conduct + real (kind=dbl_kind) :: a_rapid_mode + real (kind=dbl_kind) :: Rac_rapid_mode + real (kind=dbl_kind) :: aspect_rapid_mode + real (kind=dbl_kind) :: dSdt_slow_mode + real (kind=dbl_kind) :: phi_c_slow_mode + real (kind=dbl_kind) :: phi_i_mushy + + ! dynamics namelist + + integer (kind=int_kind) :: kstrength + integer (kind=int_kind) :: krdg_partic + integer (kind=int_kind) :: krdg_redist + real (kind=dbl_kind) :: mu_rdg + real (kind=dbl_kind) :: Cf + + ! shortwave namelist + + character (len=char_len) :: shortwave + character (len=char_len) :: albedo_type + real (kind=dbl_kind) :: albicev + real (kind=dbl_kind) :: albicei + real (kind=dbl_kind) :: albsnowv + real (kind=dbl_kind) :: albsnowi + real (kind=dbl_kind) :: ahmax + real (kind=dbl_kind) :: R_ice + real (kind=dbl_kind) :: R_pnd + real (kind=dbl_kind) :: R_snw + real (kind=dbl_kind) :: dT_mlt + real (kind=dbl_kind) :: rsnw_mlt + real (kind=dbl_kind) :: kalg + + ! ponds namelist + + real (kind=dbl_kind) :: hp1 + real (kind=dbl_kind) :: hs0 + real (kind=dbl_kind) :: hs1 + real (kind=dbl_kind) :: dpscale + real (kind=dbl_kind) :: rfracmin + real (kind=dbl_kind) :: rfracmax + real (kind=dbl_kind) :: pndaspect + character (len=char_len) :: frzpnd + + ! forcing namelist + + logical (kind=log_kind) :: formdrag + character (len=char_len) :: atmbndy + logical (kind=log_kind) :: calc_strair + logical (kind=log_kind) :: calc_Tsfc + logical (kind=log_kind) :: highfreq + integer (kind=int_kind) :: natmiter + real (kind=dbl_kind) :: ustar_min + real (kind=dbl_kind) :: emissivity + character (len=char_len) :: fbot_xfer_type + logical (kind=log_kind) :: update_ocn_f + logical (kind=log_kind) :: l_mpond_fresh + character (len=char_len) :: tfrz_option + logical (kind=log_kind) :: oceanmixed_ice + character (len=char_len) :: wave_spec_type + !----------------------------------------------------------------- ! Namelist definition @@ -729,34 +827,31 @@ end subroutine set_icepack !======================================================================= - subroutine set_grid_icepack(mesh, icepack_domain_size) + subroutine set_grid_icepack(mesh) use mod_mesh - use icedrv_settings - - implicit none - - ! INTEGER - integer :: i - !REAL - real (kind=dbl_kind) :: pi, puny - ! CHARACTER - character(len=*), parameter :: subname='(init_grid_icepack)' - ! TYPES - type(t_icepack_domain_size), intent(in), target :: icepack_domain_size - type(t_mesh), intent(in), target :: mesh - -#include "associate_icepack_domain_size.h" -#include "../associate_mesh.h" + use icedrv_domain_size, only: nx + use g_parsup, only: myDim_nod2D, eDim_nod2D + implicit none + + integer (kind=int_kind) :: i + real(kind=dbl_kind) :: puny + real(kind=dbl_kind), dimension(:,:), pointer :: coord_nod2D + character(len=*), parameter :: subname = '(init_grid_icepack)' + type(t_mesh), intent(in), target :: mesh + + !----------------------------------------------------------------- ! query Icepack values !----------------------------------------------------------------- - call icepack_query_parameters(pi_out=pi,puny_out=puny) + call icepack_query_parameters(puny_out=puny) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) + + coord_nod2D(1:2,1:myDim_nod2D+eDim_nod2D) => mesh%coord_nod2D !----------------------------------------------------------------- ! create hemisphereic masks diff --git a/src/icepack_drivers/icedrv_settings.F90 b/src/icepack_drivers/icedrv_settings.F90 deleted file mode 100644 index dd26a3f35..000000000 --- a/src/icepack_drivers/icedrv_settings.F90 +++ /dev/null @@ -1,157 +0,0 @@ -!======================================================================= -! -! Defines the domain size, number of categories and layers. -! -! author L. Zampieri -!a -!======================================================================= - - module icedrv_settings - - use icedrv_kinds - -!======================================================================= - - implicit none - - type t_icepack_domain_size - - ! setting variables used by the model - - integer (kind=int_kind) :: nx ! number of grid cells and gost cells for each mesh partition - integer (kind=int_kind) :: ncat ! number of categories in use - integer (kind=int_kind) :: nfsd ! number of floe size categories in use - integer (kind=int_kind) :: nilyr ! number of ice layers per category in use - integer (kind=int_kind) :: nslyr ! number of snow layers per category in use - integer (kind=int_kind) :: n_aero ! number of aerosols in use - integer (kind=int_kind) :: n_zaero ! number of z aerosols in use - integer (kind=int_kind) :: n_algae ! number of algae in use - integer (kind=int_kind) :: n_doc ! number of DOC pools in use - integer (kind=int_kind) :: n_dic ! number of DIC pools in use - integer (kind=int_kind) :: n_don ! number of DON pools in use - integer (kind=int_kind) :: n_fed ! number of Fe pools in use dissolved Fe - integer (kind=int_kind) :: n_fep ! number of Fe pools in use particulate Fe - integer (kind=int_kind) :: nblyr ! number of bio/brine layers per category - integer (kind=int_kind) :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic - integer (kind=int_kind) :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers - integer (kind=int_kind) :: max_nsw ! number of tracers active in shortwave calculation - integer (kind=int_kind) :: max_ntrcr ! number of tracers in total - integer (kind=int_kind) :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW - - end type t_icepack_domain_size - -!======================================================================= - - type t_icepack_namelists - - ! env namelist - - integer (kind=int_kind) :: nicecat ! number of ice thickness categories - integer (kind=int_kind) :: nfsdcat ! number of floe size categories - integer (kind=int_kind) :: nicelyr ! number of vertical layers in the ice - integer (kind=int_kind) :: nsnwlyr ! number of vertical layers in the snow - integer (kind=int_kind) :: ntraero ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) - integer (kind=int_kind) :: trzaero ! number of z aerosol tracers (up to max_aero = 6) - integer (kind=int_kind) :: tralg ! number of algal tracers (up to max_algae = 3) - integer (kind=int_kind) :: trdoc ! number of dissolve organic carbon (up to max_doc = 3) - integer (kind=int_kind) :: trdic ! number of dissolve inorganic carbon (up to max_dic = 1) - integer (kind=int_kind) :: trdon ! number of dissolve organic nitrogen (up to max_don = 1) - integer (kind=int_kind) :: trfed ! number of dissolved iron tracers (up to max_fe = 2) - integer (kind=int_kind) :: trfep ! number of particulate iron tracers (up to max_fe = 2) - integer (kind=int_kind) :: nbgclyr ! number of zbgc layers - integer (kind=int_kind) :: trbgcz ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) - integer (kind=int_kind) :: trzs ! set to 1 for zsalinity tracer (needs TRBRI = 1) - integer (kind=int_kind) :: trbri ! set to 1 for brine height tracer - integer (kind=int_kind) :: trage ! set to 1 for ice age tracer - integer (kind=int_kind) :: trfy ! set to 1 for first-year ice area tracer - integer (kind=int_kind) :: trlvl ! set to 1 for level and deformed ice tracers - integer (kind=int_kind) :: trpnd ! set to 1 for melt pond tracers - integer (kind=int_kind) :: trbgcs ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) - - ! tracer namelist - - logical (kind=log_kind) :: tr_iage - logical (kind=log_kind) :: tr_FY - logical (kind=log_kind) :: tr_lvl - logical (kind=log_kind) :: tr_pond_cesm - logical (kind=log_kind) :: tr_pond_topo - logical (kind=log_kind) :: tr_pond_lvl - logical (kind=log_kind) :: tr_aero - logical (kind=log_kind) :: tr_fsd - - ! grid namelist - - integer (kind=int_kind) :: kcatbound - - ! thermo namelist - - integer (kind=int_kind) :: kitd - integer (kind=int_kind) :: ktherm - character (len=char_len) :: conduct - real (kind=dbl_kind) :: a_rapid_mode - real (kind=dbl_kind) :: Rac_rapid_mode - real (kind=dbl_kind) :: aspect_rapid_mode - real (kind=dbl_kind) :: dSdt_slow_mode - real (kind=dbl_kind) :: phi_c_slow_mode - real (kind=dbl_kind) :: phi_i_mushy - - ! dynamics namelist - - integer (kind=int_kind) :: kstrength - integer (kind=int_kind) :: krdg_partic - integer (kind=int_kind) :: krdg_redist - real (kind=dbl_kind) :: mu_rdg - real (kind=dbl_kind) :: Cf - - ! shortwave namelist - - character (len=char_len) :: shortwave - character (len=char_len) :: albedo_type - real (kind=dbl_kind) :: albicev - real (kind=dbl_kind) :: albicei - real (kind=dbl_kind) :: albsnowv - real (kind=dbl_kind) :: albsnowi - real (kind=dbl_kind) :: ahmax - real (kind=dbl_kind) :: R_ice - real (kind=dbl_kind) :: R_pnd - real (kind=dbl_kind) :: R_snw - real (kind=dbl_kind) :: dT_mlt - real (kind=dbl_kind) :: rsnw_mlt - real (kind=dbl_kind) :: kalg - - ! ponds namelist - - real (kind=dbl_kind) :: hp1 - real (kind=dbl_kind) :: hs0 - real (kind=dbl_kind) :: hs1 - real (kind=dbl_kind) :: dpscale - real (kind=dbl_kind) :: rfracmin - real (kind=dbl_kind) :: rfracmax - real (kind=dbl_kind) :: pndaspect - character (len=char_len) :: frzpnd - - ! forcing namelist - - logical (kind=log_kind) :: formdrag - character (len=char_len) :: atmbndy - logical (kind=log_kind) :: calc_strair - logical (kind=log_kind) :: calc_Tsfc - logical (kind=log_kind) :: highfreq - integer (kind=int_kind) :: natmiter - real (kind=dbl_kind) :: ustar_min - real (kind=dbl_kind) :: emissivity - character (len=char_len) :: fbot_xfer_type - logical (kind=log_kind) :: update_ocn_f - logical (kind=log_kind) :: l_mpond_fresh - character (len=char_len) :: tfrz_option - logical (kind=log_kind) :: oceanmixed_ice - character (len=char_len) :: wave_spec_type - - end type t_icepack_namelists - -!======================================================================= - - end module icedrv_settings - -!======================================================================= - diff --git a/src/icepack_drivers/icedrv_state.F90 b/src/icepack_drivers/icedrv_state.F90 new file mode 100644 index 000000000..8711c29f0 --- /dev/null +++ b/src/icepack_drivers/icedrv_state.F90 @@ -0,0 +1,124 @@ +!======================================================================= +! +! Primary state variables in various configurations +! Note: other state variables are at the end of this... +! The primary state variable names are: +!------------------------------------------------------------------- +! for each category aggregated over units +! categories +!------------------------------------------------------------------- +! aicen(i,n) aice(i) --- +! vicen(i,n) vice(i) m +! vsnon(i,n) vsno(i) m +! trcrn(i,it,n) trcr(i,it) +! +! Area is dimensionless because aice is the fractional area +! (normalized so that the sum over all categories, including open +! water, is 1.0). That is why vice/vsno have units of m instead of m^3. +! +! Variable names follow these rules: +! +! (1) For 3D variables (indices i,n), write 'ice' or 'sno' or +! 'sfc' and put an 'n' at the end. +! (2) For 2D variables (indices i) aggregated over all categories, +! write 'ice' or 'sno' or 'sfc' without the 'n'. +! (3) For 2D variables (indices i) associated with an individual +! category, write 'i' or 's' instead of 'ice' or 'sno' and put an 'n' +! at the end: e.g. hin, hsn. These are not declared here +! but in individual modules (e.g., ice_therm_vertical). +! +! authors C. M. Bitz, UW +! Elizabeth C. Hunke and William H. Lipscomb, LANL + + module icedrv_state + + use icedrv_kinds + use icedrv_domain_size, only: nx, ncat, max_ntrcr + + implicit none + private + + !----------------------------------------------------------------- + ! state of the ice aggregated over all categories + !----------------------------------------------------------------- + + real (kind=dbl_kind), dimension(nx), & + public :: & + aice , & ! concentration of ice + vice , & ! volume per unit area of ice (m) + vsno ! volume per unit area of snow (m) + + real (kind=dbl_kind), & + dimension(nx,max_ntrcr), public :: & + trcr ! ice tracers + ! 1: surface temperature of ice/snow (C) + + !----------------------------------------------------------------- + ! state of the ice for each category + !----------------------------------------------------------------- + + real (kind=dbl_kind), dimension (nx), & + public:: & + aice0 ! concentration of open water + + real (kind=dbl_kind), & + dimension (nx,ncat), 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 (nx,max_ntrcr,ncat) :: & + trcrn ! tracers + ! 1: surface temperature of ice/snow (C) + + !----------------------------------------------------------------- + ! tracer infrastructure arrays + !----------------------------------------------------------------- + + integer (kind=int_kind), dimension (max_ntrcr), public :: & + trcr_depend ! = 0 for ice area tracers + ! = 1 for ice volume tracers + ! = 2 for snow volume tracers + + integer (kind=int_kind), dimension (max_ntrcr), public :: & + n_trcr_strata ! number of underlying tracer layers + + integer (kind=int_kind), dimension (max_ntrcr,2), public :: & + nt_strata ! indices of underlying tracer layers + + real (kind=dbl_kind), dimension (max_ntrcr,3), public :: & + trcr_base ! = 0 or 1 depending on tracer dependency + ! argument 2: (1) aice, (2) vice, (3) vsno + + !----------------------------------------------------------------- + ! dynamic variables closely related to the state of the ice + !----------------------------------------------------------------- + + real (kind=dbl_kind), dimension(nx), & + public :: & + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + divu , & ! strain rate I component, velocity divergence (1/s) + shear , & ! strain rate II component (1/s) + strength ! ice strength (N/m) + + !----------------------------------------------------------------- + ! ice state at start of time step, saved for later in the step + !----------------------------------------------------------------- + + real (kind=dbl_kind), dimension(nx), & + public :: & + aice_init ! initial concentration of ice, for diagnostics + + real (kind=dbl_kind), & + dimension(nx,ncat), 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 + +!======================================================================= + + end module icedrv_state + +!======================================================================= From aa935d6e589fc4faf367baa318f6a3c0ccf547ea Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 20 May 2020 21:25:50 +0200 Subject: [PATCH 11/54] Variable declaration with submodules --- src/fvom_main.F90 | 2 +- src/icepack_drivers/icedrv_main.F90 | 723 +++++++++++++++++++++++++++ src/icepack_drivers/icedrv_set.F90 | 17 +- src/icepack_drivers/icedrv_state.F90 | 124 ----- 4 files changed, 728 insertions(+), 138 deletions(-) create mode 100644 src/icepack_drivers/icedrv_main.F90 delete mode 100644 src/icepack_drivers/icedrv_state.F90 diff --git a/src/fvom_main.F90 b/src/fvom_main.F90 index 72a7aa87d..190ba94bf 100755 --- a/src/fvom_main.F90 +++ b/src/fvom_main.F90 @@ -26,7 +26,7 @@ program main ! Define icepack modules #if defined (__icepack) -use icedrv_set, only: set_icepack, set_grid_icepack +use icedrv_main, only: set_icepack, set_grid_icepack #endif #if defined (__oasis) diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 new file mode 100644 index 000000000..8a9ea2aa0 --- /dev/null +++ b/src/icepack_drivers/icedrv_main.F90 @@ -0,0 +1,723 @@ +!======================================================================= +! +! Module that contains the whole icepack implementation in fesom2 +! +! author Lorenzo Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + + module icedrv_main + + use icedrv_kinds + use icedrv_constants + + implicit none + + !======================================================================= +!--------- List here all the public variables to be seen outside icepack + !======================================================================= + + public :: set_icepack, set_grid_icepack + + !======================================================================= +!--------- Everything else is private + !======================================================================= + + private + + !======================================================================= +!--------- Declare all the variables used or required by Icepack + !======================================================================= + + !======================================================================= + ! 1. Setting variables used by the model + !======================================================================= + + integer (kind=int_kind), save :: nx ! number of grid cells and gost cells for each mesh partition + integer (kind=int_kind), save :: ncat ! number of categories in use + integer (kind=int_kind), save :: nfsd ! number of floe size categories in use + integer (kind=int_kind), save :: nilyr ! number of ice layers per category in use + integer (kind=int_kind), save :: nslyr ! number of snow layers per category in use + integer (kind=int_kind), save :: n_aero ! number of aerosols in use + integer (kind=int_kind), save :: n_zaero ! number of z aerosols in use + integer (kind=int_kind), save :: n_algae ! number of algae in use + integer (kind=int_kind), save :: n_doc ! number of DOC pools in use + integer (kind=int_kind), save :: n_dic ! number of DIC pools in use + integer (kind=int_kind), save :: n_don ! number of DON pools in use + integer (kind=int_kind), save :: n_fed ! number of Fe pools in use dissolved Fe + integer (kind=int_kind), save :: n_fep ! number of Fe pools in use particulate Fe + integer (kind=int_kind), save :: nblyr ! number of bio/brine layers per category + integer (kind=int_kind), save :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic + integer (kind=int_kind), save :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers + integer (kind=int_kind), save :: max_nsw ! number of tracers active in shortwave calculation + integer (kind=int_kind), save :: max_ntrcr ! number of tracers in total + integer (kind=int_kind), save :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW + integer (kind=int_kind), save :: ndtd ! dynamic time steps per thermodynamic time step + + !======================================================================= + ! 2. State variabels for icepack + !======================================================================= + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + aice(:) , & ! concentration of ice + vice(:) , & ! volume per unit area of ice (m) + vsno(:) ! volume per unit area of snow (m) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,max_ntrcr + trcr(:,:) ! ice tracers + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + aice0(:) ! concentration of open water + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,ncat + aicen(:,:) , & ! concentration of ice + vicen(:,:) , & ! volume per unit area of ice (m) + vsnon(:,:) ! volume per unit area of snow (m) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,max_ntrcr,ncat + trcrn(:,:,:) ! tracers + + integer (kind=int_kind), allocatable, save :: & ! DIM max_ntrcr + trcr_depend(:) ! = 0 for ice area tracers + ! = 1 for ice volume tracers + ! = 2 for snow volume tracers + + integer (kind=int_kind), allocatable, save :: & ! DIM max_ntrcr + n_trcr_strata(:) ! number of underlying tracer layers + + integer (kind=int_kind), allocatable, save :: & ! DIM max_ntrcr,2 + nt_strata(:,:) ! indices of underlying tracer layers + + real (kind=dbl_kind), allocatable, save :: & ! DIM max_ntrcr,3 + trcr_base(:,:) ! = 0 or 1 depending on tracer dependency + ! argument 2: (1) aice, (2) vice, (3) vsno + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + uvel(:) , & ! x-component of velocity (m/s) + vvel(:) , & ! y-component of velocity (m/s) + divu(:) , & ! strain rate I component, velocity divergence (1/s) + shear(:) , & ! strain rate II component (1/s) + strength(:) ! ice strength (N/m) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + aice_init(:) ! initial concentration of ice, for diagnostics + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,ncat + 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 + + !======================================================================= + ! 3. Flux variabels + !======================================================================= + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + ! in from atmos (if .not. calc_strair) + strax(:) , & ! wind stress components (N/m^2) + stray(:) , & + ! in from ocean + uocn(:) , & ! ocean current, x-direction (m/s) + vocn(:) , & ! ocean current, y-direction (m/s) + ! out to atmosphere + strairxT(:), & ! stress on ice by air, x-direction + strairyT(:), & ! stress on ice by air, y-direction + ! out to ocean T-cell (kg/m s^2) + strocnxT(:), & ! ice-ocean stress, x-direction + strocnyT(:) ! ice-ocean stress, y-direction + + ! diagnostic + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + strairx(:) , & ! stress on ice by air, x-direction + strairy(:) , & ! stress on ice by air, y-direction + daidtd(:) , & ! ice area tendency due to transport (1/s) + dvidtd(:) , & ! ice volume tendency due to transport (m/s) + dagedtd(:) , & ! ice age tendency due to transport (s/s) + dardg1dt(:), & ! rate of area loss by ridging ice (1/s) + dardg2dt(:), & ! rate of area gain by new ridges (1/s) + dvirdgdt(:), & ! rate of ice volume ridged (m/s) + closing(:), & ! rate of closing due to divergence/shear (1/s) + opening(:), & ! rate of opening due to divergence/shear (1/s) + ! ridging diagnostics in categories + dardg1ndt(:,:), & ! rate of area loss by ridging ice (1/s) + dardg2ndt(:,:), & ! rate of area gain by new ridges (1/s) + dvirdgndt(:,:), & ! rate of ice volume ridged (m/s) + aparticn(:,:), & ! participation function + krdgn(:,:), & ! mean ridge thickness/thickness of ridging ice + ardgn(:,:), & ! fractional area of ridged ice + vrdgn(:,:), & ! volume of ridged ice + araftn(:,:), & ! rafting ice area + vraftn(:,:), & ! rafting ice volume + aredistn(:,:), & ! redistribution function: fraction of new ridge area + vredistn(:,:) ! redistribution function: fraction of new ridge volume + + ! in from atmosphere (if calc_Tsfc) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + zlvl(:) , & ! atm level height (m) + uatm(:) , & ! wind velocity components (m/s) + vatm(:) , & + wind(:) , & ! wind speed (m/s) + potT(:) , & ! air potential temperature (K) + T_air(:) , & ! air temperature (K) + Qa(:) , & ! specific humidity (kg/kg) + rhoa(:) , & ! air density (kg/m^3) + swvdr(:) , & ! sw down, visible, direct (W/m^2) + swvdf(:) , & ! sw down, visible, diffuse (W/m^2) + swidr(:) , & ! sw down, near IR, direct (W/m^2) + swidf(:) , & ! sw down, near IR, diffuse (W/m^2) + flw(:) , & ! incoming longwave radiation (W/m^2) + fsw(:) ! incoming shortwave radiation (W/m^2) (internal use) + + ! in from atmosphere (if .not. calc_Tsfc) + ! These are per ice area + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,ncat + 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 + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + frain(:) , & ! rainfall rate (kg/m^2 s) + fsnow(:) ! snowfall rate (kg/m^2 s) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + sss(:) , & ! sea surface salinity (ppt) + sst(:) , & ! sea surface temperature (C) + sstdat(:) , & ! sea surface temperature (C) saved for restoring + frzmlt(:) , & ! freezing/melting potential (W/m^2) + frzmlt_init(:), & ! frzmlt used in current time step (W/m^2) + Tf(:) , & ! freezing temperature (C) + qdp(:) , & ! deep ocean heat flux (W/m^2), negative upward + hmix(:) ! mixed layer depth (m) + + ! out to atmosphere (if calc_Tsfc) + ! note Tsfc is in ice_state.F + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + fsens(:) , & ! sensible heat flux (W/m^2) + flat(:) , & ! latent heat flux (W/m^2) + fswabs(:) , & ! shortwave flux absorbed in ice and ocean (W/m^2) + fswint_ai(:),& ! SW absorbed in ice interior below surface (W/m^2) + flwout(:) , & ! outgoing longwave radiation (W/m^2) + Tref(:) , & ! 2m atm reference temperature (K) + Qref(:) , & ! 2m atm reference spec humidity (kg/kg) + Uref(:) , & ! 10m atm reference wind speed (m/s) + evap(:) , & ! evaporative water flux (kg/m^2/s) + evaps(:) , & ! evaporative water flux over snow (kg/m^2/s) + evapi(:) ! evaporative water flux over ice (kg/m^2/s) + + ! albedos aggregated over categories (if calc_Tsfc) + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + alvdr(:) , & ! visible, direct (fraction) + alidr(:) , & ! near-ir, direct (fraction) + alvdf(:) , & ! visible, diffuse (fraction) + alidf(:) , & ! near-ir, diffuse (fraction) + ! grid-box-mean versions + alvdr_ai(:), & ! visible, direct (fraction) + alidr_ai(:), & ! near-ir, direct (fraction) + alvdf_ai(:), & ! visible, diffuse (fraction) + alidf_ai(:), & ! near-ir, diffuse (fraction) + ! components for history + albice(:) , & ! bare ice albedo + albsno(:) , & ! snow albedo + albpnd(:) , & ! melt pond albedo + apeff_ai(:) , & ! effective pond area used for radiation calculation + snowfrac(:) , & ! snow fraction used in radiation + ! components for diagnostic + alvdr_init(:), & ! visible, direct (fraction) + alidr_init(:), & ! near-ir, direct (fraction) + alvdf_init(:), & ! visible, diffuse (fraction) + alidf_init(:) ! near-ir, diffuse (fraction) + + ! out to ocean + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + fpond(:) , & ! fresh water flux to ponds (kg/m^2/s) + fresh(:) , & ! fresh water flux to ocean (kg/m^2/s) + fsalt(:) , & ! salt flux to ocean (kg/m^2/s) + fhocn(:) , & ! net heat flux to ocean (W/m^2) + fswthru(:) ! shortwave penetrating to ocean (W/m^2) + + ! internal + + real (kind=dbl_kind), & + allocatable, public :: & ! DIM nx + fswfac(:) , & ! for history + scale_factor(:)! scaling factor for shortwave components + + logical (kind=log_kind), public :: & + update_ocn_f, & ! if true, update fresh water and salt fluxes + l_mpond_fresh ! if true, include freshwater feedback from meltponds + ! when running in ice-ocean or coupled configuration + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,ncat + meltsn(:,:) , & ! snow melt in category n (m) + melttn(:,:) , & ! top melt in category n (m) + meltbn(:,:) , & ! bottom melt in category n (m) + congeln(:,:) , & ! congelation ice formation in category n (m) + snoicen(:,:) ! snow-ice formation in category n (m) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,ncat + keffn_top(:,:) ! effective thermal conductivity of the top ice layer + ! on categories (W/m^2/K) + + ! quantities passed from ocean mixed layer to atmosphere + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + strairx_ocn(:) , & ! stress on ocean by air, x-direction + strairy_ocn(:) , & ! stress on ocean by air, y-direction + fsens_ocn(:) , & ! sensible heat flux (W/m^2) + flat_ocn(:) , & ! latent heat flux (W/m^2) + flwout_ocn(:) , & ! outgoing longwave radiation (W/m^2) + evap_ocn(:) , & ! evaporative water flux (kg/m^2/s) + alvdr_ocn(:) , & ! visible, direct (fraction) + alidr_ocn(:) , & ! near-ir, direct (fraction) + alvdf_ocn(:) , & ! visible, diffuse (fraction) + alidf_ocn(:) , & ! near-ir, diffuse (fraction) + Tref_ocn(:) , & ! 2m atm reference temperature (K) + Qref_ocn(:) ! 2m atm reference spec humidity (kg/kg) + + ! diagnostic + + real (kind=dbl_kind), allocatable, save :: & !DIM nx + fsurf(:) , & ! net surface heat flux (excluding fcondtop)(W/m^2) + fcondtop(:),&! top surface conductive flux (W/m^2) + fcondbot(:),&! bottom surface conductive flux (W/m^2) + fbot(:), & ! heat flux at bottom surface of ice (excluding excess) (W/m^2) + Tbot(:), & ! Temperature at bottom surface of ice (deg C) + Tsnice(:), & ! Temperature at snow ice interface (deg C) + congel(:), & ! basal ice growth (m/step-->cm/day) + frazil(:), & ! frazil ice growth (m/step-->cm/day) + snoice(:), & ! snow-ice formation (m/step-->cm/day) + meltt(:) , & ! top ice melt (m/step-->cm/day) + melts(:) , & ! snow melt (m/step-->cm/day) + meltb(:) , & ! basal ice melt (m/step-->cm/day) + meltl(:) , & ! lateral ice melt (m/step-->cm/day) + dsnow(:), & ! change in snow thickness (m/step-->cm/day) + daidtt(:), & ! ice area tendency thermo. (s^-1) + dvidtt(:), & ! ice volume tendency thermo. (m/s) + dagedtt(:),& ! ice age tendency thermo. (s/s) + mlt_onset(:), &! day of year that sfc melting begins + 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), allocatable, save :: & ! DIM nx,ncat + fsurfn(:,:), & ! category fsurf + fcondtopn(:,:),& ! category fcondtop + fcondbotn(:,:),& ! category fcondbot + fsensn(:,:), & ! category sensible heat flux + flatn(:,:) ! category latent heat flux + + ! As above but these remain grid box mean values i.e. they are not + ! divided by aice at end of ice_dynamics. + ! These are used for generating + ! ice diagnostics as these are more accurate. + ! (The others suffer from problem of incorrect values at grid boxes + ! that change from an ice free state to an icy state.) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + fresh_ai(:), & ! fresh water flux to ocean (kg/m^2/s) + fsalt_ai(:), & ! salt flux to ocean (kg/m^2/s) + fhocn_ai(:), & ! net heat flux to ocean (W/m^2) + fswthru_ai(:) ! shortwave penetrating to ocean (W/m^2) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + rside(:) , & ! fraction of ice that melts laterally + cos_zen(:) , & ! cosine solar zenith angle, < 0 for sun below horizon + rdg_conv(:), & ! convergence term for ridging (1/s) + rdg_shear(:) ! shear term for ridging (1/s) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,nilyr+1 + salinz(:,:) , & ! initial salinity profile (ppt) + Tmltz(:,:) ! initial melting temperature (C) + + !======================================================================= + ! 4. Flux variables for biogeochemistry + !======================================================================= + + ! in from atmosphere + + real (kind=dbl_kind), & !coupling variable for both tr_aero and tr_zaero + allocatable, save :: & ! DIM nx,icepack_max_aero + faero_atm(:,:) ! aerosol deposition rate (kg/m^2 s) + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,icepack_max_nbtrcr + flux_bio_atm(:,:) ! all bio fluxes to ice from atmosphere + + ! in from ocean + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,icepack_max_aero + faero_ocn(:,:) ! aerosol flux to ocean (kg/m^2/s) + + ! out to ocean + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,icepack_max_nbtrcr + flux_bio(:,:) , & ! all bio fluxes to ocean + flux_bio_ai(:,:) ! all bio fluxes to ocean, averaged over grid cell + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + fzsal_ai(:), & ! salt flux to ocean from zsalinity (kg/m^2/s) + fzsal_g_ai(:) ! gravity drainage salt flux to ocean (kg/m^2/s) + + ! internal + + logical (kind=log_kind), save :: & + cpl_bgc ! switch to couple BGC via drivers + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,ncat + hin_old(:,:) , & ! old ice thickness + dsnown(:,:) ! change in snow thickness in category n (m) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + nit(:) , & ! ocean nitrate (mmol/m^3) + amm(:) , & ! ammonia/um (mmol/m^3) + sil(:) , & ! silicate (mmol/m^3) + dmsp(:) , & ! dmsp (mmol/m^3) + dms(:) , & ! dms (mmol/m^3) + hum(:) , & ! humic material carbon (mmol/m^3) + fnit(:) , & ! ice-ocean nitrate flux (mmol/m^2/s), positive to ocean + famm(:) , & ! ice-ocean ammonia/um flux (mmol/m^2/s), positive to ocean + fsil(:) , & ! ice-ocean silicate flux (mmol/m^2/s), positive to ocean + fdmsp(:) , & ! ice-ocean dmsp (mmol/m^2/s), positive to ocean + fdms(:) , & ! ice-ocean dms (mmol/m^2/s), positive to ocean + fhum(:) , & ! ice-ocean humic material carbon (mmol/m^2/s), positive to ocean + fdust(:) ! ice-ocean dust flux (kg/m^2/s), positive to ocean + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,icepack_max_algae + algalN(:,:) , & ! ocean algal nitrogen (mmol/m^3) (diatoms, pico, phaeo) + falgalN(:,:) ! ice-ocean algal nitrogen flux (mmol/m^2/s) (diatoms, pico, phaeo) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,icepack_max_doc + doc(:,:) , & ! ocean doc (mmol/m^3) (saccharids, lipids, tbd ) + fdoc(:,:) ! ice-ocean doc flux (mmol/m^2/s) (saccharids, lipids, tbd) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,icepack_max_don + don(:,:) , & ! ocean don (mmol/m^3) (proteins and amino acids) + fdon(:,:) ! ice-ocean don flux (mmol/m^2/s) (proteins and amino acids) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,icepack_max_dic + dic(:,:) , & ! ocean dic (mmol/m^3) + fdic(:,:) ! ice-ocean dic flux (mmol/m^2/s) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,icepack_max_fe + fed(:,:), fep(:,:) , & ! ocean dissolved and particulate fe (nM) + ffed(:,:), ffep(:,:) ! ice-ocean dissolved and particulate fe flux (umol/m^2/s) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,icepack_max_aero + zaeros(:,:) ! ocean aerosols (mmol/m^3) + + !======================================================================= + ! 5. Column variables + !======================================================================= + + ! icepack_itd.F90 + real (kind=dbl_kind), save, allocatable :: & ! DIM 0:ncat ? + hin_max(:) ! category limits (m) + + character (len=35), save, allocatable :: c_hi_range(:) ! DIM ncat + + ! icepack_meltpond_lvl.F90 + real (kind=dbl_kind), save, & ! DIM nx,ncat + allocatable :: & + dhsn(:,:) , & ! depth difference for snow on sea ice and pond ice + ffracn(:,:) ! fraction of fsurfn used to melt ipond + + ! icepack_shortwave.F90 + ! category albedos + real (kind=dbl_kind), save, & ! DIM nx,ncat + allocatable :: & + alvdrn(:,:) , & ! visible direct albedo (fraction) + alidrn(:,:) , & ! near-ir direct albedo (fraction) + alvdfn(:,:) , & ! visible diffuse albedo (fraction) + alidfn(:,:) ! near-ir diffuse albedo (fraction) + + ! albedo components for history + real (kind=dbl_kind), save, & ! DIM nx,ncat + allocatable :: & + albicen(:,:) , & ! bare ice + albsnon(:,:) , & ! snow + albpndn(:,:) , & ! pond + apeffn(:,:) ! effective pond area used for radiation calculation + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,ncat + snowfracn(:,:) ! Category snow fraction used in radiation + + ! shortwave components + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,nilyr,ncat + Iswabsn(:,:,:) ! SW radiation absorbed in ice layers (W m-2) + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,nslyr,ncat + Sswabsn(:,:,:) ! SW radiation absorbed in snow layers (W m-2) + + real (kind=dbl_kind), allocatable, & ! DIM nx,ncat + save :: & + fswsfcn(:,:) , & ! SW absorbed at ice/snow surface (W m-2) + fswthrun(:,:) , & ! SW through ice to ocean (W/m^2) + fswintn(:,:) ! SW absorbed in ice interior, below surface (W m-2) + + real (kind=dbl_kind), allocatable, & ! DIM nx,nilyr+1,ncat + save :: & + fswpenln(:,:,:) ! visible SW entering ice layers (W m-2) + + ! aerosol optical properties -> band | + ! v aerosol + ! for combined dust category, use category 4 properties + real (kind=dbl_kind), allocatable, save :: & ! DIM icepack_nspint,icepack_max_aero + kaer_tab(:,:) , & ! aerosol mass extinction cross section (m2/kg) + waer_tab(:,:) , & ! aerosol single scatter albedo (fraction) + gaer_tab(:,:) ! aerosol asymmetry parameter (cos(theta)) + + real (kind=dbl_kind), allocatable, save :: & ! DIM icepack_nspint,icepack_nmodal1 + kaer_bc_tab(:,:), & ! BC mass extinction cross section (m2/kg) + waer_bc_tab(:,:), & ! BC single scatter albedo (fraction) + gaer_bc_tab(:,:) ! BC aerosol asymmetry parameter (cos(theta)) + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM icepack_nspint,icepack_nmodal1,icepack_nmodal2 + bcenh(:,:,:) ! BC absorption enhancement factor + + ! biogeochemistry components + + real (kind=dbl_kind), allocatable, save :: & ! DIM nblyr+2 + bgrid(:) ! biology nondimensional vertical grid points + + real (kind=dbl_kind), allocatable, save :: & ! DIM nblyr+1 + igrid(:) ! biology vertical interface points + + real (kind=dbl_kind), allocatable, save :: & ! DIM nilyr+1 + cgrid(:) , & ! CICE vertical coordinate + icgrid(:) , & ! interface grid for CICE (shortwave variable) + swgrid(:) ! grid for ice tracers used in dEdd scheme + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,ncat + first_ice_real(:,:) ! .true. = c1, .false. = c0 + + logical (kind=log_kind), & + allocatable, save :: & ! DIM nx,ncat + first_ice(:,:) ! distinguishes ice that disappears (e.g. melts) + ! and reappears (e.g. transport) in a grid cell + ! during a single time step from ice that was + ! there the entire time step (true until ice forms) + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,icepack_max_nbtrcr + ocean_bio(:,:) ! contains all the ocean bgc tracer concentrations + + ! diagnostic fluxes + real (kind=dbl_kind), & + allocatable, save :: & !DIM nx,icepack_max_nbtrcr + fbio_snoice(:,:), & ! fluxes from snow to ice + fbio_atmice(:,:) ! fluxes from atm to ice + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,icepack_max_nbtrcr + ocean_bio_all(:,:) ! fixed order, all values even for tracers false + ! N(1:max_algae) = 1:max_algae + ! Nit = max_algae + 1 + ! DOC(1:max_doc) = max_algae + 2 : max_algae + + ! max_doc + 1 + ! DIC(1:max_dic) = max_algae + max_doc + 2 : + ! max_algae + max_doc + 1 + max_dic + ! chl(1:max_algae) = max_algae + max_doc + 2 + + ! max_dic : + ! 2*max_algae + max_doc + 1 + + ! max_dic + ! Am = 2*max_algae + max_doc + 2 + max_dic + ! Sil= 2*max_algae + max_doc + 3 + max_dic + ! DMSPp= 2*max_algae + max_doc + 4 + max_dic + ! DMSPd= 2*max_algae + max_doc + 5 + max_dic + ! DMS = 2*max_algae + max_doc + 6 + max_dic + ! PON = 2*max_algae + max_doc + 7 + max_dic + ! DON(1:max_don) = 2*max_algae + max_doc + 8 + + ! max_dic : + ! 2*max_algae + max_doc + 7 + + ! max_dic + max_don + ! Fed(1:max_fe) = 2*max_algae + max_doc + 8 + + ! max_dic + max_don : + ! 2*max_algae + max_doc + 7 + + ! max_dic + max_don + max_fe + ! Fep(1:max_fe) = 2*max_algae + max_doc + 8 + + ! max_dic + max_don + max_fe : + ! 2*max_algae + max_doc + 7 + + ! max_dic + max_don + 2*max_fe + ! zaero(1:max_aero) = 2*max_algae + max_doc + 8 + + ! max_dic + max_don + 2*max_fe : + ! 2*max_algae + max_doc + 7 + + ! max_dic + max_don + 2*max_fe + ! + max_aero + ! humic = 2*max_algae + max_doc + 8 + max_dic + + ! max_don + 2*max_fe + max_aero + + integer (kind=int_kind), allocatable, save :: & ! DIM nx,icepack_max_algae + algal_peak(:,:) ! vertical location of algal maximum, 0 if no maximum + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,nblyr+1,ncat + Zoo(:,:,:) ! N losses accumulated in timestep (ie. zooplankton/bacteria) + ! (mmol/m^3) + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,ncat + dhbr_top(:,:) , & ! brine top change + dhbr_bot(:,:) ! brine bottom change + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx + grow_net(:) , & ! Specific growth rate (/s) per grid cell + PP_net(:) , & ! Total production (mg C/m^2/s) per grid cell + hbri(:) ! brine height, area-averaged for comparison with hi(m) + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,nblyr+2,ncat + bphi(:,:,:) , & ! porosity of layers + bTiz(:,:,:) ! layer temperatures interpolated on bio grid (C) + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,ncat + darcy_V(:,:) ! darcy velocity positive up (m/s) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + zsal_tot(:) , & ! Total ice salinity in per grid cell (g/m^2) + chl_net(:) , & ! Total chla (mg chla/m^2) per grid cell + NO_net(:) ! Total nitrate per grid cell + + logical (kind=log_kind), allocatable, save :: & ! DIM nx + Rayleigh_criteria(:) ! .true. means Ra_c was reached + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + Rayleigh_real(:) ! .true. = c1, .false. = c0 + + real (kind=dbl_kind), & + allocatable, public :: & ! DIM nx,ncat + sice_rho(:,:) ! avg sea ice density (kg/m^3) ! ech: diagnostic only? + + real (kind=dbl_kind), & + allocatable, public :: & ! DIM nx,ncat + fzsaln(:,:) , & ! category fzsal(kg/m^2/s) + fzsaln_g(:,:) ! salt flux from gravity drainage only + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + fzsal(:) , & ! Total flux of salt to ocean at time step for conservation + fzsal_g(:) ! Total gravity drainage flux + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,nblyr+1,ncat + zfswin(:,:,:) ! Shortwave flux into layers interpolated on bio grid (W/m^2) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,nblyr+1,ncat + iDi(:,:,:) , & ! igrid Diffusivity (m^2/s) + iki(:,:,:) ! Ice permeability (m^2) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + upNO(:) , & ! nitrate uptake rate (mmol/m^2/d) times aice + upNH(:) ! ammonium uptake rate (mmol/m^2/d) times aice + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,max_ntrcr,ncat + trcrn_sw(:,:,:) ! bgc tracers active in the delta-Eddington shortwave + ! calculation on the shortwave grid (swgrid) + + real (kind=dbl_kind), & + allocatable, save :: & ! DIM nx,icepack_max_nbtrcr + ice_bio_net(:,:), & ! depth integrated tracer (mmol/m^2) + snow_bio_net(:,:) ! depth integrated snow tracer (mmol/m^2) + + ! floe size distribution + real(kind=dbl_kind), allocatable, save :: & ! DIM nfsd + 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) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + wave_sig_ht(:) ! significant height of waves (m) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nfreq + wavefreq(:), & ! wave frequencies + dwavefreq(:) ! wave frequency bin widths + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,nfreq + wave_spectrum(:,:) ! wave spectrum + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx,nfsd + ! change in floe size distribution due to processes + d_afsd_newi(:,:), d_afsd_latg(:,:), d_afsd_latm(:,:), d_afsd_wave(:,:), d_afsd_weld(:,:) + + character (len=35), allocatable, save :: & ! DIM nfsd + c_fsd_range(:) ! fsd floe_rad bounds (m) + + !======================================================================= + ! 6. Grid variables + !======================================================================= + + logical (kind=log_kind), allocatable, save :: & ! DIM + lmask_n(:), & ! northern hemisphere mask + lmask_s(:) ! northern hemisphere mask + + !======================================================================= + ! 7. Clock variables + !======================================================================= + + ! The following variables should be sufficient to run icepack in fesom 2 + ! Restart and output will be handeled by fesom + + integer (kind=int_kind), save :: & + days_per_year , & ! number of days in one year + daymo(12) , & ! number of days in each month + daycal(13) , & ! day number at end of month + daycal365(13) , & + daycal366(13) + + data daycal365 /0,31,59,90,120,151,181,212,243,273,304,334,365/ + data daycal366 /0,31,60,91,121,152,182,213,244,274,305,335,366/ + + integer (kind=int_kind), save :: & + istep1 , & ! counter, number of steps at current timestep + mday , & ! day of the month + month_i , & ! month number, 1 to 12 + nyr , & ! year number + sec ! elapsed seconds into date + + real (kind=dbl_kind), save :: & + time , & ! total elapsed time (s) + yday , & ! day of the year + dayyr , & ! number of days per year + nextsw_cday , & ! julian day of next shortwave calculation + secday , & ! seconds per day + dt_dyn ! dynamics/transport/ridging timestep (s) + + character (len=char_len), save :: & + calendar_type ! differentiates Gregorian from other calendars + ! default = ' ' + + !======================================================================= +!--------- Define the interface for submodules + !======================================================================= + + interface + + ! Read icepack namelists, setup the model parameter and write diagnostics + module subroutine set_icepack() + implicit none + end subroutine set_icepack + + ! Set up hemispheric masks + module subroutine set_grid_icepack(mesh) + use mod_mesh + implicit none + type(t_mesh), intent(in), target :: mesh + end subroutine set_grid_icepack + + ! Allocate variables + module subroutine allocate_icepack + implicit none + end subroutine allocate_icepack + + end interface + + end module icedrv_main diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 590ffd534..8d80d9d93 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -6,11 +6,8 @@ ! !======================================================================= - module icedrv_set + submodule (icedrv_main) icedrv_set - use icedrv_kinds - use icedrv_constants, only: nu_diag, ice_stdout, nu_diag_out, nu_nml - use icedrv_constants, only: c0, c1, c2, c3, p2, p5 use icepack_intfc, only: icepack_init_parameters use icepack_intfc, only: icepack_init_fsd use icepack_intfc, only: icepack_init_tracer_flags @@ -24,16 +21,10 @@ module icedrv_set use icepack_intfc, only: icepack_warnings_flush use icepack_intfc, only: icepack_warnings_aborted use icedrv_system, only: icedrv_system_abort - - implicit none - - public set_icepack, set_grid_icepack - - private contains - subroutine set_icepack + module subroutine set_icepack() use icedrv_domain_size use g_parsup, only: mype, myDim_nod2D, eDim_nod2D @@ -827,7 +818,7 @@ end subroutine set_icepack !======================================================================= - subroutine set_grid_icepack(mesh) + module subroutine set_grid_icepack(mesh) use mod_mesh use icedrv_domain_size, only: nx @@ -869,7 +860,7 @@ end subroutine set_grid_icepack !======================================================================= - end module icedrv_set + end submodule icedrv_set diff --git a/src/icepack_drivers/icedrv_state.F90 b/src/icepack_drivers/icedrv_state.F90 deleted file mode 100644 index 8711c29f0..000000000 --- a/src/icepack_drivers/icedrv_state.F90 +++ /dev/null @@ -1,124 +0,0 @@ -!======================================================================= -! -! Primary state variables in various configurations -! Note: other state variables are at the end of this... -! The primary state variable names are: -!------------------------------------------------------------------- -! for each category aggregated over units -! categories -!------------------------------------------------------------------- -! aicen(i,n) aice(i) --- -! vicen(i,n) vice(i) m -! vsnon(i,n) vsno(i) m -! trcrn(i,it,n) trcr(i,it) -! -! Area is dimensionless because aice is the fractional area -! (normalized so that the sum over all categories, including open -! water, is 1.0). That is why vice/vsno have units of m instead of m^3. -! -! Variable names follow these rules: -! -! (1) For 3D variables (indices i,n), write 'ice' or 'sno' or -! 'sfc' and put an 'n' at the end. -! (2) For 2D variables (indices i) aggregated over all categories, -! write 'ice' or 'sno' or 'sfc' without the 'n'. -! (3) For 2D variables (indices i) associated with an individual -! category, write 'i' or 's' instead of 'ice' or 'sno' and put an 'n' -! at the end: e.g. hin, hsn. These are not declared here -! but in individual modules (e.g., ice_therm_vertical). -! -! authors C. M. Bitz, UW -! Elizabeth C. Hunke and William H. Lipscomb, LANL - - module icedrv_state - - use icedrv_kinds - use icedrv_domain_size, only: nx, ncat, max_ntrcr - - implicit none - private - - !----------------------------------------------------------------- - ! state of the ice aggregated over all categories - !----------------------------------------------------------------- - - real (kind=dbl_kind), dimension(nx), & - public :: & - aice , & ! concentration of ice - vice , & ! volume per unit area of ice (m) - vsno ! volume per unit area of snow (m) - - real (kind=dbl_kind), & - dimension(nx,max_ntrcr), public :: & - trcr ! ice tracers - ! 1: surface temperature of ice/snow (C) - - !----------------------------------------------------------------- - ! state of the ice for each category - !----------------------------------------------------------------- - - real (kind=dbl_kind), dimension (nx), & - public:: & - aice0 ! concentration of open water - - real (kind=dbl_kind), & - dimension (nx,ncat), 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 (nx,max_ntrcr,ncat) :: & - trcrn ! tracers - ! 1: surface temperature of ice/snow (C) - - !----------------------------------------------------------------- - ! tracer infrastructure arrays - !----------------------------------------------------------------- - - integer (kind=int_kind), dimension (max_ntrcr), public :: & - trcr_depend ! = 0 for ice area tracers - ! = 1 for ice volume tracers - ! = 2 for snow volume tracers - - integer (kind=int_kind), dimension (max_ntrcr), public :: & - n_trcr_strata ! number of underlying tracer layers - - integer (kind=int_kind), dimension (max_ntrcr,2), public :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension (max_ntrcr,3), public :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - !----------------------------------------------------------------- - ! dynamic variables closely related to the state of the ice - !----------------------------------------------------------------- - - real (kind=dbl_kind), dimension(nx), & - public :: & - uvel , & ! x-component of velocity (m/s) - vvel , & ! y-component of velocity (m/s) - divu , & ! strain rate I component, velocity divergence (1/s) - shear , & ! strain rate II component (1/s) - strength ! ice strength (N/m) - - !----------------------------------------------------------------- - ! ice state at start of time step, saved for later in the step - !----------------------------------------------------------------- - - real (kind=dbl_kind), dimension(nx), & - public :: & - aice_init ! initial concentration of ice, for diagnostics - - real (kind=dbl_kind), & - dimension(nx,ncat), 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 - -!======================================================================= - - end module icedrv_state - -!======================================================================= From 2c074862921b93530ffa8427203bf4b06e6a8e20 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 20 May 2020 23:17:18 +0200 Subject: [PATCH 12/54] Allocated all the variables needed for running Icepack --- src/icepack_drivers/icedrv_allocate.F90 | 429 ++++++++++++++++++++++++ src/icepack_drivers/icedrv_main.F90 | 50 ++- src/icepack_drivers/icedrv_set.F90 | 18 +- src/icepack_drivers/icedrv_system.F90 | 11 +- 4 files changed, 489 insertions(+), 19 deletions(-) create mode 100644 src/icepack_drivers/icedrv_allocate.F90 diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 new file mode 100644 index 000000000..cf2bcf1f4 --- /dev/null +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -0,0 +1,429 @@ +! ------------------------------------------------------------- +! Submodule to allocate all the icepack variables +! +! +! Author: Lorenzo Zampieri ( lorenzo.zampieri@awi.de ) +! ------------------------------------------------------------- + + submodule (icedrv_main) allocate_icepack + + use icepack_intfc, only: icepack_max_nbtrcr, icepack_max_algae, icepack_max_aero + use icepack_intfc, only: icepack_nmodal1, icepack_nmodal2 + use icepack_intfc, only: icepack_nspint + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_max_aero, icepack_max_nbtrcr, & + icepack_max_algae, icepack_max_doc, icepack_max_don, icepack_max_dic, icepack_max_fe, & + icepack_query_tracer_indices, icepack_query_tracer_flags, icepack_query_parameters, & + icepack_query_tracer_sizes + use icedrv_system, only: icedrv_system_abort + + contains + + module subroutine alloc_state + + implicit none + + integer (int_kind) :: ntrcr, ierr + character(len=*), parameter :: subname='(alloc_state)' + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) & + call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + allocate ( & + lmask_n(nx) , & ! N. Hemis mask + lmask_s(nx) , & ! S. Hemis mask + stat=ierr) + + if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + allocate ( & + aice (nx) , & ! concentration of ice + vice (nx) , & ! volume per unit area of ice (m) + vsno (nx) , & ! volume per unit area of snow (m) + aice0 (nx) , & ! concentration of open water + uvel (nx) , & ! x-component of velocity (m/s) + vvel (nx) , & ! y-component of velocity (m/s) + divu (nx) , & ! strain rate I component, velocity divergence (1/s) + shear (nx) , & ! strain rate II component (1/s) + strength (nx) , & ! ice strength (N/m) + aice_init (nx) , & ! initial concentration of ice, for diagnostics + aicen (nx,ncat) , & ! concentration of ice + vicen (nx,ncat) , & ! volume per unit area of ice (m) + vsnon (nx,ncat) , & ! volume per unit area of snow (m) + aicen_init(nx,ncat) , & ! initial ice concentration, for linear ITD + vicen_init(nx,ncat) , & ! initial ice volume (m), for linear ITD + vsnon_init(nx,ncat) , & ! initial snow volume (m), for aerosol + trcr (nx,ntrcr) , & ! ice tracers: 1: surface temperature of ice/snow (C) + trcrn (nx,ntrcr,ncat) , & ! tracers: 1: surface temperature of ice/snow (C) + stat=ierr) + + if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + allocate ( & + trcr_depend(ntrcr) , & ! + n_trcr_strata(ntrcr) , & ! number of underlying tracer layers + nt_strata(ntrcr,2) , & ! indices of underlying tracer layers + trcr_base(ntrcr,3) , & ! = 0 or 1 depending on tracer dependency, (1) aice, (2) vice, (3) vsno + stat=ierr) + + if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + trcr_depend = 0 + n_trcr_strata = 0 + nt_strata = 0 + trcr_base = 0 + + end subroutine alloc_state + + ! --------------------------------------------------------------- + ! Subroutine to allocate the arrays declared in ice icedrv_flux + ! --------------------------------------------------------------- + ! Lorenzo Zampieri 02/2019 + ! --------------------------------------------------------------- + + module subroutine alloc_flux + + implicit none + + integer (int_kind) :: ierr + character(len=*), parameter :: subname='(alloc_flux)' + + allocate( & + strax(nx) , & ! wind stress components (N/m^2) + stray(nx) , & ! + uocn(nx) , & ! ocean current, x-direction (m/s) + vocn(nx) , & ! ocean current, y-direction (m/s) + strairxT(nx), & ! stress on ice by air, x-direction + strairyT(nx), & ! stress on ice by air, y-direction + strocnxT(nx), & ! ice-ocean stress, x-direction + strocnyT(nx), & ! ice-ocean stress, y-direction + strairx(nx) , & ! stress on ice by air, x-direction + strairy(nx) , & ! stress on ice by air, y-direction + daidtd(nx) , & ! ice area tendency due to transport (1/s) + dvidtd(nx) , & ! ice volume tendency due to transport (m/s) + dagedtd(nx) , & ! ice age tendency due to transport (s/s) + dardg1dt(nx), & ! rate of area loss by ridging ice (1/s) + dardg2dt(nx), & ! rate of area gain by new ridges (1/s) + dvirdgdt(nx), & ! rate of ice volume ridged (m/s) + closing(nx) , & ! rate of closing due to divergence/shear (1/s) + opening(nx) , & ! rate of opening due to divergence/shear (1/s) + dardg1ndt(nx,ncat), & ! rate of area loss by ridging ice (1/s) + dardg2ndt(nx,ncat), & ! rate of area gain by new ridges (1/s) + dvirdgndt(nx,ncat), & ! rate of ice volume ridged (m/s) + aparticn(nx,ncat), & ! participation function + krdgn(nx,ncat), & ! mean ridge thickness/thickness of ridging ice + ardgn(nx,ncat), & ! fractional area of ridged ice + vrdgn(nx,ncat), & ! volume of ridged ice + araftn(nx,ncat), & ! rafting ice area + vraftn(nx,ncat), & ! rafting ice volume + aredistn(nx,ncat), & ! redistribution function: fraction of new ridge area + vredistn(nx,ncat), & ! redistribution function: fraction of new ridge volume + zlvl(nx) , & ! atm level height (m) + uatm(nx) , & ! wind velocity components (m/s) + vatm(nx) , & + wind(nx) , & ! wind speed (m/s) + potT(nx) , & ! air potential temperature (K) + T_air(nx) , & ! air temperature (K) + Qa(nx) , & ! specific humidity (kg/kg) + rhoa(nx) , & ! air density (kg/m^3) + swvdr(nx) , & ! sw down, visible, direct (W/m^2) + swvdf(nx) , & ! sw down, visible, diffuse (W/m^2) + swidr(nx) , & ! sw down, near IR, direct (W/m^2) + swidf(nx) , & ! sw down, near IR, diffuse (W/m^2) + flw(nx) , & ! incoming longwave radiation (W/m^2) + fsurfn_f(nx,ncat) , & ! net flux to top surface, excluding fcondtop + fcondtopn_f(nx,ncat), & ! downward cond flux at top surface (W m-2) + fsensn_f(nx,ncat) , & ! sensible heat flux (W m-2) + flatn_f(nx,ncat) , & ! latent heat flux (W m-2) + frain(nx) , & ! rainfall rate (kg/m^2 s) + fsnow(nx) , & ! snowfall rate (kg/m^2 s) + sss(nx) , & ! sea surface salinity (ppt) + sst(nx) , & ! sea surface temperature (C) + sstdat(nx) , & ! sea surface temperature (C) saved for restoring + frzmlt(nx) , & ! freezing/melting potential (W/m^2) + frzmlt_init(nx), & ! frzmlt used in current time step (W/m^2) + Tf(nx) , & ! freezing temperature (C) + qdp(nx) , & ! deep ocean heat flux (W/m^2), negative upward + hmix(nx) , & ! mixed layer depth (m) + fsens(nx) , & ! sensible heat flux (W/m^2) + flat(nx) , & ! latent heat flux (W/m^2) + fswabs(nx) , & ! shortwave flux absorbed in ice and ocean (W/m^2) + fswint_ai(nx),& ! SW absorbed in ice interior below surface (W/m^2) + flwout(nx) , & ! outgoing longwave radiation (W/m^2) + Tref(nx) , & ! 2m atm reference temperature (K) + Qref(nx) , & ! 2m atm reference spec humidity (kg/kg) + Uref(nx) , & ! 10m atm reference wind speed (m/s) + evap(nx) , & ! evaporative water flux (kg/m^2/s) + evaps(nx) , & ! evaporative water flux over snow (kg/m^2/s) + evapi(nx) , & ! evaporative water flux over ice (kg/m^2/s) + alvdr(nx) , & ! visible, direct (fraction) + alidr(nx) , & ! near-ir, direct (fraction) + alvdf(nx) , & ! visible, diffuse (fraction) + alidf(nx) , & ! near-ir, diffuse (fraction) + alvdr_ai(nx), & ! visible, direct (fraction) + alidr_ai(nx), & ! near-ir, direct (fraction) + alvdf_ai(nx), & ! visible, diffuse (fraction) + alidf_ai(nx), & ! near-ir, diffuse (fraction) + albice(nx) , & ! bare ice albedo + albsno(nx) , & ! snow albedo + albpnd(nx) , & ! melt pond albedo + apeff_ai(nx) , & ! effective pond area used for radiation calculation + snowfrac(nx) , & ! snow fraction used in radiation + alvdr_init(nx), & ! visible, direct (fraction) + alidr_init(nx), & ! near-ir, direct (fraction) + alvdf_init(nx), & ! visible, diffuse (fraction) + alidf_init(nx), & ! near-ir, diffuse (fraction) + fpond(nx) , & ! fresh water flux to ponds (kg/m^2/s) + fresh(nx) , & ! fresh water flux to ocean (kg/m^2/s) + fsalt(nx) , & ! salt flux to ocean (kg/m^2/s) + fhocn(nx) , & ! net heat flux to ocean (W/m^2) + fswthru(nx) , & ! shortwave penetrating to ocean (W/m^2) + fswfac(nx) , & ! for history + scale_factor(nx), & ! scaling factor for shortwave components + meltsn(nx,ncat) , & ! snow melt in category n (m) + melttn(nx,ncat) , & ! top melt in category n (m) + meltbn(nx,ncat) , & ! bottom melt in category n (m) + congeln(nx,ncat), & ! congelation ice formation in category n (m) + snoicen(nx,ncat), & ! snow-ice formation in category n (m) + keffn_top(nx,ncat), & ! effective thermal conductivity of the top ice layer + ! on categories (W/m^2/K) + strairx_ocn(nx) , & ! stress on ocean by air, x-direction + strairy_ocn(nx) , & ! stress on ocean by air, y-direction + fsens_ocn(nx) , & ! sensible heat flux (W/m^2) + flat_ocn(nx) , & ! latent heat flux (W/m^2) + flwout_ocn(nx) , & ! outgoing longwave radiation (W/m^2) + evap_ocn(nx) , & ! evaporative water flux (kg/m^2/s) + alvdr_ocn(nx) , & ! visible, direct (fraction) + alidr_ocn(nx) , & ! near-ir, direct (fraction) + alvdf_ocn(nx) , & ! visible, diffuse (fraction) + alidf_ocn(nx) , & ! near-ir, diffuse (fraction) + Tref_ocn(nx) , & ! 2m atm reference temperature (K) + Qref_ocn(nx) , & ! 2m atm reference spec humidity (kg/kg) + fsurf(nx) , & ! net surface heat flux (excluding fcondtop)(W/m^2) + fcondtop(nx),&! top surface conductive flux (W/m^2) + fcondbot(nx),&! bottom surface conductive flux (W/m^2) + fbot(nx), & ! heat flux at bottom surface of ice (excluding excess) (W/m^2) + Tbot(nx), & ! Temperature at bottom surface of ice (deg C) + Tsnice(nx), & ! Temperature at snow ice interface (deg C) + congel(nx), & ! basal ice growth (m/step-->cm/day) + frazil(nx), & ! frazil ice growth (m/step-->cm/day) + snoice(nx), & ! snow-ice formation (m/step-->cm/day) + meltt(nx) , & ! top ice melt (m/step-->cm/day) + melts(nx) , & ! snow melt (m/step-->cm/day) + meltb(nx) , & ! basal ice melt (m/step-->cm/day) + meltl(nx) , & ! lateral ice melt (m/step-->cm/day) + dsnow(nx) , & ! change in snow thickness (m/step-->cm/day) + daidtt(nx), & ! ice area tendency thermo. (s^-1) + dvidtt(nx), & ! ice volume tendency thermo. (m/s) + dagedtt(nx),& ! ice age tendency thermo. (s/s) + mlt_onset(nx) , &! day of year that sfc melting begins + frz_onset(nx) , &! day of year that freezing begins (congel or frazil) + frazil_diag(nx) , & ! frazil ice growth diagnostic (m/step-->cm/day) + fsurfn(nx,ncat) , & ! category fsurf + fcondtopn(nx,ncat) , & ! category fcondtop + fcondbotn(nx,ncat) , & ! category fcondbot + fsensn(nx,ncat) , & ! category sensible heat flux + flatn(nx,ncat) , & ! category latent heat flux + fresh_ai(nx), & ! fresh water flux to ocean (kg/m^2/s) + fsalt_ai(nx), & ! salt flux to ocean (kg/m^2/s) + fhocn_ai(nx), & ! net heat flux to ocean (W/m^2) + fswthru_ai(nx), & ! shortwave penetrating to ocean (W/m^2) + rside(nx) , & ! fraction of ice that melts laterally + fsw(nx) , & ! incoming shortwave radiation (W/m^2) + cos_zen(nx) , & ! cosine solar zenith angle, < 0 for sun below horizon + rdg_conv(nx) , & ! convergence term for ridging (1/s) + rdg_shear(nx), & ! shear term for ridging (1/s) + salinz(nx,nilyr+1) , & ! initial salinity profile (ppt) + Tmltz(nx,nilyr+1) , & ! initial melting temperature (C) + stat=ierr) + + if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + end subroutine alloc_flux + + ! --------------------------------------------------------------- + ! Subroutine to allocate the arrays declared in ice icedrv_flux_bgc + ! --------------------------------------------------------------- + ! Lorenzo Zampieri 02/2019 + ! --------------------------------------------------------------- + + module subroutine alloc_flux_bgc + + implicit none + + integer (int_kind) :: ierr + character(len=*), parameter :: subname='(alloc_flux_bgc)' + + allocate( & + faero_atm(nx,icepack_max_aero) , & + flux_bio_atm(nx,icepack_max_nbtrcr) , & ! all bio fluxes to ice from atmosphere + faero_ocn(nx,icepack_max_aero) , & ! aerosol flux to ocean (kg/m^2/s) + flux_bio(nx,icepack_max_nbtrcr) , & ! all bio fluxes to ocean + flux_bio_ai(nx,icepack_max_nbtrcr) , & ! all bio fluxes to ocean, averaged over grid cell + fzsal_ai(nx) , & ! salt flux to ocean from zsalinity (kg/m^2/s) + fzsal_g_ai(nx) , & ! gravity drainage salt flux to ocean (kg/m^2/s) + hin_old(nx,ncat) , & ! old ice thickness + dsnown(nx,ncat) , & ! change in snow thickness in category n (m) + nit(nx) , & ! ocean nitrate (mmol/m^3) + amm(nx) , & ! ammonia/um (mmol/m^3) + sil(nx) , & ! silicate (mmol/m^3) + dmsp(nx) , & ! dmsp (mmol/m^3) + dms(nx) , & ! dms (mmol/m^3) + hum(nx) , & ! humic material carbon (mmol/m^3) + fnit(nx) , & ! ice-ocean nitrate flux (mmol/m^2/s), positive to ocean + famm(nx) , & ! ice-ocean ammonia/um flux (mmol/m^2/s), positive to ocean + fsil(nx) , & ! ice-ocean silicate flux (mmol/m^2/s), positive to ocean + fdmsp(nx) , & ! ice-ocean dmsp (mmol/m^2/s), positive to ocean + fdms(nx) , & ! ice-ocean dms (mmol/m^2/s), positive to ocean + fhum(nx) , & ! ice-ocean humic material carbon (mmol/m^2/s), positive to ocean + fdust(nx) , & ! ice-ocean dust flux (kg/m^2/s), positive to ocean + algalN(nx,icepack_max_algae) , & ! ocean algal nitrogen (mmol/m^3) (diatoms, pico, phaeo) + falgalN(nx,icepack_max_algae) , & ! ice-ocean algal nitrogen flux (mmol/m^2/s) (diatoms, pico, phaeo) + doc(nx,icepack_max_doc) , & ! ocean doc (mmol/m^3) (saccharids, lipids, tbd ) + fdoc(nx,icepack_max_doc) , & ! ice-ocean doc flux (mmol/m^2/s) (saccharids, lipids, tbd) + don(nx,icepack_max_don) , & ! ocean don (mmol/m^3) (proteins and amino acids) + fdon(nx,icepack_max_don) , & ! ice-ocean don flux (mmol/m^2/s) (proteins and amino acids) + dic(nx,icepack_max_dic) , & ! ocean dic (mmol/m^3) + fdic(nx,icepack_max_dic) , & ! ice-ocean dic flux (mmol/m^2/s) + fed(nx,icepack_max_fe), fep(nx,icepack_max_fe) , & ! ocean dissolved and particulate fe (nM) + ffed(nx,icepack_max_fe), ffep(nx,icepack_max_fe) , & ! ice-ocean dissolved and particulate fe flux (umol/m^2/s) + zaeros(nx,icepack_max_aero) , & ! ocean aerosols (mmol/m^3) + stat=ierr) + + if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + end subroutine alloc_flux_bgc + + module subroutine alloc_column + + implicit none + + integer (int_kind) :: max_nbtrcr, max_algae, max_aero, & + nmodal1, nmodal2, max_don + integer (int_kind) :: ierr + character(len=*), parameter :: subname='(alloc_column)' + + + call icepack_query_tracer_sizes( max_nbtrcr_out=max_nbtrcr, & + max_algae_out=max_algae, max_aero_out=max_aero, & + nmodal1_out=nmodal1, nmodal2_out=nmodal2, max_don_out=max_don) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) & + call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + allocate( & + Cdn_atm(nx) , & ! atm drag coefficient + Cdn_ocn(nx) , & ! ocn drag coefficient + ! form drag + hfreebd(nx), & ! freeboard (m) + hdraft(nx), & ! draft of ice + snow column (Stoessel1993) + hridge(nx), & ! ridge height + distrdg(nx), & ! distance between ridges + hkeel(nx), & ! keel depth + dkeel(nx), & ! distance between keels + lfloe(nx), & ! floe length + dfloe(nx), & ! distance between floes + Cdn_atm_skin(nx), & ! neutral skin drag coefficient + Cdn_atm_floe(nx), & ! neutral floe edge drag coefficient + Cdn_atm_pond(nx), & ! neutral pond edge drag coefficient + Cdn_atm_rdg(nx), & ! neutral ridge drag coefficient + Cdn_ocn_skin(nx), & ! skin drag coefficient + Cdn_ocn_floe(nx), & ! floe edge drag coefficient + Cdn_ocn_keel(nx), & ! keel drag coefficient + Cdn_atm_ratio(nx), & ! ratio drag atm / neutral drag atm + hin_max(0:ncat) , & ! category limits (m) + c_hi_range(ncat) , & ! + dhsn(nx,ncat) , & ! depth difference for snow on sea ice and pond ice + ffracn(nx,ncat) , & ! fraction of fsurfn used to melt ipond + alvdrn(nx,ncat) , & ! visible direct albedo (fraction) + alidrn(nx,ncat) , & ! near-ir direct albedo (fraction) + alvdfn(nx,ncat) , & ! visible diffuse albedo (fraction) + alidfn(nx,ncat) , & ! near-ir diffuse albedo (fraction) + albicen(nx,ncat) , & ! bare ice + albsnon(nx,ncat) , & ! snow + albpndn(nx,ncat) , & ! pond + apeffn(nx,ncat) , & ! effective pond area used for radiation calculation + snowfracn(nx,ncat) , & ! Category snow fraction used in radiation + Iswabsn(nx,nilyr,ncat) , & ! SW radiation absorbed in ice layers (W m-2) + Sswabsn(nx,nslyr,ncat) , & ! SW radiation absorbed in snow layers (W m-2) + fswsfcn(nx,ncat) , & ! SW absorbed at ice/snow surface (W m-2) + fswthrun(nx,ncat) , & ! SW through ice to ocean (W/m^2) + fswintn(nx,ncat) , & ! SW absorbed in ice interior, below surface (W m-2) + fswpenln(nx,nilyr+1,ncat) , & ! visible SW entering ice layers (W m-2) + kaer_tab(icepack_nspint,icepack_max_aero) , & ! aerosol mass extinction cross section (m2/kg) + waer_tab(icepack_nspint,icepack_max_aero) , & ! aerosol single scatter albedo (fraction) + gaer_tab(icepack_nspint,icepack_max_aero) , & ! aerosol asymmetry parameter (cos(theta)) + kaer_bc_tab(icepack_nspint,icepack_nmodal1) , & ! BC mass extinction cross section (m2/kg) + waer_bc_tab(icepack_nspint,icepack_nmodal1) , & ! BC single scatter albedo (fraction) + gaer_bc_tab(icepack_nspint,icepack_nmodal1) , & ! BC aerosol asymmetry parameter (cos(theta)) + bcenh(icepack_nspint,icepack_nmodal1,icepack_nmodal2) , & ! BC absorption enhancement factor + bgrid(nblyr+2) , & ! biology nondimensional vertical grid points + igrid(nblyr+1) , & ! biology vertical interface points + cgrid(nilyr+1) , & ! CICE vertical coordinate + icgrid(nilyr+1) , & ! interface grid for CICE (shortwave variable) + swgrid(nilyr+1) , & ! grid for ice tracers used in dEdd scheme + first_ice_real(nx,ncat) , & ! .true. = c1, .false. = c0 + first_ice(nx,ncat) , & ! distinguishes ice that disappears (e.g. melts) + ! and reappears (e.g. transport) in a grid cell + ! during a single time step from ice that was + ! there the entire time step (true until ice forms) + ocean_bio(nx,icepack_max_nbtrcr) , & ! contains all the ocean bgc tracer concentrations + fbio_snoice(nx,icepack_max_nbtrcr) , & ! fluxes from snow to ice + fbio_atmice(nx,icepack_max_nbtrcr) , & ! fluxes from atm to ice + ocean_bio_all(nx,icepack_max_nbtrcr) , & ! fixed order, all values even for tracers false + algal_peak(nx,icepack_max_algae) , & ! vertical location of algal maximum, 0 if no maximum + Zoo(nx,nblyr+1,ncat) , & ! N losses accumulated in timestep (ie. zooplankton/bacteria) + ! (mmol/m^3) + dhbr_top(nx,ncat) , & ! brine top change + dhbr_bot(nx,ncat) , & ! brine bottom change + grow_net(nx) , & ! Specific growth rate (/s) per grid cell + PP_net(nx) , & ! Total production (mg C/m^2/s) per grid cell + hbri(nx) , & ! brine height, area-averaged for comparison with hi (m) + bphi(nx,nblyr+2,ncat) , & ! porosity of layers + bTiz(nx,nblyr+2,ncat) , & ! layer temperatures interpolated on bio grid (C) + darcy_V(nx,ncat) , & ! darcy velocity positive up (m/s) + zsal_tot(nx) , & ! Total ice salinity in per grid cell (g/m^2) + chl_net(nx) , & ! Total chla (mg chla/m^2) per grid cell + NO_net(nx) , & ! Total nitrate per grid cell + Rayleigh_criteria(nx) , & ! .true. means Ra_c was reached + Rayleigh_real(nx) , & ! .true. = c1, .false. = c0 + sice_rho(nx,ncat) , & ! avg sea ice density (kg/m^3) ! ech: diagnostic only? + fzsaln(nx,ncat) , & ! category fzsal(kg/m^2/s) + fzsaln_g(nx,ncat) , & ! salt flux from gravity drainage only + fzsal(nx) , & ! Total flux of salt to ocean at time step for conservation + fzsal_g(nx) , & ! Total gravity drainage flux + zfswin(nx,nblyr+1,ncat) , & ! Shortwave flux into layers interpolated on bio grid (W/m^2) + iDi(nx,nblyr+1,ncat) , & ! igrid Diffusivity (m^2/s) + iki(nx,nblyr+1,ncat) , & ! Ice permeability (m^2) + upNO(nx) , & ! nitrate uptake rate (mmol/m^2/d) times aice + upNH(nx) , & ! ammonium uptake rate (mmol/m^2/d) times aice + trcrn_sw(nx,max_ntrcr,ncat) , & ! bgc tracers active in the delta-Eddington shortwave + ice_bio_net(nx,icepack_max_nbtrcr) , & ! depth integrated tracer (mmol/m^2) + snow_bio_net(nx,icepack_max_nbtrcr), & ! depth integrated snow tracer (mmol/m^2) + ! Floe size distribution + floe_rad_l(nfsd) , & ! fsd size lower bound in m (radius) + floe_rad_c(nfsd) , & ! fsd size bin centre in m (radius) + floe_binwidth(nfsd) , & ! fsd size bin width in m (radius) + wave_sig_ht(nx) , & ! significant height of waves (m) + wavefreq(nfreq) , & ! wave frequencies + dwavefreq(nfreq) , & ! wave frequency bin widths + wave_spectrum(nx,nfreq), & ! wave spectrum + d_afsd_newi(nx,nfsd) , & ! change in floe size distribution due toprocesses + d_afsd_latg(nx,nfsd) , & + d_afsd_latm(nx,nfsd) , & + d_afsd_wave(nx,nfsd) , & + d_afsd_weld(nx,nfsd) , & + c_fsd_range(nfsd) , & ! fsd floe_rad bounds (m) + stat=ierr) + + if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + end subroutine alloc_column + +! ------------------------------------------------------------------------------ + + end submodule allocate_icepack + +! ------------------------------------------------------------------------------ diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 8a9ea2aa0..3ed45fd1f 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -2,7 +2,7 @@ ! ! Module that contains the whole icepack implementation in fesom2 ! -! author Lorenzo Zampieri ( lorenzo.zampieri@awi.de ) +! Author: Lorenzo Zampieri ( lorenzo.zampieri@awi.de ) ! !======================================================================= @@ -14,10 +14,12 @@ module icedrv_main implicit none !======================================================================= -!--------- List here all the public variables to be seen outside icepack +!--------- List here all the public variables and +!--------- subroutines to be seen outside icepack !======================================================================= - public :: set_icepack, set_grid_icepack + public :: set_icepack, set_grid_icepack, alloc_state, alloc_flux, & + alloc_flux_bgc, alloc_column !======================================================================= !--------- Everything else is private @@ -415,6 +417,27 @@ module icedrv_main !======================================================================= ! 5. Column variables !======================================================================= + + real (kind=dbl_kind), save, allocatable :: & ! DIM nx + Cdn_atm(:) , & ! atm drag coefficient + Cdn_ocn(:) , & ! ocn drag coefficient + ! form drag + hfreebd(:), & ! freeboard (m) + hdraft(:), & ! draft of ice + snow column (Stoessel1993) + hridge(:), & ! ridge height + distrdg(:), & ! distance between ridges + hkeel(:), & ! keel depth + dkeel(:), & ! distance between keels + lfloe(:), & ! floe length + dfloe(:), & ! distance between floes + Cdn_atm_skin(:), & ! neutral skin drag coefficient + Cdn_atm_floe(:), & ! neutral floe edge drag coefficient + Cdn_atm_pond(:), & ! neutral pond edge drag coefficient + Cdn_atm_rdg(:), & ! neutral ridge drag coefficient + Cdn_ocn_skin(:), & ! skin drag coefficient + Cdn_ocn_floe(:), & ! floe edge drag coefficient + Cdn_ocn_keel(:), & ! keel drag coefficient + Cdn_atm_ratio(:) ! ratio drag atm / neutral drag atm ! icepack_itd.F90 real (kind=dbl_kind), save, allocatable :: & ! DIM 0:ncat ? @@ -713,10 +736,25 @@ module subroutine set_grid_icepack(mesh) type(t_mesh), intent(in), target :: mesh end subroutine set_grid_icepack - ! Allocate variables - module subroutine allocate_icepack + ! Allocate state and grid variables + module subroutine alloc_state() + implicit none + end subroutine alloc_state + + ! Allocate flux variables + module subroutine alloc_flux() + implicit none + end subroutine alloc_flux + + ! Allocate flux bgc variables + module subroutine alloc_flux_bgc() + implicit none + end subroutine alloc_flux_bgc + + ! Allocate column variables + module subroutine alloc_column() implicit none - end subroutine allocate_icepack + end subroutine alloc_column end interface diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 8d80d9d93..4656cbe59 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -821,8 +821,6 @@ end subroutine set_icepack module subroutine set_grid_icepack(mesh) use mod_mesh - use icedrv_domain_size, only: nx - use g_parsup, only: myDim_nod2D, eDim_nod2D implicit none @@ -842,19 +840,19 @@ module subroutine set_grid_icepack(mesh) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) - coord_nod2D(1:2,1:myDim_nod2D+eDim_nod2D) => mesh%coord_nod2D + coord_nod2D(1:2,1:nx) => mesh%coord_nod2D !----------------------------------------------------------------- ! create hemisphereic masks !----------------------------------------------------------------- - !lmask_n(:) = .false. - !lmask_s(:) = .false. - ! - !do i = 1, nx - ! if (coord_nod2D(2,:) >= -puny) lmask_n(i) = .true. ! N. Hem. - ! if (coord_nod2D(2,:) < -puny) lmask_s(i) = .true. ! S. Hem. - !enddo + lmask_n(:) = .false. + lmask_s(:) = .false. + + do i = 1, nx + if (coord_nod2D(2,i) >= -puny) lmask_n(i) = .true. ! N. Hem. + if (coord_nod2D(2,i) < -puny) lmask_s(i) = .true. ! S. Hem. + enddo end subroutine set_grid_icepack diff --git a/src/icepack_drivers/icedrv_system.F90 b/src/icepack_drivers/icedrv_system.F90 index 8ad5871fb..40c28589a 100644 --- a/src/icepack_drivers/icedrv_system.F90 +++ b/src/icepack_drivers/icedrv_system.F90 @@ -7,13 +7,15 @@ module icedrv_system use icedrv_kinds + use g_parsup, only: par_ex use icedrv_constants, only: nu_diag - !use icedrv_state, only: aice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted implicit none - private + public :: icedrv_system_abort + + private !======================================================================= @@ -43,8 +45,11 @@ subroutine icedrv_system_abort(icell, istep, string, file, line) if (present(file)) write (nu_diag,*) subname,' called from', trim(file) if (present(line)) write (nu_diag,*) subname,' line number', line if (present(istep)) write (nu_diag,*) subname,' istep =', istep - !if (present(icell)) write (nu_diag,*) subname,' i, aice =', icell, aice(icell) if (present(string)) write (nu_diag,*) subname,' string =', trim(string) + + ! Stop FESOM2 + + call par_ex(1) stop end subroutine icedrv_system_abort From 845e6e9edb987313b1bcec7b7da92b8e1ddb969b Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 22 May 2020 17:02:26 +0200 Subject: [PATCH 13/54] Submodule for initialization of tracers completed --- src/fvom_main.F90 | 5 +- src/icepack_drivers/icedrv_allocate.F90 | 31 +- src/icepack_drivers/icedrv_init.F90 | 965 ++++++++++++++++++++++++ src/icepack_drivers/icedrv_main.F90 | 78 +- src/icepack_drivers/icedrv_set.F90 | 124 +-- 5 files changed, 1134 insertions(+), 69 deletions(-) create mode 100644 src/icepack_drivers/icedrv_init.F90 diff --git a/src/fvom_main.F90 b/src/fvom_main.F90 index 190ba94bf..78d9266af 100755 --- a/src/fvom_main.F90 +++ b/src/fvom_main.F90 @@ -26,7 +26,7 @@ program main ! Define icepack modules #if defined (__icepack) -use icedrv_main, only: set_icepack, set_grid_icepack +use icedrv_main, only: set_icepack, init_icepack, alloc_icepack #endif #if defined (__oasis) @@ -81,7 +81,8 @@ program main !===================== if (mype==0) write(*,*) 'Icepack: reading namelists from namelist.icepack' call set_icepack - call set_grid_icepack(mesh) + call alloc_icepack + call init_icepack(mesh) if (mype==0) write(*,*) 'Icepack: setup complete' #endif diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 index cf2bcf1f4..f436813a2 100644 --- a/src/icepack_drivers/icedrv_allocate.F90 +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -28,14 +28,17 @@ module subroutine alloc_state call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) & + if (icepack_warnings_aborted()) & call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) allocate ( & lmask_n(nx) , & ! N. Hemis mask lmask_s(nx) , & ! S. Hemis mask + lon_val(nx) , & + lat_val(nx) , & stat=ierr) + if (ierr/=0) write(*,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) allocate ( & @@ -59,6 +62,7 @@ module subroutine alloc_state trcrn (nx,ntrcr,ncat) , & ! tracers: 1: surface temperature of ice/snow (C) stat=ierr) + if (ierr/=0) write(*,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) allocate ( & @@ -68,6 +72,7 @@ module subroutine alloc_state trcr_base(ntrcr,3) , & ! = 0 or 1 depending on tracer dependency, (1) aice, (2) vice, (3) vsno stat=ierr) + if (ierr/=0) write(*,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) trcr_depend = 0 @@ -125,7 +130,7 @@ module subroutine alloc_flux vatm(nx) , & wind(nx) , & ! wind speed (m/s) potT(nx) , & ! air potential temperature (K) - T_air(nx) , & ! air temperature (K) + T_air(nx) , & ! air temperature (K) Qa(nx) , & ! specific humidity (kg/kg) rhoa(nx) , & ! air density (kg/m^3) swvdr(nx) , & ! sw down, visible, direct (W/m^2) @@ -233,12 +238,15 @@ module subroutine alloc_flux rside(nx) , & ! fraction of ice that melts laterally fsw(nx) , & ! incoming shortwave radiation (W/m^2) cos_zen(nx) , & ! cosine solar zenith angle, < 0 for sun below horizon - rdg_conv(nx) , & ! convergence term for ridging (1/s) - rdg_shear(nx), & ! shear term for ridging (1/s) + rdg_conv(nx) , & ! convergence term for ridging on nodes (1/s) + rdg_shear(nx), & ! shear term for ridging on nodes (1/s) + rdg_conv_elem(nx_elem), & ! convergence term for ridging on elements (1/s) + rdg_shear_elem(nx_elem), & ! shear term for ridging on elements (1/s) salinz(nx,nilyr+1) , & ! initial salinity profile (ppt) Tmltz(nx,nilyr+1) , & ! initial melting temperature (C) stat=ierr) + if (ierr/=0) write(*,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) end subroutine alloc_flux @@ -292,6 +300,7 @@ module subroutine alloc_flux_bgc zaeros(nx,icepack_max_aero) , & ! ocean aerosols (mmol/m^3) stat=ierr) + if (ierr/=0) write(*,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) end subroutine alloc_flux_bgc @@ -418,10 +427,24 @@ module subroutine alloc_column c_fsd_range(nfsd) , & ! fsd floe_rad bounds (m) stat=ierr) + if (ierr/=0) write(*,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) end subroutine alloc_column +! ------------------------------------------------------------------------------ + + module subroutine alloc_icepack + + implicit none + + call alloc_state + call alloc_flux + call alloc_flux_bgc + call alloc_column + + end subroutine alloc_icepack + ! ------------------------------------------------------------------------------ end submodule allocate_icepack diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 new file mode 100644 index 000000000..3fc2dc3dd --- /dev/null +++ b/src/icepack_drivers/icedrv_init.F90 @@ -0,0 +1,965 @@ +!======================================================================= +! +! This module initializes the icepack variables +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + + submodule (icedrv_main) icedrv_init + + use icepack_intfc, only: icepack_init_parameters + use icepack_intfc, only: icepack_init_tracer_flags + use icepack_intfc, only: icepack_init_tracer_sizes + use icepack_intfc, only: icepack_init_tracer_indices + use icepack_intfc, only: icepack_init_trcr + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_tracer_indices + use icepack_intfc, only: icepack_warnings_flush + use icepack_intfc, only: icepack_warnings_aborted + use icepack_intfc, only: icepack_write_tracer_flags + use icepack_intfc, only: icepack_write_tracer_indices + use icepack_intfc, only: icepack_write_tracer_sizes + use icedrv_system, only: icedrv_system_abort + + contains + + module subroutine init_state() + + use icepack_intfc, only: icepack_aggregate + + implicit none + + integer (kind=int_kind) :: & + i , & ! horizontal indes + k , & ! vertical index + it ! tracer index + + logical (kind=log_kind) :: & + heat_capacity ! from icepack + + integer (kind=int_kind) :: ntrcr + logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_aero, tr_fsd + logical (kind=log_kind) :: tr_pond_cesm, tr_pond_lvl, tr_pond_topo + integer (kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno, nt_iage, nt_fy + integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, & + nt_ipnd, nt_aero, nt_fsd + + character(len=*), parameter :: subname='(init_state)' + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(heat_capacity_out=heat_capacity) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, & + tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, & + tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_fsd_out=tr_fsd) + 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, nt_iage_out=nt_iage, nt_fy_out=nt_fy, & + 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_aero_out=nt_aero, nt_fsd_out=nt_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + ! Check number of layers in ice and snow. + !----------------------------------------------------------------- + if (nilyr < 1) then + write (nu_diag,*) 'nilyr =', nilyr + write (nu_diag,*) 'Must have at least one ice layer' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (nslyr < 1) then + write (nu_diag,*) 'nslyr =', nslyr + write (nu_diag,*) 'Must have at least one snow layer' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (.not.heat_capacity) then + + write (nu_diag,*) 'WARNING - Zero-layer thermodynamics' + + if (nilyr > 1) then + write (nu_diag,*) 'nilyr =', nilyr + write (nu_diag,*) & + 'Must have nilyr = 1 if ktherm = 0' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (nslyr > 1) then + write (nu_diag,*) 'nslyr =', nslyr + write (nu_diag,*) & + 'Must have nslyr = 1 if heat_capacity = F' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + endif ! heat_capacity = F + + !----------------------------------------------------------------- + ! Set tracer types + !----------------------------------------------------------------- + + trcr_depend(nt_Tsfc) = 0 ! ice/snow surface temperature + do k = 1, nilyr + trcr_depend(nt_sice + k - 1) = 1 ! volume-weighted ice salinity + trcr_depend(nt_qice + k - 1) = 1 ! volume-weighted ice enthalpy + enddo + do k = 1, nslyr + trcr_depend(nt_qsno + k - 1) = 2 ! volume-weighted snow enthalpy + enddo + if (tr_iage) trcr_depend(nt_iage) = 1 ! volume-weighted ice age + if (tr_FY) trcr_depend(nt_FY) = 0 ! area-weighted first-year ice area + if (tr_lvl) trcr_depend(nt_alvl) = 0 ! level ice area + if (tr_lvl) trcr_depend(nt_vlvl) = 1 ! level ice volume + if (tr_pond_cesm) then + trcr_depend(nt_apnd) = 0 ! melt pond area + trcr_depend(nt_hpnd) = 2+nt_apnd ! melt pond depth + endif + if (tr_pond_lvl) then + trcr_depend(nt_apnd) = 2+nt_alvl ! melt pond area + trcr_depend(nt_hpnd) = 2+nt_apnd ! melt pond depth + trcr_depend(nt_ipnd) = 2+nt_apnd ! refrozen pond lid + endif + if (tr_pond_topo) then + trcr_depend(nt_apnd) = 0 ! melt pond area + trcr_depend(nt_hpnd) = 2+nt_apnd ! melt pond depth + trcr_depend(nt_ipnd) = 2+nt_apnd ! refrozen pond lid + endif + if (tr_fsd) then + do it = 1, nfsd + trcr_depend(nt_fsd + it - 1) = 0 ! area-weighted floe size distribution + enddo + endif + if (tr_aero) then ! volume-weighted aerosols + do it = 1, n_aero + trcr_depend(nt_aero+(it-1)*4 ) = 2 ! snow + trcr_depend(nt_aero+(it-1)*4+1) = 2 ! snow + trcr_depend(nt_aero+(it-1)*4+2) = 1 ! ice + trcr_depend(nt_aero+(it-1)*4+3) = 1 ! ice + enddo + endif + + do it = 1, ntrcr + ! mask for base quantity on which tracers are carried + if (trcr_depend(it) == 0) then ! area + trcr_base(it,1) = c1 + elseif (trcr_depend(it) == 1) then ! ice volume + trcr_base(it,2) = c1 + elseif (trcr_depend(it) == 2) then ! snow volume + trcr_base(it,3) = c1 + else + trcr_base(it,1) = c1 ! default: ice area + trcr_base(it,2) = c0 + trcr_base(it,3) = c0 + endif + + ! initialize number of underlying tracer layers + n_trcr_strata(it) = 0 + ! default indices of underlying tracer layers + nt_strata (it,1) = 0 + nt_strata (it,2) = 0 + enddo + + if (tr_pond_cesm) then + n_trcr_strata(nt_hpnd) = 1 ! melt pond depth + nt_strata (nt_hpnd,1) = nt_apnd ! on melt pond area + endif + if (tr_pond_lvl) then + n_trcr_strata(nt_apnd) = 1 ! melt pond area + nt_strata (nt_apnd,1) = nt_alvl ! on level ice area + n_trcr_strata(nt_hpnd) = 2 ! melt pond depth + nt_strata (nt_hpnd,2) = nt_apnd ! on melt pond area + nt_strata (nt_hpnd,1) = nt_alvl ! on level ice area + n_trcr_strata(nt_ipnd) = 2 ! refrozen pond lid + nt_strata (nt_ipnd,2) = nt_apnd ! on melt pond area + nt_strata (nt_ipnd,1) = nt_alvl ! on level ice area + endif + if (tr_pond_topo) then + n_trcr_strata(nt_hpnd) = 1 ! melt pond depth + nt_strata (nt_hpnd,1) = nt_apnd ! on melt pond area + n_trcr_strata(nt_ipnd) = 1 ! refrozen pond lid + nt_strata (nt_ipnd,1) = nt_apnd ! on melt pond area + endif + + !----------------------------------------------------------------- + ! Set state variables + !----------------------------------------------------------------- + + !call set_state_var (nx, & + ! Tair (:), sst (:), & + ! Tf (:), & + ! salinz(:,:), Tmltz(:,:), & + ! aicen (:,:), trcrn(:,:,:), & + ! vicen (:,:), vsnon(:,:)) + + !----------------------------------------------------------------- + ! compute aggregate ice state and open water area + !----------------------------------------------------------------- + + do i = 1, nx + aice(i) = c0 + vice(i) = c0 + vsno(i) = c0 + do it = 1, max_ntrcr + trcr(i,it) = c0 + enddo + + call icepack_aggregate(ncat=ncat, & + trcrn=trcrn(i,1:ntrcr,:), & + aicen=aicen(i,:), & + vicen=vicen(i,:), & + vsnon=vsnon(i,:), & + trcr=trcr (i,1:ntrcr), & + aice=aice (i), & + vice=vice (i), & + vsno=vsno (i), & + aice0=aice0(i), & + 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,:)) + + aice_init(i) = aice(i) + + enddo + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine init_state + +!======================================================================= + + module subroutine init_coupler_flux() + + use icepack_intfc, only: icepack_liquidus_temperature + + + real (kind=dbl_kind) :: fcondtopn_d(6), fsurfn_d(6) + real (kind=dbl_kind) :: stefan_boltzmann, Tffresh + real (kind=dbl_kind) :: vonkar, zref, iceruf + integer (kind=int_kind):: i + integer (kind=int_kind) :: n + data fcondtopn_d / -50.0_dbl_kind,-17.0_dbl_kind,-12.0_dbl_kind, & + -9.0_dbl_kind, -7.0_dbl_kind, -3.0_dbl_kind / + data fsurfn_d / 0.20_dbl_kind, 0.15_dbl_kind, 0.10_dbl_kind, & + 0.05_dbl_kind, 0.01_dbl_kind, 0.01_dbl_kind / + character(len=*), parameter :: subname='(init_coupler_flux)' + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(stefan_boltzmann_out=stefan_boltzmann, & + Tffresh_out=Tffresh, vonkar_out=vonkar, zref_out=zref, iceruf_out=iceruf) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + ! information received from FESOM2 EVP solver + !----------------------------------------------------------------- + + rdg_shear(:) = c0 + rdg_conv(:) = c0 + rdg_shear_elem(:) = c0 + rdg_conv_elem(:) = c0 + + !----------------------------------------------------------------- + ! fluxes received from atmosphere + !----------------------------------------------------------------- + zlvl (:) = c10 ! atm level height (m) + rhoa (:) = 1.3_dbl_kind ! air density (kg/m^3) + uatm (:) = c5 ! wind velocity (m/s) + vatm (:) = c5 + strax (:) = 0.05_dbl_kind + stray (:) = 0.05_dbl_kind + fsnow (:) = c0 ! snowfall rate (kg/m2/s) + ! fsnow must be 0 for exact restarts + ! typical winter values + potT (:) = 253.0_dbl_kind ! air potential temp (K) + T_air (:) = 253.0_dbl_kind ! air temperature (K) + Qa (:) = 0.0006_dbl_kind ! specific humidity (kg/kg) + swvdr (:) = c0 ! shortwave radiation (W/m^2) + swvdf (:) = c0 ! shortwave radiation (W/m^2) + swidr (:) = c0 ! shortwave radiation (W/m^2) + swidf (:) = c0 ! shortwave radiation (W/m^2) + flw (:) = c180 ! incoming longwave rad (W/m^2) + frain (:) = c0 ! rainfall rate (kg/m2/s) + do n = 1, ncat ! conductive heat flux (W/m^2) + fcondtopn_f(:,n) = fcondtopn_d(n) + enddo + fsurfn_f = fcondtopn_f ! surface heat flux (W/m^2) + flatn_f (:,:) = c0 ! latent heat flux (kg/m2/s) + fsensn_f(:,:) = c0 ! sensible heat flux (W/m^2) + + faero_atm (:,:) = c0 ! aerosol deposition rate (kg/m2/s) + flux_bio_atm (:,:) = c0 ! zaero and bio deposition rate (kg/m2/s) + + !----------------------------------------------------------------- + ! fluxes received from ocean + !----------------------------------------------------------------- + + uocn (:) = c0 ! surface ocean currents (m/s) + vocn (:) = c0 + frzmlt (:) = c0 ! freezing/melting potential (W/m^2) + sss (:) = 34.0_dbl_kind ! sea surface salinity (ppt) + sst (:) = -1.8_dbl_kind ! sea surface temperature (C) + sstdat (:) = sst(:) ! sea surface temperature (C) + + do i = 1, nx + Tf (i) = icepack_liquidus_temperature(sss(i)) ! freezing temp (C) + enddo + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + qdp (:) = c0 ! deep ocean heat flux (W/m^2) + hmix (:) = c20 ! ocean mixed layer depth + + !----------------------------------------------------------------- + ! fluxes sent to atmosphere + !----------------------------------------------------------------- + + strairxT(:) = c0 ! wind stress, T grid + strairyT(:) = c0 + + fsens (:) = c0 + flat (:) = c0 + fswabs (:) = 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 + alvdr (:) = c0 + alidr (:) = c0 + alvdf (:) = c0 + alidf (:) = c0 + + !----------------------------------------------------------------- + ! fluxes sent to ocean + !----------------------------------------------------------------- + + strocnxT(:) = c0 ! ice-ocean stress, x-direction (T-cell) + strocnyT(:) = c0 ! ice-ocean stress, y-direction (T-cell) + fresh (:) = c0 + fsalt (:) = c0 + fhocn (:) = c0 + fswthru (:) = 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 + + !----------------------------------------------------------------- + ! derived or computed fields + !----------------------------------------------------------------- + + cos_zen (:) = c0 ! Cosine of the zenith angle + fsw (:) = c0 ! sahortwave radiation (W/m^2) + fsw (:) = swvdr(:) + swvdf(:) + swidr(:) + swidf(:) + scale_factor(:) = c1 ! shortwave scaling factor + wind (:) = sqrt(uatm(:)**2 + vatm(:)**2) ! wind speed, (m/s) + Cdn_atm(:) = (vonkar/log(zref/iceruf)) & + * (vonkar/log(zref/iceruf)) ! atmo drag for RASM + + end subroutine init_coupler_flux + +!======================================================================= + + module subroutine init_flux_atm_ocn() + + character(len=*), parameter :: subname='(init_flux_atm_ocn)' + + !----------------------------------------------------------------- + ! initialize albedo and atmosphere fluxes + !----------------------------------------------------------------- + + strairxT(:) = c0 ! wind stress, T grid + strairyT(:) = c0 + fsens (:) = c0 + flat (:) = c0 + fswabs (:) = c0 + flwout (:) = c0 + evap (:) = c0 + evaps (:) = c0 + evapi (:) = c0 + Tref (:) = c0 + Qref (:) = c0 + Uref (:) = c0 + + !----------------------------------------------------------------- + ! fluxes sent to ocean + !----------------------------------------------------------------- + + fresh (:) = c0 + fsalt (:) = c0 + fhocn (:) = c0 + fswthru (:) = c0 + faero_ocn(:,:) = c0 + + end subroutine init_flux_atm_ocn + +!======================================================================= + + module subroutine init_history_therm() + + logical (kind=log_kind) :: formdrag, tr_iage + integer (kind=int_kind) :: nt_iage + real (kind=dbl_kind) :: vonkar, zref, iceruf + real (kind=dbl_kind) :: dragio + character(len=*), parameter :: subname='(init_history_therm)' + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(formdrag_out=formdrag) + call icepack_query_tracer_flags(tr_iage_out=tr_iage) + call icepack_query_tracer_indices(nt_iage_out=nt_iage) + call icepack_query_parameters(dragio_out=dragio, & + vonkar_out=vonkar, zref_out=zref, iceruf_out=iceruf) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + + fsurf (:) = c0 + fcondtop(:)= c0 + fcondbot(:)= c0 + congel (:) = c0 + frazil (:) = c0 + snoice (:) = c0 + dsnow (:) = c0 + meltt (:) = c0 + melts (:) = c0 + meltb (:) = c0 + meltl (:) = c0 + daidtt (:) = aice(:) ! temporary initial area + dvidtt (:) = vice(:) ! temporary initial volume + if (tr_iage) then + dagedtt(:) = trcr(:,nt_iage) ! temporary initial age + else + dagedtt(:) = c0 + endif + fsurfn (:,:) = c0 + fcondtopn (:,:) = c0 + fcondbotn (:,:) = c0 + flatn (:,:) = c0 + fsensn (:,:) = c0 + fpond (:) = c0 + fresh_ai (:) = c0 + fsalt_ai (:) = c0 + fhocn_ai (:) = c0 + fswthru_ai(:) = c0 + albice (:) = c0 + albsno (:) = c0 + albpnd (:) = c0 + apeff_ai (:) = c0 + snowfrac (:) = c0 + frazil_diag (:) = c0 + + ! drag coefficients are computed prior to the atmo_boundary call, + ! during the thermodynamics section + Cdn_ocn(:) = dragio + Cdn_atm(:) = (vonkar/log(zref/iceruf)) & + * (vonkar/log(zref/iceruf)) ! atmo drag for RASM + + if (formdrag) then + Cdn_atm_rdg (:) = c0 + Cdn_atm_ratio(:)= c0 + Cdn_atm_floe(:) = c0 + Cdn_atm_pond(:) = c0 + Cdn_atm_skin(:) = c0 + Cdn_ocn_skin(:) = c0 + Cdn_ocn_keel(:) = c0 + Cdn_ocn_floe(:) = c0 + hfreebd (:) = c0 + hdraft (:) = c0 + hridge (:) = c0 + distrdg (:) = c0 + hkeel (:) = c0 + dkeel (:) = c0 + lfloe (:) = c0 + dfloe (:) = c0 + endif + + end subroutine init_history_therm + +!======================================================================= + + module subroutine init_history_dyn() + + logical (kind=log_kind) :: tr_iage + integer (kind=int_kind) :: nt_iage + character(len=*), parameter :: subname='(init_history_dyn)' + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_tracer_flags(tr_iage_out=tr_iage) + call icepack_query_tracer_indices(nt_iage_out=nt_iage) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + + dardg1dt(:) = c0 + dardg2dt(:) = c0 + dvirdgdt(:) = c0 + daidtd (:) = aice(:) ! temporary initial area + dvidtd (:) = vice(:) ! temporary initial volume + if (tr_iage) & + dagedtd (:) = trcr(:,nt_iage) ! temporary initial age + ardgn (:,:) = c0 + vrdgn (:,:) = c0 + krdgn (:,:) = c1 + aparticn(:,:) = c0 + aredistn(:,:) = c0 + vredistn(:,:) = c0 + dardg1ndt(:,:) = c0 + dardg2ndt(:,:) = c0 + dvirdgndt(:,:) = c0 + araftn (:,:) = c0 + vraftn (:,:) = c0 + aredistn (:,:) = c0 + vredistn (:,:) = c0 + + end subroutine init_history_dyn + +!======================================================================= + + module subroutine init_history_bgc() + + character(len=*), parameter :: subname='(init_history_bgc)' + + PP_net (:) = c0 + grow_net (:) = c0 + hbri (:) = c0 + flux_bio (:,:) = c0 + flux_bio_ai (:,:) = c0 + ice_bio_net (:,:) = c0 + snow_bio_net(:,:) = c0 + fbio_snoice (:,:) = c0 + fbio_atmice (:,:) = c0 + fzsal (:) = c0 + fzsal_g (:) = c0 + zfswin (:,:,:) = c0 + 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 + + end subroutine init_history_bgc + +!======================================================================= + + module subroutine init_thermo_vertical() + + use icepack_intfc, only: icepack_init_thermo + + integer (kind=int_kind) :: & + i, & ! horizontal indices + k ! ice layer index + real (kind=dbl_kind), dimension(nilyr+1) :: & + sprofile ! vertical salinity profile + real (kind=dbl_kind) :: & + depressT + character(len=*), parameter :: subname='(init_thermo_vertical)' + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(depressT_out=depressT) + call icepack_init_thermo(nilyr=nilyr, sprofile=sprofile) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Prescibe vertical profile of salinity and melting temperature. + ! Note this profile is only used for BL99 thermodynamics. + !----------------------------------------------------------------- + + do i = 1, nx + do k = 1, nilyr+1 + salinz(i,k) = sprofile(k) + Tmltz (i,k) = -salinz(i,k)*depressT + enddo ! k + enddo ! i + + end subroutine init_thermo_vertical + +!======================================================================= + + module subroutine init_shortwave() + + use icepack_intfc, only: icepack_step_radiation + use icepack_intfc, only: icepack_max_aero + use icepack_intfc, only: icepack_max_algae + use icepack_intfc, only: icepack_init_orbit + + integer (kind=int_kind) :: & + i, k , & ! horizontal indices + n ! thickness category index + real (kind=dbl_kind) :: & + netsw ! flag for shortwave radiation presence + logical (kind=log_kind) :: & + l_print_point, & ! flag to print designated grid point diagnostics + dEdd_algae, & ! from icepack + modal_aero ! from icepack + character (len=char_len) :: & + shortwave ! from icepack + real (kind=dbl_kind), dimension(ncat) :: & + fbri ! brine height to ice thickness + real (kind=dbl_kind), allocatable, dimension(:,:) :: & + ztrcr_sw + logical (kind=log_kind) :: tr_brine, tr_zaero, tr_bgc_N + integer (kind=int_kind) :: nt_alvl, nt_apnd, nt_hpnd, nt_ipnd, nt_aero, & + nt_fbri, nt_tsfc, ntrcr, nbtrcr_sw, nlt_chl_sw + integer (kind=int_kind), dimension(icepack_max_aero) :: nlt_zaero_sw + integer (kind=int_kind), dimension(icepack_max_aero) :: nt_zaero + integer (kind=int_kind), dimension(icepack_max_algae) :: nt_bgc_N + real (kind=dbl_kind) :: puny + character(len=*), parameter :: subname='(init_shortwave)' + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(shortwave_out=shortwave) + call icepack_query_parameters(dEdd_algae_out=dEdd_algae) + call icepack_query_parameters(modal_aero_out=modal_aero) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, & + nbtrcr_sw_out=nbtrcr_sw) + call icepack_query_tracer_flags(tr_brine_out=tr_brine, & + tr_zaero_out=tr_zaero, tr_bgc_N_out=tr_bgc_N) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & + nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, & + nt_fbri_out=nt_fbri, nt_tsfc_out=nt_tsfc, & + nt_bgc_N_out=nt_bgc_N, nt_zaero_out=nt_zaero, & + nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + allocate(ztrcr_sw(nbtrcr_sw, ncat)) + + fswpenln(:,:,:) = c0 + Iswabsn(:,:,:) = c0 + Sswabsn(:,:,:) = c0 + + do i = 1, nx + + l_print_point = .false. + + alvdf(i) = c0 + alidf(i) = c0 + alvdr(i) = c0 + alidr(i) = c0 + alvdr_ai(i) = c0 + alidr_ai(i) = c0 + alvdf_ai(i) = c0 + alidf_ai(i) = c0 + albice(i) = c0 + albsno(i) = c0 + albpnd(i) = c0 + snowfrac(i) = c0 + apeff_ai(i) = c0 + + do n = 1, ncat + alvdrn(i,n) = c0 + alidrn(i,n) = c0 + alvdfn(i,n) = c0 + alidfn(i,n) = c0 + fswsfcn(i,n) = c0 + fswintn(i,n) = c0 + fswthrun(i,n) = c0 + enddo ! ncat + + enddo ! nx + + do i = 1, nx + + if (trim(shortwave) == 'dEdd') then ! delta Eddington + + ! initialize orbital parameters + ! These come from the driver in the coupled model. + call icepack_warnings_flush(nu_diag) + call icepack_init_orbit() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) & + call icedrv_system_abort(i, istep1, subname, __FILE__,__LINE__) + endif + + fbri(:) = c0 + ztrcr_sw(:,:) = c0 + do n = 1, ncat + if (tr_brine) fbri(n) = trcrn(i,nt_fbri,n) + enddo + + call icepack_step_radiation ( & + dt=dt, ncat=ncat, & + nblyr=nblyr, & + nilyr=nilyr, nslyr=nslyr, & + dEdd_algae=dEdd_algae, & + swgrid=swgrid(:), & + igrid=igrid(:), & + fbri=fbri(:), & + aicen=aicen(i,:), & + vicen=vicen(i,:), & + vsnon=vsnon(i,:), & + Tsfcn=trcrn(i,nt_Tsfc,:), & + alvln=trcrn(i,nt_alvl,:), & + apndn=trcrn(i,nt_apnd,:), & + hpndn=trcrn(i,nt_hpnd,:), & + ipndn=trcrn(i,nt_ipnd,:), & + aeron=trcrn(i,nt_aero:nt_aero+4*n_aero-1,:), & + bgcNn=trcrn(i,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:), & + zaeron=trcrn(i,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:), & + trcrn_bgcsw=ztrcr_sw, & + TLAT=lat_val(i), TLON=lon_val(i), & + calendar_type=calendar_type, & + days_per_year=days_per_year, & + nextsw_cday=nextsw_cday, yday=yday, sec=sec, & + kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & + waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & + gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & + bcenh=bcenh(:,:,:), & + modal_aero=modal_aero, & + swvdr=swvdr(i), swvdf=swvdf(i), & + swidr=swidr(i), swidf=swidf(i), & + coszen=cos_zen(i), fsnow=fsnow(i), & + alvdrn=alvdrn(i,:), alvdfn=alvdfn(i,:), & + alidrn=alidrn(i,:), alidfn=alidfn(i,:), & + fswsfcn=fswsfcn(i,:), fswintn=fswintn(i,:), & + fswthrun=fswthrun(i,:), fswpenln=fswpenln(i,:,:), & + Sswabsn=Sswabsn(i,:,:), Iswabsn=Iswabsn(i,:,:), & + albicen=albicen(i,:), albsnon=albsnon(i,:), & + albpndn=albpndn(i,:), apeffn=apeffn(i,:), & + snowfracn=snowfracn(i,:), & + dhsn=dhsn(i,:), ffracn=ffracn(i,:), & + l_print_point=l_print_point, & + initonly = .true.) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Define aerosol tracer on shortwave grid + !----------------------------------------------------------------- + + if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then + do n = 1, ncat + do k = 1, nbtrcr_sw + trcrn_sw(i,k,n) = ztrcr_sw(k,n) + enddo + enddo + endif + + enddo + + !----------------------------------------------------------------- + ! Aggregate albedos + !----------------------------------------------------------------- + + do n = 1, ncat + do i = 1, nx + + if (aicen(i,n) > puny) then + + alvdf(i) = alvdf(i) + alvdfn(i,n)*aicen(i,n) + alidf(i) = alidf(i) + alidfn(i,n)*aicen(i,n) + alvdr(i) = alvdr(i) + alvdrn(i,n)*aicen(i,n) + alidr(i) = alidr(i) + alidrn(i,n)*aicen(i,n) + + netsw = swvdr(i) + swidr(i) + swvdf(i) + swidf(i) + if (netsw > puny) then ! sun above horizon + albice(i) = albice(i) + albicen(i,n)*aicen(i,n) + albsno(i) = albsno(i) + albsnon(i,n)*aicen(i,n) + albpnd(i) = albpnd(i) + albpndn(i,n)*aicen(i,n) + endif + + apeff_ai(i) = apeff_ai(i) + apeffn(i,n)*aicen(i,n) + snowfrac(i) = snowfrac(i) + snowfracn(i,n)*aicen(i,n) + + endif ! aicen > puny + enddo ! i + enddo ! ncat + + do i = 1, nx + + !---------------------------------------------------------------- + ! Store grid box mean albedos and fluxes before scaling by aice + !---------------------------------------------------------------- + + alvdf_ai (i) = alvdf (i) + alidf_ai (i) = alidf (i) + alvdr_ai (i) = alvdr (i) + alidr_ai (i) = alidr (i) + + !---------------------------------------------------------------- + ! Save net shortwave for scaling factor in scale_factor + !---------------------------------------------------------------- + scale_factor(i) = swvdr(i)*(c1 - alvdr_ai(i)) & + + swvdf(i)*(c1 - alvdf_ai(i)) & + + swidr(i)*(c1 - alidr_ai(i)) & + + swidf(i)*(c1 - alidf_ai(i)) + + enddo ! i + + deallocate(ztrcr_sw) + + end subroutine init_shortwave + +!======================================================================= + + module subroutine init_fsd() + + wavefreq (:) = c0 + dwavefreq (:) = c0 + wave_sig_ht (:) = c0 + wave_spectrum (:,:) = c0 + d_afsd_newi (:,:) = c0 + d_afsd_latg (:,:) = c0 + d_afsd_latm (:,:) = c0 + d_afsd_wave (:,:) = c0 + d_afsd_weld (:,:) = c0 + + end subroutine init_fsd + +!======================================================================= + + module subroutine init_icepack(mesh) + + use icepack_intfc, only: icepack_init_itd + use icepack_intfc, only: icepack_init_itd_hist + use icepack_intfc, only: icepack_init_fsd + use icepack_intfc, only: icepack_init_fsd_bounds + use icepack_intfc, only: icepack_warnings_flush + + implicit none + + logical (kind=log_kind) :: & + tr_aero, & ! from icepack + tr_zaero, & ! from icepack + tr_fsd, & ! from icepack + wave_spec ! from icepack + character(len=*), parameter :: subname='(icedrv_initialize)' + type(t_mesh), intent(in), target :: mesh + + call icepack_query_parameters(wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_aero_out=tr_aero) + call icepack_query_tracer_flags(tr_zaero_out=tr_zaero) + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + ! generate some output + if (mype==0) then + call icepack_write_tracer_flags(nu_diag) + call icepack_write_tracer_sizes(nu_diag) + call icepack_write_tracer_indices(nu_diag) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + endif + + call set_grid_icepack(mesh) + 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) ! initialize the ice thickness distribution + call icepack_warnings_flush(nu_diag) + + if (icepack_warnings_aborted(subname)) then + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + + if (mype==0) then + call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted(subname)) & + call icedrv_system_abort(file=__FILE__,line=__LINE__) + end if + + if (tr_fsd) then + call icepack_init_fsd_bounds( & + nfsd=nfsd, & ! floe size distribution + floe_rad_l=floe_rad_l, & ! fsd size lower bound in m (radius) + floe_rad_c=floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth=floe_binwidth, & ! fsd size bin width in m (radius) + c_fsd_range=c_fsd_range) ! string for history output + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted(subname)) then + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + endif + call init_fsd + + call init_state ! initialize the ice state + call init_history_therm ! initialize thermo history variables + + !if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice + !if (tr_aero .or. tr_zaero) call faero_default ! default aerosols values + + call init_shortwave ! initialize radiative transfer using current swdn + call init_flux_atm_ocn ! initialize atmosphere, ocean fluxes + + end subroutine + +!======================================================================= + + end submodule icedrv_init + +!======================================================================= diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 3ed45fd1f..1ed823553 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -10,6 +10,7 @@ module icedrv_main use icedrv_kinds use icedrv_constants + use g_parsup, only: mype implicit none @@ -18,8 +19,7 @@ module icedrv_main !--------- subroutines to be seen outside icepack !======================================================================= - public :: set_icepack, set_grid_icepack, alloc_state, alloc_flux, & - alloc_flux_bgc, alloc_column + public :: set_icepack, alloc_icepack, init_icepack !======================================================================= !--------- Everything else is private @@ -35,7 +35,8 @@ module icedrv_main ! 1. Setting variables used by the model !======================================================================= - integer (kind=int_kind), save :: nx ! number of grid cells and gost cells for each mesh partition + integer (kind=int_kind), save :: nx ! number of nodes and gost nodes for each mesh partition + integer (kind=int_kind), save :: nx_elem ! number of elements and gost elements for each mesh partition integer (kind=int_kind), save :: ncat ! number of categories in use integer (kind=int_kind), save :: nfsd ! number of floe size categories in use integer (kind=int_kind), save :: nilyr ! number of ice layers per category in use @@ -327,10 +328,12 @@ module icedrv_main fswthru_ai(:) ! shortwave penetrating to ocean (W/m^2) real (kind=dbl_kind), allocatable, save :: & ! DIM nx - rside(:) , & ! fraction of ice that melts laterally - cos_zen(:) , & ! cosine solar zenith angle, < 0 for sun below horizon - rdg_conv(:), & ! convergence term for ridging (1/s) - rdg_shear(:) ! shear term for ridging (1/s) + rside(:), & ! fraction of ice that melts laterally + cos_zen(:), & ! cosine solar zenith angle, < 0 for sun below horizon + rdg_conv_elem(:), & ! convergence term for ridging on elements (1/s) + rdg_shear_elem(:), & ! shear term for ridging on elements (1/s) + rdg_conv(:), & ! convergence term for ridging on nodes (1/s) + rdg_shear(:) ! shear term for ridging on nodes (1/s) real (kind=dbl_kind), allocatable, save :: & ! DIM nx,nilyr+1 salinz(:,:) , & ! initial salinity profile (ppt) @@ -682,6 +685,10 @@ module icedrv_main lmask_n(:), & ! northern hemisphere mask lmask_s(:) ! northern hemisphere mask + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + lon_val(:), & ! mesh nodes longitude + lat_val(:) ! mesh nodes latitude + !======================================================================= ! 7. Clock variables !======================================================================= @@ -756,6 +763,63 @@ module subroutine alloc_column() implicit none end subroutine alloc_column + ! Allocate all + module subroutine alloc_icepack() + implicit none + end subroutine alloc_icepack + + ! Initialize ice state + module subroutine init_state() + implicit none + end subroutine init_state + + ! Initialize coupler flux + module subroutine init_coupler_flux() + implicit none + end subroutine init_coupler_flux + + ! Initialize fluxes to and from atm. and ocean + module subroutine init_flux_atm_ocn() + implicit none + end subroutine init_flux_atm_ocn + + ! Initialize thermodynamic history + module subroutine init_history_therm() + implicit none + end subroutine init_history_therm + + ! Initialize dynamic hystory + module subroutine init_history_dyn() + implicit none + end subroutine init_history_dyn + + ! Initialize bgc hystory + module subroutine init_history_bgc() + implicit none + end subroutine init_history_bgc + + ! Initialize vertical column + module subroutine init_thermo_vertical() + implicit none + end subroutine init_thermo_vertical + + ! Initialize shartwave radiation + module subroutine init_shortwave() + implicit none + end subroutine init_shortwave + + ! Initialize floe size distribution + module subroutine init_fsd() + implicit none + end subroutine init_fsd + + ! Initialize all + module subroutine init_icepack(mesh) + use mod_mesh + implicit none + type(t_mesh), intent(in), target :: mesh + end subroutine init_icepack + end interface end module icedrv_main diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 4656cbe59..4261922a1 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -9,11 +9,9 @@ submodule (icedrv_main) icedrv_set use icepack_intfc, only: icepack_init_parameters - use icepack_intfc, only: icepack_init_fsd use icepack_intfc, only: icepack_init_tracer_flags use icepack_intfc, only: icepack_init_tracer_sizes use icepack_intfc, only: icepack_init_tracer_indices - use icepack_intfc, only: icepack_init_trcr use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_flags use icepack_intfc, only: icepack_query_tracer_sizes @@ -26,8 +24,9 @@ module subroutine set_icepack() - use icedrv_domain_size - use g_parsup, only: mype, myDim_nod2D, eDim_nod2D + use g_parsup, only: myDim_nod2D, eDim_nod2D, & + myDim_elem2D, eDim_elem2D, & + mpi_comm_fesom implicit none @@ -39,7 +38,7 @@ module subroutine set_icepack() integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd integer (kind=int_kind) :: nt_ipnd, nt_aero, nt_fsd, nt_FY integer (kind=int_kind) :: ntrcr, nt_iage - integer (kind=int_kind) :: nml_error, diag_error + integer (kind=int_kind) :: nml_error, diag_error, mpi_error integer (kind=int_kind) :: n real (kind=dbl_kind) :: rpcesm, rplvl, rptopo, puny logical (kind=log_kind) :: tr_pond, wave_spec @@ -157,7 +156,8 @@ module subroutine set_icepack() namelist / env_nml / & nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & - trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs + trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs, & + ndtd namelist / grid_nml / & kcatbound @@ -178,9 +178,8 @@ module subroutine set_icepack() dT_mlt, rsnw_mlt, kalg namelist / ponds_nml / & - hs0, dpscale, frzpnd, & - rfracmin, rfracmax, pndaspect, hs1, & - hp1 + hs0, dpscale, frzpnd, hp1, & + rfracmin, rfracmax, pndaspect, hs1 namelist / tracer_nml / & tr_iage, tr_FY, tr_lvl, tr_pond_cesm, & @@ -218,6 +217,7 @@ module subroutine set_icepack() trlvl = 0 ! set to 1 for level and deformed ice tracers trpnd = 0 ! set to 1 for melt pond tracers trbgcs = 0 ! set to 1 for skeletal layer tracers (needs + ndtd = 1 ! dynamic time steps per thermodynamic time step !----------------------------------------------------------------- ! Read namelist env_nml @@ -249,7 +249,8 @@ module subroutine set_icepack() ! Derived quantities used by the icepack model !----------------------------------------------------------------- - nx = myDim_nod2D + eDim_nod2D + nx = myDim_nod2D + eDim_nod2D + nx_elem = myDim_elem2D + eDim_elem2D ncat = nicecat ! number of categories nfsd = nfsdcat ! number of floe size categories @@ -331,7 +332,6 @@ module subroutine set_icepack() ! other default values !----------------------------------------------------------------- - ndtd = 1 ! dynamic time steps per thermodynamic time step l_mpond_fresh = .false. ! logical switch for including meltpond freshwater ! flux feedback to ocean model oceanmixed_ice = .false. ! if true, use internal ocean mixed layer @@ -395,16 +395,14 @@ module subroutine set_icepack() ! set up diagnostics output and resolve conflicts !----------------------------------------------------------------- - if (mype == 0) write(*,*) 'Diagnostic output will be in files ' - if (mype == 0) write(*,*) ' ','icepack.diagnostics' - if (mype == 0) write(*,*) ' Error output will be in files ' - if (mype == 0) write(*,*) ' ','icepack.errors' + if (mype == 0) write(*,*) 'Diagnostic output will be in file ' + if (mype == 0) write(*,*) ' icepack.diagnostics' diag_filename = 'icepack.diagnostics' open (nu_diag, file=diag_filename, status='unknown', iostat=diag_error) if (diag_error /= 0) then if (mype == 0) write(*,*) 'Error while opening diagnostic file' - call icedrv_system_abort(file=__FILE__,line=__LINE__) + if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) endif if (mype == 0) write(nu_diag,*) '-----------------------------------' @@ -416,7 +414,7 @@ module subroutine set_icepack() if (mype == 0) write (nu_diag,*) 'Remapping the ITD is not allowed for ncat=1.' if (mype == 0) write (nu_diag,*) 'Use kitd = 0 (delta function ITD) with kcatbound = 0' if (mype == 0) write (nu_diag,*) 'or for column configurations use kcatbound = -1' - call icedrv_system_abort(file=__FILE__,line=__LINE__) + if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) endif if (ncat /= 1 .and. kcatbound == -1) then @@ -438,7 +436,7 @@ module subroutine set_icepack() if (rpcesm + rplvl + rptopo > c1 + puny) then if (mype == 0) write (nu_diag,*) 'WARNING: Must use only one melt pond scheme' - call icedrv_system_abort(file=__FILE__,line=__LINE__) + if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) endif if (tr_pond_lvl .and. .not. tr_lvl) then @@ -470,7 +468,7 @@ module subroutine set_icepack() if (mype == 0) write (nu_diag,*) 'WARNING: aerosols activated but' if (mype == 0) write (nu_diag,*) 'WARNING: not allocated in tracer array.' if (mype == 0) write (nu_diag,*) 'WARNING: Activate in compilation script.' - call icedrv_system_abort(file=__FILE__,line=__LINE__) + if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) endif if (tr_aero .and. trim(shortwave) /= 'dEdd') then @@ -524,6 +522,7 @@ module subroutine set_icepack() if (mype == 0) write (nu_diag,*) 'WARNING: formdrag=T but tr_lvl=F' if (mype == 0) write (nu_diag,*) 'WARNING: Setting tr_lvl=T' tr_lvl = .true. + max_ntrcr = max_ntrcr + 2 ! tr_lvl brings two more tracers endif endif @@ -563,7 +562,7 @@ module subroutine set_icepack() write(nu_diag,1030) ' shortwave = ', trim(shortwave) write(nu_diag,1000) ' -------------------------------' write(nu_diag,1000) ' BGC coupling is switched OFF ' - write(nu_diag,1000) ' not implemented in this version' + write(nu_diag,1000) ' not implemented with FESOM2 ' write(nu_diag,1000) ' -------------------------------' if (trim(shortwave) == 'dEdd') then @@ -719,44 +718,48 @@ module subroutine set_icepack() endif if (ntrcr > max_ntrcr-1) then - write(nu_diag,*) 'max_ntrcr-1 < number of namelist tracers' - write(nu_diag,*) 'max_ntrcr-1 = ',max_ntrcr-1,' ntrcr = ',ntrcr - call icedrv_system_abort(file=__FILE__,line=__LINE__) + if (mype == 0) write(nu_diag,*) 'max_ntrcr-1 < number of namelist tracers' + if (mype == 0) write(nu_diag,*) 'max_ntrcr-1 = ',max_ntrcr-1,' ntrcr = ',ntrcr + if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) endif - write(nu_diag,*) ' ' - write(nu_diag,1020) 'max_ntrcr = ', max_ntrcr - write(nu_diag,1020) 'ntrcr = ' , ntrcr - write(nu_diag,*) ' ' - write(nu_diag,1020) 'nt_sice = ', nt_sice - write(nu_diag,1020) 'nt_qice = ', nt_qice - write(nu_diag,1020) 'nt_qsno = ', nt_qsno - write(nu_diag,*)' ' - write(nu_diag,1020) 'ncat = ', ncat - write(nu_diag,1020) 'nilyr = ', nilyr - write(nu_diag,1020) 'nslyr = ', nslyr - write(nu_diag,1020) 'nblyr = ', nblyr - write(nu_diag,1020) 'nfsd = ', nfsd - write(nu_diag,1020) 'n_aero = ', n_aero + if (mype == 0) then - if (formdrag) then - if (nt_apnd==0) then - write(nu_diag,*)'ERROR: nt_apnd:',nt_apnd - call icedrv_system_abort(file=__FILE__,line=__LINE__) - elseif (nt_hpnd==0) then - write(nu_diag,*)'ERROR: nt_hpnd:',nt_hpnd - call icedrv_system_abort(file=__FILE__,line=__LINE__) - elseif (nt_ipnd==0) then - write(nu_diag,*)'ERROR: nt_ipnd:',nt_ipnd - call icedrv_system_abort(file=__FILE__,line=__LINE__) - elseif (nt_alvl==0) then - write(nu_diag,*)'ERROR: nt_alvl:',nt_alvl - call icedrv_system_abort(file=__FILE__,line=__LINE__) - elseif (nt_vlvl==0) then - write(nu_diag,*)'ERROR: nt_vlvl:',nt_vlvl - call icedrv_system_abort(file=__FILE__,line=__LINE__) + write(nu_diag,*) ' ' + write(nu_diag,1020) 'max_ntrcr = ', max_ntrcr + write(nu_diag,1020) 'ntrcr = ' , ntrcr + write(nu_diag,*) ' ' + write(nu_diag,1020) 'nt_sice = ', nt_sice + write(nu_diag,1020) 'nt_qice = ', nt_qice + write(nu_diag,1020) 'nt_qsno = ', nt_qsno + write(nu_diag,*)' ' + write(nu_diag,1020) 'ncat = ', ncat + write(nu_diag,1020) 'nilyr = ', nilyr + write(nu_diag,1020) 'nslyr = ', nslyr + write(nu_diag,1020) 'nblyr = ', nblyr + write(nu_diag,1020) 'nfsd = ', nfsd + write(nu_diag,1020) 'n_aero = ', n_aero + + if (formdrag) then + if (nt_apnd==0) then + write(nu_diag,*)'ERROR: nt_apnd:',nt_apnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_hpnd==0) then + write(nu_diag,*)'ERROR: nt_hpnd:',nt_hpnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_ipnd==0) then + write(nu_diag,*)'ERROR: nt_ipnd:',nt_ipnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_alvl==0) then + write(nu_diag,*)'ERROR: nt_alvl:',nt_alvl + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_vlvl==0) then + write(nu_diag,*)'ERROR: nt_vlvl:',nt_vlvl + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif endif - endif + + endif ! mype == 0 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements 1005 format (a30,2x,f9.6) ! float @@ -814,6 +817,8 @@ module subroutine set_icepack() if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) + call mpi_barrier(mpi_comm_fesom,mpi_error) + end subroutine set_icepack !======================================================================= @@ -840,8 +845,8 @@ module subroutine set_grid_icepack(mesh) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) - coord_nod2D(1:2,1:nx) => mesh%coord_nod2D - + coord_nod2D(1:2,1:nx) => mesh%coord_nod2D + !----------------------------------------------------------------- ! create hemisphereic masks !----------------------------------------------------------------- @@ -854,6 +859,13 @@ module subroutine set_grid_icepack(mesh) if (coord_nod2D(2,i) < -puny) lmask_s(i) = .true. ! S. Hem. enddo + !----------------------------------------------------------------- + ! longitudes and latitudes + !----------------------------------------------------------------- + + lon_val(:) = coord_nod2D(1,:) + lat_val(:) = coord_nod2D(2,:) + end subroutine set_grid_icepack !======================================================================= From c406cf68d634b85bccd5170fd42fb2ee7ee63f27 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 22 May 2020 18:03:16 +0200 Subject: [PATCH 14/54] Initialization state variables --- src/icepack_drivers/icedrv_init.F90 | 219 ++++++++++++++++++++++------ src/icepack_drivers/icedrv_main.F90 | 5 + 2 files changed, 181 insertions(+), 43 deletions(-) diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 3fc2dc3dd..25e8cd64e 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -198,48 +198,7 @@ module subroutine init_state() ! Set state variables !----------------------------------------------------------------- - !call set_state_var (nx, & - ! Tair (:), sst (:), & - ! Tf (:), & - ! salinz(:,:), Tmltz(:,:), & - ! aicen (:,:), trcrn(:,:,:), & - ! vicen (:,:), vsnon(:,:)) - - !----------------------------------------------------------------- - ! compute aggregate ice state and open water area - !----------------------------------------------------------------- - - do i = 1, nx - aice(i) = c0 - vice(i) = c0 - vsno(i) = c0 - do it = 1, max_ntrcr - trcr(i,it) = c0 - enddo - - call icepack_aggregate(ncat=ncat, & - trcrn=trcrn(i,1:ntrcr,:), & - aicen=aicen(i,:), & - vicen=vicen(i,:), & - vsnon=vsnon(i,:), & - trcr=trcr (i,1:ntrcr), & - aice=aice (i), & - vice=vice (i), & - vsno=vsno (i), & - aice0=aice0(i), & - 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,:)) - - aice_init(i) = aice(i) - - enddo - - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & - file=__FILE__, line=__LINE__) + call init_state_var end subroutine init_state @@ -956,10 +915,184 @@ module subroutine init_icepack(mesh) call init_shortwave ! initialize radiative transfer using current swdn call init_flux_atm_ocn ! initialize atmosphere, ocean fluxes - end subroutine + end subroutine init_icepack + +!======================================================================= + + module subroutine init_state_var () + + use icepack_intfc, only: icepack_init_fsd + use icepack_intfc, only: icepack_aggregate + + implicit none + + ! local variables + + integer (kind=int_kind) :: & + i , & ! horizontal indices + k , & ! ice layer index + n , & ! thickness category index + it ! tracer index + + real (kind=dbl_kind) :: & + Tsfc, sum, hbar, & + rhos, Lfresh, puny + + real (kind=dbl_kind), dimension(ncat) :: & + ainit, hinit ! initial area, thickness + + real (kind=dbl_kind), dimension(nilyr) :: & + qin ! ice enthalpy (J/m3) + + real (kind=dbl_kind), dimension(nslyr) :: & + qsn ! snow enthalpy (J/m3) + + real (kind=dbl_kind), parameter :: & + hsno_init = 0.25_dbl_kind ! initial snow thickness (m) + + logical (kind=log_kind) :: tr_brine, tr_lvl, tr_fsd + integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, nt_sice, nt_fsd + integer (kind=int_kind) :: nt_fbri, nt_alvl, nt_vlvl, ntrcr + + character(len=char_len_long), parameter :: ice_ic='default' + character(len=*), parameter :: subname='(set_state_var)' + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl, & + tr_fsd_out=tr_fsd) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_query_tracer_indices( nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & + nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fsd_out=nt_fsd, & + nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) + call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + ! Initialize state variables. + ! If restarting, these values are overwritten. + !----------------------------------------------------------------- + + do n = 1, ncat + do i = 1, nx + aicen(i,n) = c0 + vicen(i,n) = c0 + vsnon(i,n) = c0 + trcrn(i,nt_Tsfc,n) = Tf(i) ! surface temperature + if (max_ntrcr >= 2) then + do it = 2, max_ntrcr + trcrn(i,it,n) = c0 + enddo + endif + if (tr_lvl) trcrn(i,nt_alvl,n) = c1 + if (tr_lvl) trcrn(i,nt_vlvl,n) = c1 + if (tr_brine) trcrn(i,nt_fbri,n) = c1 + do k = 1, nilyr + trcrn(i,nt_sice+k-1,n) = salinz(i,k) + enddo + do k = 1, nslyr + trcrn(i,nt_qsno+k-1,n) = -rhos * Lfresh + enddo + enddo + ainit(n) = c0 + hinit(n) = c0 + enddo + + if (3 <= ncat) then + n = 3 + ainit(n) = c1 ! assumes we are using the default ITD boundaries + hinit(n) = c2 + else + ainit(ncat) = c1 + hinit(ncat) = c2 + endif + + do i = 1, nx + if (sst(i) <= Tf(i)) then + do n = 1, ncat + ! ice volume, snow volume + aicen(i,n) = ainit(n) + vicen(i,n) = hinit(n) * ainit(n) ! m + vsnon(i,n) = c0 + ! tracers + call icepack_init_trcr(Tair = T_air(i), & + Tf = Tf(i), & + Sprofile = salinz(i,:), & + Tprofile = Tmltz(i,:), & + Tsfc = Tsfc, & + nilyr=nilyr, nslyr=nslyr, & + qin=qin(:), qsn=qsn(:)) + + ! floe size distribution + if (tr_fsd) call icepack_init_fsd(nfsd=nfsd, ice_ic=ice_ic, & + floe_rad_c=floe_rad_c, & + floe_binwidth=floe_binwidth, & + afsd=trcrn(i,nt_fsd:nt_fsd+nfsd-1,n)) + ! surface temperature + trcrn(i,nt_Tsfc,n) = Tsfc ! deg C + ! ice enthalpy, salinity + do k = 1, nilyr + trcrn(i,nt_qice+k-1,n) = qin(k) + trcrn(i,nt_sice+k-1,n) = salinz(i,k) + enddo + ! snow enthalpy + do k = 1, nslyr + trcrn(i,nt_qsno+k-1,n) = qsn(k) + enddo ! nslyr + ! brine fraction + if (tr_brine) trcrn(i,nt_fbri,n) = c1 + enddo ! ncat + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + endif + enddo + + !----------------------------------------------------------------- + ! compute aggregate ice state and open water area + !----------------------------------------------------------------- + + do i = 1, nx + aice(i) = c0 + vice(i) = c0 + vsno(i) = c0 + do it = 1, max_ntrcr + trcr(i,it) = c0 + enddo + + call icepack_aggregate(ncat=ncat, & + trcrn=trcrn(i,1:ntrcr,:), & + aicen=aicen(i,:), & + vicen=vicen(i,:), & + vsnon=vsnon(i,:), & + trcr=trcr (i,1:ntrcr), & + aice=aice (i), & + vice=vice (i), & + vsno=vsno (i), & + aice0=aice0(i), & + 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,:)) + + aice_init(i) = aice(i) + + enddo + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine init_state_var !======================================================================= end submodule icedrv_init + !======================================================================= diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 1ed823553..63dcb4af9 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -813,6 +813,11 @@ module subroutine init_fsd() implicit none end subroutine init_fsd + ! Initialize state variables + module subroutine init_state_var() + implicit none + end subroutine init_state_var + ! Initialize all module subroutine init_icepack(mesh) use mod_mesh From 8b2f539466ce0f7ffe1c95db63448fe5f98ab34e Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 27 May 2020 09:54:20 +0200 Subject: [PATCH 15/54] Partial advection implementation --- src/icepack_drivers/icedrv_advection.F90 | 824 +++++++++++++++++++++++ src/icepack_drivers/icedrv_allocate.F90 | 24 +- src/icepack_drivers/icedrv_init.F90 | 45 +- src/icepack_drivers/icedrv_main.F90 | 24 +- src/icepack_drivers/icedrv_set.F90 | 6 +- 5 files changed, 903 insertions(+), 20 deletions(-) create mode 100644 src/icepack_drivers/icedrv_advection.F90 diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 new file mode 100644 index 000000000..5d60b974c --- /dev/null +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -0,0 +1,824 @@ +!======================================================================= +! +! This submodule contains the subroutines +! for the advection of sea ice tracers +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + +module icedrv_advection + + use icedrv_kinds + use icedrv_constants + use icedrv_system, only: icedrv_system_abort + + implicit none + + public :: fct_init_icepack, tracer_advection_icepack + + private + + real(kind=dbl_kind), allocatable, dimension(:) :: & + d_tr, trl, & + rhs_tr, rhs_trdiv, & + icepplus, iceppminus, & + icefluxes, mass_matrix + + ! Variables needed for advection + + contains + + subroutine tg_rhs_icepack(mesh, trc) + + use mod_mesh + use i_arrays + use i_param + use g_parsup + use o_param + use g_config + + implicit none + + ! Input - output + + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(:), intent(inout) :: trc + + ! Local variables + + real(kind=dbl_kind) :: diff, um, vm, vol, & + entries(3), dx(3), dy(3) + integer(kind=int_kind) :: n, q, row, & + elem, elnodes(3) + + #include "associate_mesh.h" + + ! Taylor-Galerkin (Lax-Wendroff) rhs + + do row = 1, nx_nh + rhs_tr(row)=c0 + enddo + + ! Velocities at nodes + + do elem = 1, nx_elem_nh !assembling rhs over elements + + elnodes = elem2D_nodes(:,elem) + + ! Derivatives + dx = gradient_sca(1:3,elem) + dy = gradient_sca(4:6,elem) + vol = elem_area(elem) + um = sum(uvel_elem(elnodes)) + vm = sum(vvel_elem(elnodes)) + + ! Diffusivity + + diff = ice_diff * sqrt( elem_area(elem) / scale_area ) + do n = 1, 3 + row = elnodes(n) + do q = 1, 3 + entries(q) = vol*ice_dt*((dx(n)*(um+uvel_elem(elnodes(q))) + & + dy(n)*(vm+vvel_elem(elnodes(q))))/12.0_WP - & + diff*(dx(n)*dx(q)+ dy(n)*dy(q)) - & + 0.5_WP*ice_dt*(um*dx(n)+vm*dy(n))*(um*dx(q)+vm*dy(q))/9.0_WP) + enddo + rhs_tr(row)=rhs_tr(row)+sum(entries*trc(elnodes)) + enddo + enddo + + end subroutine tg_rhs_icepack + + !======================================================================= + + subroutine fct_init_icepack(mesh) + + use o_param + use o_mesh + use i_arrays + use g_parsup + + type(t_mesh), intent(in), target :: mesh + + implicit none + + ! Initialization of arrays necessary to implement FCT algorithm + allocate(trl(nx)) ! low-order solutions + allocate(d_tr(nx)) ! increments of high + ! order solutions + allocate(icefluxes(nx_elem_nh, 3)) + allocate(icepplus(nx), icepminus(nx)) + allocate(rhs_tr(n_nx), rhs_trdiv(nx)) + allocate(mass_matrix(sum(nn_num(1:nx_nh)))) + + + trl(:) = c0 + d_tr(:) = c0 + rhs_tr(:) = c0 + rhs_trdiv(:) = c0 + icefluxes(:,:) = c0 + icepplus(:) = c0 + icepminus(:) = c0 + mass_matrix(:,:) = c0 + + ! Fill in the mass matrix + call fill_mass_matrix_icepack(mesh) + + if (mype==0) write(*,*) 'Icepack FCT is initialized' + + end subroutine fct_init_icepack + + !======================================================================= + + subroutine fill_mass_matrix_icepack(mesh) + + use mod_mesh + use o_mesh + use i_param + use i_arrays + use g_parsup + + implicit none + + integer(kind=int_kind) :: n, n1, n2, row + integer(kind=int_kind) :: elem, elnodes(3), q, offset, col, ipos + integer(kind=int_kind), allocatable :: col_pos(:) + real(kind=dbl_kind) :: aa + integer(kind=int_kind) :: flag=0 ,iflag=0 + type(t_mesh), intent(in), target :: mesh + + #include "associate_mesh.h" + + allocate(col_pos(nx)) + + do elem=1,nx_elem_nh + elnodes=elem2D_nodes(:,elem) + do n = 1, 3 + row = elnodes(n) + if ( row > nx_nh ) cycle + ! Global-to-local neighbourhood correspondence + do q = 1, nn_num(row) + col_pos(nn_pos(q,row))=q + enddo + offset = ssh_stiff%rowptr(row) - ssh_stiff%rowptr(1) + do q = 1, 3 + col = elnodes(q) + ipos = offset+col_pos(col) + mass_matrix(ipos) = mass_matrix(ipos) + elem_area(elem) / 12.0_WP + if ( q == n ) then + mass_matrix(ipos) = mass_matrix(ipos) + elem_area(elem) / 12.0_WP + end if + enddo + enddo + enddo + + ! TEST: area == sum of row entries in mass_matrix: + do q = 1, nx_nh + offset = ssh_stiff%rowptr(q) - ssh_stiff%rowptr(1) + 1 + n = ssh_stiff%rowptr(q+1) - ssh_stiff%rowptr(1) + aa = sum(mass_matrix(offset:n)) + if ( abs(area(1,q)-aa) > p1) then + iflag = q + flag = 1 + endif + enddo + + if ( flag > 0 ) then + offset = ssh_stiff%rowptr(iflag) - ssh_stiff%rowptr(1)+1 + n = ssh_stiff%rowptr(iflag+1) - ssh_stiff%rowptr(1) + aa = sum(mass_matrix(offset:n)) + + write(*,*) '#### MASS MATRIX PROBLEM', mype, iflag, aa, area(1,iflag) + endif + deallocate(col_pos) + + end subroutine fill_mass_matrix_icepack + + !======================================================================= + + subroutine solve_low_order_icepack(mesh, trc) + + !============================ + ! Low-order solution + !============================ + ! + ! It is assumed that m_ice, a_ice and m_snow from the previous time step + ! are known at 1:myDim_nod2D+eDim_nod2D. + ! We add diffusive contribution to the rhs. The diffusion operator + ! is implemented as the difference between the consistent and lumped mass + ! matrices acting on the field from the previous time step. The consistent + ! mass matrix on the lhs is replaced with the lumped one. + + use mod_mesh + use o_mesh + use i_arrays + use i_parm + use g_parsup + use g_comm_auto + + implicit none + + integer(kind=int_kind) :: row, clo, clo2, cn, location(100) + real (kind=dbl_kind) :: gamma + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(:), intent(inout) :: trc + + #include "associate_mesh.h" + + gamma = ice_gamma_fct ! Added diffusivity parameter + ! Adjust it to ensure posivity of solution + + do row = 1, nx_nh + clo = ssh_stiff%rowptr(row) - ssh_stiff%rowptr(1) + 1 + clo2 = ssh_stiff%rowptr(row+1) - ssh_stiff%rowptr(1) + cn = clo2 - clo + 1 + location(1:cn) = nn_pos(1:cn, row) + trl(row) = (rhs_tr(row) + gamma * sum(mass_matrix(clo:clo2) * & + trc(location(1:cn)))) / area(1,row) + & + (1.0_WP-gamma) * trc(row) + enddo + + call exchange_nod(trl) + + ! Low-order solution must be known to neighbours + + end subroutine solve_low_order_icepack + + !======================================================================= + + subroutine solve_high_order_icepack(mesh, trc) + + use mod_mesh + use o_mesh + use i_arrays + use i_parm + use g_parsup + use g_comm_auto + + implicit none + + integer(kind=int_kind) :: n,i,clo,clo2,cn,location(100),row + real (kind=double_kind) :: rhs_new + integer(kind=int_kind), parameter :: num_iter_solve = 3 + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(:), intent(inout) :: trc + + #include "associate_mesh.h" + + ! Taylor-Galerkin solution + + ! First guess solution + do row = 1, nx_nh + d_tr(row) = rhs_tr(row) / area(1,row) + end do + + call exchange_nod(d_tr) + + ! Iterate + do n = 1, num_iter_solve - 1 + do row = 1, nx_nh + clo = ssh_stiff%rowptr(row) - ssh_stiff%rowptr(1) + 1 + clo2 = ssh_stiff%rowptr(row+1) - ssh_stiff%rowptr(1) + cn = clo2 - clo + 1 + location(1:cn) = nn_pos(1:cn,row) + rhs_new = rhs_tr(row) - sum(mass_matrix(clo:clo2) * d_tr(location(1:cn))) + trl(row) = d_tr(row) + rhs_new / area(1,row) + enddo + do row = 1, nx_nh + d_tr(row) = trl(row) + enddo + call exchange_nod(d_tr) + enddo + + end subroutine solve_high_order_icepack + + !======================================================================= + + subroutine fem_fct_icepack(mesh, trc) + + !============================ + ! Flux corrected transport algorithm for tracer advection + !============================ + ! + ! It is based on Loehner et al. (Finite-element flux-corrected + ! transport (FEM-FCT) for the Euler and Navier-Stokes equation, + ! Int. J. Numer. Meth. Fluids, 7 (1987), 1093--1109) as described by Kuzmin and + ! Turek. (kuzmin@math.uni-dortmund.de) + + use mod_mesh + use o_mesh + use i_arrays + use o_param + use i_parm + use g_parsup + use g_comm_auto + + integer(kind=int_kind) :: icoef(3,3), n, q, elem, elnodes(3), row + real (kind=dbl_kind), allocatable, dimension(:) :: tmax, tmin + real (kind=dbl_kind) :: vol, flux, ae, gamma + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(:), intent(inout) :: trc + + #include "associate_mesh.h" + + gamma = ice_gamma_fct ! It should coinside with gamma in + ! ts_solve_low_order + + !========================== + ! Compute elemental antidiffusive fluxes to nodes + !========================== + ! This is the most unpleasant part --- + ! it takes memory and time. For every element + ! we need its antidiffusive contribution to + ! each of its 3 nodes + + allocate(tmax(nx_nh), tmin(nx_nh)) + + ! Auxiliary elemental operator (mass matrix- lumped mass matrix) + + icoef = 1 + + do n = 1, 3 ! three upper nodes + ! Cycle over rows row=elnodes(n) + icoef(n,n) = -2 + enddo + + do elem = 1, nx_elem_nh + elnodes = elem2D_nodes(:,elem) + vol = elem_area(elem) + do q = 1, 3 + icefluxes(elem,q) = -sum(icoef(:,q) * (gamma * trc(elnodes) + & + d_tr(elnodes))) * (vol / area(1,elnodes(q))) / 12.0_WP + enddo + enddo + + !========================== + ! Screening the low-order solution + !========================== + ! TO BE ADDED IF FOUND NECESSARY + ! Screening means comparing low-order solutions with the + ! solution on the previous time step and using whichever + ! is greater/smaller in computations of max/min below + + !========================== + ! Cluster min/max + !========================== + + do row = 1, nx_nh + n = nn_num(row) + tmax(row) = maxval(trl(nn_pos(1:n,row))) + tmin(row) = minval(trl(nn_pos(1:n,row))) + ! Admissible increments + tmax(row) = tmax(row) - trl(row) + tmin(row) = tmin(row) - trl(row) + enddo + + !========================= + ! Sums of positive/negative fluxes to node row + !========================= + + icepplus = c0 + icepminus = c0 + do elem = 1, nx_elem_nh + elnodes = elem2D_nodes(:,elem) + do q = 1, 3 + n = elnodes(q) + flux = icefluxes(elem,q) + if ( flux > 0 ) then + icepplus(n) = icepplus(n) + flux + else + icepminus(n) = icepminus(n) + flux + endif + enddo + enddo + + !======================== + ! The least upper bound for the correction factors + !======================== + + do n = 1, nx_nh + flux = icepplus(n) + if ( abs(flux) > 0 ) then + icepplus(n) = min(1.0,tmax(n) / flux) + else + icepplus(n) = c0 + endif + + flux = icepminus(n) + if ( abs(flux) > 0 ) then + icepminus(n) = min(1.0,tmin(n) / flux) + else + icepminus(n)=c0 + endif + enddo + + ! pminus and pplus are to be known to neighbouting PE + call exchange_nod(icepminus, icepplus) + + !======================== + ! Limiting + !======================== + + do elem = 1, nx_elem_nh + elnodes = elem2D_nodes(:,elem) + ae = c1 + do q = 1, 3 + n = elnodes(q) + flux = icefluxes(elem,q) + if ( flux >=c0 ) ae = min(ae, icepplus(n)) + if ( flux < c0 ) ae = min(ae, icepminus(n)) + enddo + icefluxes(elem,:) = ae * icefluxes(elem,:) + enddo + + + !========================== + ! Update the solution + !========================== + + do n = 1, nx_nh + trc(n) = trl(n) + end do + do elem = 1, nx_elem_nh + elnodes = elem2D_nodes(:,elem) + do q = 1, 3 + n = elnodes(q) + trc(n) = trc(n) + icefluxes(elem,q) + enddo + enddo + + call exchange_nod(trc) + + deallocate(tmin, tmax) + + end subroutine fem_fct_icepack + + !======================================================================= + + subroutine tg_rhs_div_icepack(mesh, trc) + + use mod_mesh + use o_mesh + use i_arrays + use o_param + use i_parm + use g_parsup + use g_comm_auto + + implicit none + + real (kind=dbl_kind) :: diff, entries(3), um, vm, vol, dx(3), dy(3) + integer(kind=int_kind) :: n, q, row, elem, elnodes(3) + real (kind=dbl_kind) :: c_1, c_2, c_3, c_4, c_x, entries2(3) + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(:), intent(inout) :: trc + + + #include "associate_mesh.h" + + ! Computes the rhs in a Taylor-Galerkin way (with urrayspwind + ! type of correction for the advection operator). + ! In this version I tr to split divergent term off, + ! so that FCT works without it. + + do row = 1, nx_nh + ! row=myList_nod2D(m) + rhs_tr(row) = c0 + rhs_trdiv(row) = c0 + enddo + + do elem = 1, nx_elem_nh !! assembling rhs over elements + !! elem=myList_elem2D(m) + elnodes = elem2D_nodes(:,elem) + + ! Derivatives + dx = gradient_sca(1:3,elem) + dy = gradient_sca(4:6,elem) + vol = elem_area(elem) + um = sum(uvel_elem(elnodes)) + vm = sum(vvel_elem(elnodes)) + + ! This is exact computation (no assumption of u=const + ! on elements used in the standard version) + c_1 = (um*um+sum(uvel_elem(elnodes)*uvel_elem(elnodes))) / 12.0_dbl_kind + c_2 = (vm*vm+sum(vvel_elem(elnodes)*vvel_elem(elnodes))) / 12.0_dbl_kind + c_3 = (um*vm+sum(vvel_elem(elnodes)*uvel_elem(elnodes))) / 12.0_dbl_kind + c_4 = sum(dx*uvel_elem(elnodes)+dy*vvel_elem(elnodes)) + + do n = 1, 3 + row = elnodes(n) + + do q = 1, 3 + entries(q) = vol*ice_dt*((c1-p5*ice_dt*c_4)*(dx(n)*(um+uvel_elem(elnodes(q)))+ & + dy(n)*(vm+vvel_elem(elnodes(q))))/12.0_dbl_kind - & + p5*ice_dt*(c_1*dx(n)*dx(q)+c_2*dy(n)*dy(q)+c_3*(dx(n)*dy(q)+dx(q)*dy(n)))) + entries2(q) = p5*ice_dt*(dx(n)*(um+uvel_elem(elnodes(q))) + & + dy(n)*(vm+vvel_elem(elnodes(q)))-dx(q)*(um+uvel_elem(row)) - & + dy(q)*(vm+vvel_elem(row))) + enddo + c_x = vol*ice_dt*c_4*(sum(trc(elnodes))+trc(elnodes(n))+sum(entries2*trc(elnodes))) / 12.0_dbl_kind + rhs_tr(row) = rhs_tr(row) + sum(entries * trc(elnodes)) + c_x + rhs_trdiv(row) = rhs_trdiv(row) - c_x + enddo + enddo + + end subroutine tg_rhs_div_icepack + + !======================================================================= + + subroutine update_for_div_icepack(mesh, trc) + + use mod_mesh + use o_mesh + use i_arrays + use o_param + use i_parm + use g_parsup + use g_comm_auto + + implicit none + + integer(kind=int_kind) :: n, i, clo, clo2, cn, & + location(100), row + real (kind=dbl_kind) :: rhs_new + integer(kind=int_kind), parameter :: num_iter_solve=3 + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(:), intent(inout) :: trc + + #include "associate_mesh.h" + + ! Computes Taylor-Galerkin solution + ! first approximation + + do row = 1, nx_nh + d_tr(row) = rhs_trdiv(row) / area(1,row) + enddo + + call exchange_nod(d_tr) + + ! Iterate + + do n = 1, num_iter_solve-1 + do row = 1, nx_nh + clo = ssh_stiff%rowptr(row) - ssh_stiff%rowptr(1) + 1 + clo2 = ssh_stiff%rowptr(row+1) - ssh_stiff%rowptr(1) + cn = clo2 - clo + 1 + location(1:cn) = nn_pos(1:cn, row) + rhs_new = rhs_trdiv(row) - sum(mass_matrix(clo:clo2) * d_tr(location(1:cn))) + trl(row) = d_tr(row) + rhs_new / area(1,row) + enddo + do row = 1, nx_nh + d_tr(row) = trl(row) + enddo + call exchange_nod(d_tr) + enddo + + trc = trc + d_tr + + end subroutine update_for_div_icepack + + !======================================================================= + + subroutine fct_solve_icepack(mesh, trc) + + implicit none + + real(kind=dbl_kind), dimension(:), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + + ! Driving sequence + call ice_TG_rhs_div(mesh, trc) + call solve_high_order_icepack(mesh, trc) ! uses arrays of low-order solutions as temp + ! storage. It should preceed the call of low + ! order solution. + call solve_low_order_icepack(mesh, trc) + call fem_fct_icepack(mesh, trc) + call ice_update_for_div(mesh, trc) + + end subroutine fct_solve_icepack + + !======================================================================= + + subroutine tracer_advection_icepack(mesh, trc) + + implicit none + + real(kind=dbl_kind), dimension(:), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + + + end subroutine tracer_advection_icepack + + !======================================================================= + + subroutine work_to_state (nx, & + ntrcr, & + narr, trcr_depend, & + aicen, trcrn, & + vicen, vsnon, & + aice0, works) + + use icedrv_main, only: ncat, nslyr, nilyr, salinz + use icepack_intfc + use icedrv_system, only: icedrv_system_abort + use icedrv_flux, only: salinz + + integer (kind=int_kind), intent(in) :: & + nx , & ! block dimensions + ntrcr , & ! number of tracers in use + narr ! number of 2D state variable arrays in works array + + integer (kind=int_kind), dimension (ntrcr), intent(in) :: & + trcr_depend ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon + + real (kind=dbl_kind), dimension (nx,ncat), intent(out) :: & + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) + + real (kind=dbl_kind), dimension (nx,ntrcr,ncat), intent(out) :: & + trcrn ! ice tracers + + real (kind=dbl_kind), dimension (nx), intent(out) :: & + aice0 ! concentration of open water + + real (kind=dbl_kind), dimension(nx,narr), intent (inout) :: & + works ! work array + + ! local variables + + integer (kind=int_kind) :: & + nt_alvl, nt_apnd, nt_fbri, nt_Tsfc, ktherm + + logical (kind=log_kind) :: & + tr_pond_cesm, tr_pond_lvl, tr_pond_topo, heat_capacity + + integer (kind=int_kind) :: & + k, i, n, it , & ! counting indices + narrays , & ! counter for number of state variable arrays + nt_qsno , & + nt_qice , & + nt_sice + + real (kind=dbl_kind) :: & + rhos , & + rhoi , & + Lfresh , & + Tsmelt + + real (kind=dbl_kind), dimension(ncat) :: & + tmp, exc, puny + + real (kind=dbl_kind), parameter :: & + small = 0.000001_dbl_kind + + character(len=*), parameter :: subname = '(state_to_work)' + + call icepack_query_tracer_flags(tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & + nt_fbri_out=nt_fbri, nt_qsno_out=nt_qsno, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_Tsfc_out=nt_Tsfc) + call icepack_query_parameters(rhoi_out=rhoi, rhos_out=rhoi, & + Lfresh_out=Lfresh, heat_capacity_out=heat_capacity, & + Tsmelt_out=Tsmelt, ktherm_out=ktherm, & + puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + ! Open water fraction + + trcrn(:,:,:) = c0 + aicen(:,:) = c0 + vicen(:,:) = c0 + vsnon(:,:) = c0 + + do i = 1, nx + if (works(i,1) <= puny) then + aice0(i) = c0 + else if (works(i,1) >= c1) then + aice0(i) = c1 + else + aice0(i) = works(i,1) + end if + enddo + narrays = 1 + + ! Sea ice area and volume per unit area of ice and snow + + do n=1,ncat + do i = 1, nx + if (works(i,narrays+1) > c1) then + works(i,narrays+1) = c1 + end if + if (works(i,narrays+1) <= small .or. works(i,narrays+2) <= small) then + works(i,narrays+1) = c0 + works(i,narrays+2) = c0 + works(i,narrays+3) = c0 + end if + if (works(i,narrays+3) <= small) then + works(i,narrays+3) = c0 + end if + aicen(i,n) = works(i,narrays+1) + vicen(i,n) = works(i,narrays+2) + vsnon(i,n) = works(i,narrays+3) + end do + + narrays = narrays + 3 + ntrcr + end do + + do i = 1, nx ! For each grid cell + if (sum(aicen(i,:)) > c1) then + tmp(:) = c0 + exc(:) = c0 + do n = 1, ncat + if (aicen(i,n) > puny) tmp(n) = c1 + end do + do n = 1, ncat + exc(n) = max(c0,(sum(aicen(i,:)) - c1)) & + * aicen(i,n) / sum(aicen(i,:)) + end do + do n = 1, ncat + aicen(i,n) = max(c0,aicen(i,n) - exc(n)) + aice0 = max(c0,sum(aicen(i,:))) + end do + end if + end do + + narrays = 1 + + do n=1, ncat + + narrays = narrays + 3 + + do it = 1, ntrcr + + if (trcr_depend(it) == 0) then + do i = 1, nx + if (aicen(i,n) > c0) then + if (it == nt_Tsfc) then + trcrn(i,it,n) = min(c0,works(i,narrays+it)/aicen(i,n)) + else + trcrn(i,it,n) = works(i,narrays+it) / aicen(i,n) + end if + end if + enddo + elseif (trcr_depend(it) == 1) then + do i = 1, nx + if (vicen(i,n) > c0) then + if (it >= nt_qice .and. it < nt_qice+nilyr) then + trcrn(i,it,n) = min(c0,works(i,narrays+it)/vicen(i,n)) + if (.not. heat_capacity) trcrn(i,it,n) = -rhoi * Lfresh + else if (it >= nt_sice .and. it < nt_sice+nilyr) then + trcrn(i,it,n) = max(c0,works(i,narrays+it)/vicen(i,n)) + end if + end if + enddo + elseif (trcr_depend(it) == 2) then + do i = 1, nx + if (vsnon(i,n) > c0) then + if (it >= nt_qsno .and. it < nt_qsno+nslyr) then + trcrn(i,it,n) = min(c0,works(i,narrays+it)/vsnon(i,n)) - rhos*Lfresh + if (.not. heat_capacity) trcrn(i,it,n) = -rhos * Lfresh + end if + end if + enddo + ! Tracers not yet checked or implemented + !elseif (trcr_depend(it) == 2+nt_alvl) then + ! do i = 1, nx + ! works(i,narrays+it) = aicen(i,n) & + ! * trcrn(i,nt_alvl,n) & + ! * trcrn(i,it,n) + ! enddo + !elseif (trcr_depend(it) == 2+nt_apnd .and. & + ! tr_pond_cesm .or. tr_pond_topo) then + ! do i = 1, nx + ! works(i,narrays+it) = aicen(i,n) & + ! * trcrn(i,nt_apnd,n) & + ! * trcrn(i,it,n) + ! enddo + !elseif (trcr_depend(it) == 2+nt_apnd .and. & + ! tr_pond_lvl) then + ! do i = 1, nx + ! works(i,narrays+it) = aicen(i,n) & + ! * trcrn(i,nt_alvl,n) & + ! * trcrn(i,nt_apnd,n) & + ! * trcrn(i,it,n) + ! enddo + !elseif (trcr_depend(it) == 2+nt_fbri) then + ! do i = 1, nx + ! works(i,narrays+it) = vicen(i,n) & + ! * trcrn(i,nt_fbri,n) & + ! * trcrn(i,it,n) + ! enddo + endif + enddo + + narrays = narrays + ntrcr + + enddo ! number of categories + + +end module icedrv_advection diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 index f436813a2..7ef1a847d 100644 --- a/src/icepack_drivers/icedrv_allocate.F90 +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -41,17 +41,19 @@ module subroutine alloc_state if (ierr/=0) write(*,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) - allocate ( & - aice (nx) , & ! concentration of ice - vice (nx) , & ! volume per unit area of ice (m) - vsno (nx) , & ! volume per unit area of snow (m) - aice0 (nx) , & ! concentration of open water - uvel (nx) , & ! x-component of velocity (m/s) - vvel (nx) , & ! y-component of velocity (m/s) - divu (nx) , & ! strain rate I component, velocity divergence (1/s) - shear (nx) , & ! strain rate II component (1/s) - strength (nx) , & ! ice strength (N/m) - aice_init (nx) , & ! initial concentration of ice, for diagnostics + allocate ( & + aice (nx) , & ! concentration of ice + vice (nx) , & ! volume per unit area of ice (m) + vsno (nx) , & ! volume per unit area of snow (m) + aice0 (nx) , & ! concentration of open water + uvel (nx) , & ! x-component of velocity (m/s) on the nodes + vvel (nx) , & ! y-component of velocity (m/s) on the nodes + uvel_elem (nx_elem) , & ! x-component of velocity (m/s) on the elements + vvel_elem (nx_elem) , & ! y-component of velocity (m/s) on the elements + divu (nx) , & ! strain rate I component, velocity divergence (1/s) + shear (nx) , & ! strain rate II component (1/s) + strength (nx) , & ! ice strength (N/m) + aice_init (nx) , & ! initial concentration of ice, for diagnostics aicen (nx,ncat) , & ! concentration of ice vicen (nx,ncat) , & ! volume per unit area of ice (m) vsnon (nx,ncat) , & ! volume per unit area of snow (m) diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 3fc2dc3dd..ac0f41731 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -22,6 +22,7 @@ use icepack_intfc, only: icepack_write_tracer_flags use icepack_intfc, only: icepack_write_tracer_indices use icepack_intfc, only: icepack_write_tracer_sizes + use icepack_intfc, only: icepack_init_wave use icedrv_system, only: icedrv_system_abort contains @@ -878,6 +879,46 @@ module subroutine init_fsd() end subroutine init_fsd +!======================================================================= + + subroutine init_wave_spec() + + ! local variables + integer (kind=int_kind) :: & + k + + real(kind=dbl_kind), dimension(nfreq) :: & + wave_spectrum_profile ! wave spectrum + + wave_spectrum(:,:) = c0 + + ! wave spectrum and frequencies + ! get hardwired frequency bin info and a dummy wave spectrum profile + call icepack_init_wave(nfreq=nfreq, & + wave_spectrum_profile=wave_spectrum_profile, & + wavefreq=wavefreq, dwavefreq=dwavefreq) + + do k = 1, nfreq + wave_spectrum(:,k) = wave_spectrum_profile(k) + enddo + + end subroutine init_wave_spec + +!======================================================================= + + subroutine init_faero() + + character(len=*), parameter :: subname='(faero_default)' + + faero_atm(:,1) = 1.e-12_dbl_kind ! kg/m^2 s + faero_atm(:,2) = 1.e-13_dbl_kind + faero_atm(:,3) = 1.e-14_dbl_kind + faero_atm(:,4) = 1.e-14_dbl_kind + faero_atm(:,5) = 1.e-14_dbl_kind + faero_atm(:,6) = 1.e-14_dbl_kind + + end subroutine faero_default + !======================================================================= module subroutine init_icepack(mesh) @@ -950,8 +991,8 @@ module subroutine init_icepack(mesh) call init_state ! initialize the ice state call init_history_therm ! initialize thermo history variables - !if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - !if (tr_aero .or. tr_zaero) call faero_default ! default aerosols values + if (tr_fsd .and. wave_spec) call init_wave_spec ! wave spectrum in ice + if (tr_aero .or. tr_zaero) call init_faero ! default aerosols values call init_shortwave ! initialize radiative transfer using current swdn call init_flux_atm_ocn ! initialize atmosphere, ocean fluxes diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 1ed823553..8ee659d87 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -37,6 +37,8 @@ module icedrv_main integer (kind=int_kind), save :: nx ! number of nodes and gost nodes for each mesh partition integer (kind=int_kind), save :: nx_elem ! number of elements and gost elements for each mesh partition + integer (kind=int_kind), save :: nx_nh ! number of nodes for each mesh partition (NO GOST CELLS) + integer (kind=int_kind), save :: nx_elem_nh ! number of elements for each mesh partition (NO GOST CELLS) integer (kind=int_kind), save :: ncat ! number of categories in use integer (kind=int_kind), save :: nfsd ! number of floe size categories in use integer (kind=int_kind), save :: nilyr ! number of ice layers per category in use @@ -96,11 +98,13 @@ module icedrv_main ! argument 2: (1) aice, (2) vice, (3) vsno real (kind=dbl_kind), allocatable, save :: & ! DIM nx - uvel(:) , & ! x-component of velocity (m/s) - vvel(:) , & ! y-component of velocity (m/s) - divu(:) , & ! strain rate I component, velocity divergence (1/s) - shear(:) , & ! strain rate II component (1/s) - strength(:) ! ice strength (N/m) + uvel(:) , & ! x-component of velocity (m/s) on the nodes + vvel(:) , & ! y-component of velocity (m/s) on the nodes + uvel_elem(:) , & ! x-component of velocity (m/s) on the elements + vvel_elem(:) , & ! y-component of velocity (m/s) on the elements + divu(:) , & ! strain rate I component, velocity divergence (1/s) + shear(:) , & ! strain rate II component (1/s) + strength(:) ! ice strength (N/m) real (kind=dbl_kind), allocatable, save :: & ! DIM nx aice_init(:) ! initial concentration of ice, for diagnostics @@ -813,6 +817,16 @@ module subroutine init_fsd() implicit none end subroutine init_fsd + ! Initialize wave spectrum + module subroutine init_wave_spec() + implicit none + end subroutine init_wave_spec + + ! Initialize constant aerosols values + module subroutine init_faero() + implicit none + end subroutine init_faero + ! Initialize all module subroutine init_icepack(mesh) use mod_mesh diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 4261922a1..74b2c3ce4 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -249,8 +249,10 @@ module subroutine set_icepack() ! Derived quantities used by the icepack model !----------------------------------------------------------------- - nx = myDim_nod2D + eDim_nod2D - nx_elem = myDim_elem2D + eDim_elem2D + nx = myDim_nod2D + eDim_nod2D + nx_elem = myDim_elem2D + eDim_elem2D + nx_nh = myDim_nod2D + nx_elem_nh = myDim_elem2D ncat = nicecat ! number of categories nfsd = nfsdcat ! number of floe size categories From 6fb01eeebbd54a4842dfb3d259f2ac0ebf28028a Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 27 May 2020 09:56:41 +0200 Subject: [PATCH 16/54] transfer implementation --- src/icepack_drivers/icedrv_allocate.F90 | 1 - src/icepack_drivers/icedrv_domain_size.F90 | 52 ------------ src/icepack_drivers/icedrv_init.F90 | 7 +- src/icepack_drivers/icedrv_main.F90 | 8 +- src/icepack_drivers/icedrv_transfer.F90 | 92 ++++++++++++++++++++++ 5 files changed, 103 insertions(+), 57 deletions(-) delete mode 100644 src/icepack_drivers/icedrv_domain_size.F90 create mode 100644 src/icepack_drivers/icedrv_transfer.F90 diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 index f436813a2..e3d608fb5 100644 --- a/src/icepack_drivers/icedrv_allocate.F90 +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -125,7 +125,6 @@ module subroutine alloc_flux vraftn(nx,ncat), & ! rafting ice volume aredistn(nx,ncat), & ! redistribution function: fraction of new ridge area vredistn(nx,ncat), & ! redistribution function: fraction of new ridge volume - zlvl(nx) , & ! atm level height (m) uatm(nx) , & ! wind velocity components (m/s) vatm(nx) , & wind(nx) , & ! wind speed (m/s) diff --git a/src/icepack_drivers/icedrv_domain_size.F90 b/src/icepack_drivers/icedrv_domain_size.F90 deleted file mode 100644 index f2345bca5..000000000 --- a/src/icepack_drivers/icedrv_domain_size.F90 +++ /dev/null @@ -1,52 +0,0 @@ -!======================================================================= -! -! Defines the domain size, number of categories and layers. -! -! author L. Zampieri -! -!======================================================================= - - module icedrv_domain_size - - use icedrv_kinds - -!======================================================================= - - implicit none - - public & - nx, ncat, nfsd, nilyr, nslyr, n_aero, n_zaero, n_algae, & - n_doc, n_dic, n_don, n_fed, n_fep, nblyr, n_bgc, nltrcr, & - max_nsw, max_ntrcr, nfreq, ndtd - - private - - ! setting variables used by the model - - integer (kind=int_kind), save :: nx ! number of grid cells and gost cells for each mesh partition - integer (kind=int_kind), save :: ncat ! number of categories in use - integer (kind=int_kind), save :: nfsd ! number of floe size categories in use - integer (kind=int_kind), save :: nilyr ! number of ice layers per category in use - integer (kind=int_kind), save :: nslyr ! number of snow layers per category in use - integer (kind=int_kind), save :: n_aero ! number of aerosols in use - integer (kind=int_kind), save :: n_zaero ! number of z aerosols in use - integer (kind=int_kind), save :: n_algae ! number of algae in use - integer (kind=int_kind), save :: n_doc ! number of DOC pools in use - integer (kind=int_kind), save :: n_dic ! number of DIC pools in use - integer (kind=int_kind), save :: n_don ! number of DON pools in use - integer (kind=int_kind), save :: n_fed ! number of Fe pools in use dissolved Fe - integer (kind=int_kind), save :: n_fep ! number of Fe pools in use particulate Fe - integer (kind=int_kind), save :: nblyr ! number of bio/brine layers per category - integer (kind=int_kind), save :: n_bgc ! nit, am, sil, dmspp, dmspd, dms, pon, humic - integer (kind=int_kind), save :: nltrcr ! number of zbgc (includes zaero) and zsalinity tracers - integer (kind=int_kind), save :: max_nsw ! number of tracers active in shortwave calculation - integer (kind=int_kind), save :: max_ntrcr ! number of tracers in total - integer (kind=int_kind), save :: nfreq ! number of wave frequencies ! HARDWIRED FOR NOW - integer (kind=int_kind), save :: ndtd ! dynamic time steps per thermodynamic time step - -!======================================================================= - - end module icedrv_domain_size - -!======================================================================= - diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 25e8cd64e..9942d3d52 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -1,6 +1,6 @@ !======================================================================= ! -! This module initializes the icepack variables +! This submodule initializes the icepack variables ! ! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) ! @@ -242,7 +242,10 @@ module subroutine init_coupler_flux() !----------------------------------------------------------------- ! fluxes received from atmosphere !----------------------------------------------------------------- - zlvl (:) = c10 ! atm level height (m) + zlvl_t = c10 ! atm level height for temperature (m) + zlvl_q = c10 ! atm level height for humidity (m) + zlvl_v = c10 ! atm level height for wind (m) + rhoa (:) = 1.3_dbl_kind ! air density (kg/m^3) uatm (:) = c5 ! wind velocity (m/s) vatm (:) = c5 diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 63dcb4af9..98a87f0d9 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -155,9 +155,13 @@ module icedrv_main vredistn(:,:) ! redistribution function: fraction of new ridge volume ! in from atmosphere (if calc_Tsfc) - + + real (kind=dbl_kind), save :: & + zlvl_t , & ! atm level height for temperature (m) + zlvl_q , & ! atm level height for humidity (m) + zlvl_v ! atm level height for wind (m) + real (kind=dbl_kind), allocatable, save :: & ! DIM nx - zlvl(:) , & ! atm level height (m) uatm(:) , & ! wind velocity components (m/s) vatm(:) , & wind(:) , & ! wind speed (m/s) diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 new file mode 100644 index 000000000..c1ce2d19b --- /dev/null +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -0,0 +1,92 @@ +!======================================================================= +! +! This submodule exchanges variables between icepack and fesom2 +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + + submodule (icedrv_main) icedrv_transfer + + contains + + module subroutine fesom_to_icepack() + + implicit none + + character(len=*), parameter :: subname='(fesom_to_icepack)' + + real (kind=dbl_kind), parameter :: & + frcvdr = 0.28_dbl_kind, & ! frac of incoming sw in vis direct band + frcvdf = 0.24_dbl_kind, & ! frac of incoming sw in vis diffuse band + frcidr = 0.31_dbl_kind, & ! frac of incoming sw in near IR direct band + frcidf = 0.17_dbl_kind, & ! frac of incoming sw in near IR diffuse band + ex = 0.286_dbl_kind + + use g_forcing_arrays, only: Tair, shum, u_wind, v_wind, & ! Atmospheric forcing fields + shortwave, longwave, prec_rain, & + prec_snow, press_air + use g_forcing_param, only: ncar_bulk_z_wind, ncar_bulk_z_tair, & + ncar_bulk_z_shum + use g_sbf, only: l_mslp + use i_arrays, only: S_oc_array, T_oc_array, & ! Ocean and sea ice field + u_w, v_w, & + u_ice, v_ice + + ! Ice + + uvel(:) = u_ice(:) + vvel(:) = v_ice(:) + + ! Atmosphere + + T_air(:) = Tair(:) + 273.15_dbl_kind + Qa(:) = shum(:) + uatm(:) = u_wind(:) + vatm(:) = v_wind(:) + fsw(:) = shortwave(:) + flw(:) = longwave(:) + frain(:) = prec_rain(:) * 1000.0_dbl_kind + fsnow(:) = prec_snow(:) * 1000.0_dbl_kind + + zlvl_t = ncar_bulk_z_tair + zlvl_q = ncar_bulk_z_shum + zlvl_v = ncar_bulk_z_wind + + if ( l_mslp ) then + potT(:) = T_air(:)*(press_air(:)/100000.0_dbl_kind)^ex + else + potT(:) = T_air(:) + endif + + ! Ocean + + sst(:) = T_oc_array(:) + sstdat(:) = T_oc_array(:) + sss(:) = S_oc_array(:) + uocn(:) = u_w(:) + vocn(:) = v_w(:) + + ! divide shortwave into spectral bands + swvdr = fsw*frcvdr ! visible direct + swvdf = fsw*frcvdf ! visible diffuse + swidr = fsw*frcidr ! near IR direct + swidf = fsw*frcidf ! near IR diffuse + + end subroutine fesom_to_icepack + +!======================================================================= + + + module subroutine icepack_to_fesom() + + implicit none + + +!======================================================================= + + end subroutine icepack_to_fesom + +!======================================================================= + + end submodule icedrv_transfer From 6bcbfb7cabe95247fed457d9cb0eabf1a971cba1 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 28 May 2020 15:13:27 +0200 Subject: [PATCH 17/54] Code compiles with advection and transfer --- src/icepack_drivers/icedrv_advection.F90 | 1030 ++++++++++++++++------ src/icepack_drivers/icedrv_allocate.F90 | 16 +- src/icepack_drivers/icedrv_init.F90 | 81 +- src/icepack_drivers/icedrv_main.F90 | 105 ++- src/icepack_drivers/icedrv_oml.F90 | 106 +++ src/icepack_drivers/icedrv_transfer.F90 | 131 ++- 6 files changed, 1145 insertions(+), 324 deletions(-) create mode 100644 src/icepack_drivers/icedrv_oml.F90 diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index 5d60b974c..cdaf5c3ed 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -7,23 +7,29 @@ ! !======================================================================= -module icedrv_advection +submodule (icedrv_main) icedrv_advection use icedrv_kinds use icedrv_constants use icedrv_system, only: icedrv_system_abort + use g_comm_auto, only: exchange_nod + use icepack_intfc, only: icepack_warnings_flush, & + icepack_warnings_aborted, & + icepack_query_tracer_indices, & + icepack_query_tracer_flags, & + icepack_query_parameters, & + icepack_query_tracer_sizes implicit none - public :: fct_init_icepack, tracer_advection_icepack + real(kind=dbl_kind), allocatable, dimension(:) :: & + d_tr, trl, & + rhs_tr, rhs_trdiv, & + icepplus, icepminus, & + mass_matrix - private - - real(kind=dbl_kind), allocatable, dimension(:) :: & - d_tr, trl, & - rhs_tr, rhs_trdiv, & - icepplus, iceppminus, & - icefluxes, mass_matrix + real(kind=dbl_kind), allocatable, dimension(:,:) :: & + icefluxes ! Variables needed for advection @@ -32,7 +38,6 @@ module icedrv_advection subroutine tg_rhs_icepack(mesh, trc) use mod_mesh - use i_arrays use i_param use g_parsup use o_param @@ -52,7 +57,7 @@ subroutine tg_rhs_icepack(mesh, trc) integer(kind=int_kind) :: n, q, row, & elem, elnodes(3) - #include "associate_mesh.h" +#include "../associate_mesh.h" ! Taylor-Galerkin (Lax-Wendroff) rhs @@ -70,8 +75,8 @@ subroutine tg_rhs_icepack(mesh, trc) dx = gradient_sca(1:3,elem) dy = gradient_sca(4:6,elem) vol = elem_area(elem) - um = sum(uvel_elem(elnodes)) - vm = sum(vvel_elem(elnodes)) + um = sum(uvel(elnodes)) + vm = sum(vvel(elnodes)) ! Diffusivity @@ -79,9 +84,9 @@ subroutine tg_rhs_icepack(mesh, trc) do n = 1, 3 row = elnodes(n) do q = 1, 3 - entries(q) = vol*ice_dt*((dx(n)*(um+uvel_elem(elnodes(q))) + & - dy(n)*(vm+vvel_elem(elnodes(q))))/12.0_WP - & - diff*(dx(n)*dx(q)+ dy(n)*dy(q)) - & + entries(q) = vol*ice_dt*((dx(n)*(um+uvel(elnodes(q))) + & + dy(n)*(vm+vvel(elnodes(q))))/12.0_WP - & + diff*(dx(n)*dx(q)+ dy(n)*dy(q)) - & 0.5_WP*ice_dt*(um*dx(n)+vm*dy(n))*(um*dx(q)+vm*dy(q))/9.0_WP) enddo rhs_tr(row)=rhs_tr(row)+sum(entries*trc(elnodes)) @@ -92,24 +97,23 @@ end subroutine tg_rhs_icepack !======================================================================= - subroutine fct_init_icepack(mesh) + module subroutine init_advection_icepack(mesh) use o_param use o_mesh - use i_arrays use g_parsup - type(t_mesh), intent(in), target :: mesh - implicit none + type(t_mesh), intent(in), target :: mesh + ! Initialization of arrays necessary to implement FCT algorithm allocate(trl(nx)) ! low-order solutions allocate(d_tr(nx)) ! increments of high ! order solutions allocate(icefluxes(nx_elem_nh, 3)) allocate(icepplus(nx), icepminus(nx)) - allocate(rhs_tr(n_nx), rhs_trdiv(nx)) + allocate(rhs_tr(nx), rhs_trdiv(nx)) allocate(mass_matrix(sum(nn_num(1:nx_nh)))) @@ -120,14 +124,14 @@ subroutine fct_init_icepack(mesh) icefluxes(:,:) = c0 icepplus(:) = c0 icepminus(:) = c0 - mass_matrix(:,:) = c0 + mass_matrix(:) = c0 ! Fill in the mass matrix call fill_mass_matrix_icepack(mesh) if (mype==0) write(*,*) 'Icepack FCT is initialized' - end subroutine fct_init_icepack + end subroutine init_advection_icepack !======================================================================= @@ -136,7 +140,6 @@ subroutine fill_mass_matrix_icepack(mesh) use mod_mesh use o_mesh use i_param - use i_arrays use g_parsup implicit none @@ -148,7 +151,7 @@ subroutine fill_mass_matrix_icepack(mesh) integer(kind=int_kind) :: flag=0 ,iflag=0 type(t_mesh), intent(in), target :: mesh - #include "associate_mesh.h" +#include "../associate_mesh.h" allocate(col_pos(nx)) @@ -212,10 +215,9 @@ subroutine solve_low_order_icepack(mesh, trc) use mod_mesh use o_mesh - use i_arrays - use i_parm + use i_param use g_parsup - use g_comm_auto + implicit none @@ -224,7 +226,7 @@ subroutine solve_low_order_icepack(mesh, trc) type(t_mesh), target, intent(in) :: mesh real(kind=dbl_kind), dimension(:), intent(inout) :: trc - #include "associate_mesh.h" +#include "../associate_mesh.h" gamma = ice_gamma_fct ! Added diffusivity parameter ! Adjust it to ensure posivity of solution @@ -251,20 +253,19 @@ subroutine solve_high_order_icepack(mesh, trc) use mod_mesh use o_mesh - use i_arrays - use i_parm + use i_param use g_parsup - use g_comm_auto + implicit none integer(kind=int_kind) :: n,i,clo,clo2,cn,location(100),row - real (kind=double_kind) :: rhs_new + real (kind=dbl_kind) :: rhs_new integer(kind=int_kind), parameter :: num_iter_solve = 3 type(t_mesh), target, intent(in) :: mesh real(kind=dbl_kind), dimension(:), intent(inout) :: trc - #include "associate_mesh.h" +#include "../associate_mesh.h" ! Taylor-Galerkin solution @@ -308,11 +309,10 @@ subroutine fem_fct_icepack(mesh, trc) use mod_mesh use o_mesh - use i_arrays use o_param - use i_parm + use i_param use g_parsup - use g_comm_auto + integer(kind=int_kind) :: icoef(3,3), n, q, elem, elnodes(3), row real (kind=dbl_kind), allocatable, dimension(:) :: tmax, tmin @@ -320,7 +320,7 @@ subroutine fem_fct_icepack(mesh, trc) type(t_mesh), target, intent(in) :: mesh real(kind=dbl_kind), dimension(:), intent(inout) :: trc - #include "associate_mesh.h" +#include "../associate_mesh.h" gamma = ice_gamma_fct ! It should coinside with gamma in ! ts_solve_low_order @@ -460,11 +460,10 @@ subroutine tg_rhs_div_icepack(mesh, trc) use mod_mesh use o_mesh - use i_arrays use o_param - use i_parm + use i_param use g_parsup - use g_comm_auto + implicit none @@ -474,8 +473,7 @@ subroutine tg_rhs_div_icepack(mesh, trc) type(t_mesh), target, intent(in) :: mesh real(kind=dbl_kind), dimension(:), intent(inout) :: trc - - #include "associate_mesh.h" +#include "../associate_mesh.h" ! Computes the rhs in a Taylor-Galerkin way (with urrayspwind ! type of correction for the advection operator). @@ -496,26 +494,26 @@ subroutine tg_rhs_div_icepack(mesh, trc) dx = gradient_sca(1:3,elem) dy = gradient_sca(4:6,elem) vol = elem_area(elem) - um = sum(uvel_elem(elnodes)) - vm = sum(vvel_elem(elnodes)) + um = sum(uvel(elnodes)) + vm = sum(vvel(elnodes)) ! This is exact computation (no assumption of u=const ! on elements used in the standard version) - c_1 = (um*um+sum(uvel_elem(elnodes)*uvel_elem(elnodes))) / 12.0_dbl_kind - c_2 = (vm*vm+sum(vvel_elem(elnodes)*vvel_elem(elnodes))) / 12.0_dbl_kind - c_3 = (um*vm+sum(vvel_elem(elnodes)*uvel_elem(elnodes))) / 12.0_dbl_kind - c_4 = sum(dx*uvel_elem(elnodes)+dy*vvel_elem(elnodes)) + c_1 = (um*um+sum(uvel(elnodes)*uvel(elnodes))) / 12.0_dbl_kind + c_2 = (vm*vm+sum(vvel(elnodes)*vvel(elnodes))) / 12.0_dbl_kind + c_3 = (um*vm+sum(vvel(elnodes)*uvel(elnodes))) / 12.0_dbl_kind + c_4 = sum(dx*uvel(elnodes)+dy*vvel(elnodes)) do n = 1, 3 row = elnodes(n) do q = 1, 3 - entries(q) = vol*ice_dt*((c1-p5*ice_dt*c_4)*(dx(n)*(um+uvel_elem(elnodes(q)))+ & - dy(n)*(vm+vvel_elem(elnodes(q))))/12.0_dbl_kind - & + entries(q) = vol*ice_dt*((c1-p5*ice_dt*c_4)*(dx(n)*(um+uvel(elnodes(q)))+ & + dy(n)*(vm+vvel(elnodes(q))))/12.0_dbl_kind - & p5*ice_dt*(c_1*dx(n)*dx(q)+c_2*dy(n)*dy(q)+c_3*(dx(n)*dy(q)+dx(q)*dy(n)))) - entries2(q) = p5*ice_dt*(dx(n)*(um+uvel_elem(elnodes(q))) + & - dy(n)*(vm+vvel_elem(elnodes(q)))-dx(q)*(um+uvel_elem(row)) - & - dy(q)*(vm+vvel_elem(row))) + entries2(q) = p5*ice_dt*(dx(n)*(um+uvel(elnodes(q))) + & + dy(n)*(vm+vvel(elnodes(q)))-dx(q)*(um+uvel(row)) - & + dy(q)*(vm+vvel(row))) enddo c_x = vol*ice_dt*c_4*(sum(trc(elnodes))+trc(elnodes(n))+sum(entries2*trc(elnodes))) / 12.0_dbl_kind rhs_tr(row) = rhs_tr(row) + sum(entries * trc(elnodes)) + c_x @@ -531,11 +529,10 @@ subroutine update_for_div_icepack(mesh, trc) use mod_mesh use o_mesh - use i_arrays use o_param - use i_parm + use i_param use g_parsup - use g_comm_auto + implicit none @@ -546,7 +543,7 @@ subroutine update_for_div_icepack(mesh, trc) type(t_mesh), target, intent(in) :: mesh real(kind=dbl_kind), dimension(:), intent(inout) :: trc - #include "associate_mesh.h" +#include "../associate_mesh.h" ! Computes Taylor-Galerkin solution ! first approximation @@ -581,11 +578,13 @@ end subroutine update_for_div_icepack !======================================================================= subroutine fct_solve_icepack(mesh, trc) - + + use mod_mesh + implicit none - real(kind=dbl_kind), dimension(:), intent(inout) :: trc - type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(nx), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh ! Driving sequence call ice_TG_rhs_div(mesh, trc) @@ -600,13 +599,132 @@ end subroutine fct_solve_icepack !======================================================================= - subroutine tracer_advection_icepack(mesh, trc) + module subroutine tracer_advection_icepack(mesh) - implicit none + use mod_mesh + use icepack_intfc, only: icepack_aggregate + use icepack_itd, only: cleanup_itd + use g_config, only: dt - real(kind=dbl_kind), dimension(:), intent(inout) :: trc + implicit none + + ! NOTE: For remapping, hice and hsno are considered tracers. + ! ntrace is not equal to ntrcr! + + integer (kind=int_kind) :: ntrcr, ntrace, narr, nbtrcr, i, & + nx, nt, nt1, k + integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, & + nt_sice, nt_fbri, nt_iage, nt_FY, nt_alvl, nt_vlvl, & + nt_apnd, nt_hpnd, nt_ipnd, nt_bgc_Nit, nt_bgc_S + logical (kind=log_kind) :: tr_pond_topo, tr_pond_lvl, tr_pond_cesm, & + tr_pond, tr_aero, tr_FY, & + tr_iage, heat_capacity + real (kind=dbl_kind) :: puny + + ! Tracer dependencies and additional arrays + + integer (kind=int_kind), dimension(:), allocatable :: & + tracer_type , & ! = 1, 2, or 3 (depends on 0, 1 or 2 other tracers) + depend ! tracer dependencies (see below) + + logical (kind=log_kind), dimension (:), allocatable :: & + has_dependents ! true if a tracer has dependent tracers + + real (kind=dbl_kind), dimension (:,:), allocatable :: & + works + type(t_mesh), target, intent(in) :: mesh + call icepack_query_parameters(heat_capacity_out=heat_capacity, & + puny_out=puny) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_query_tracer_flags( & + tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_aero_out=tr_aero, tr_pond_out=tr_pond, & + tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & + nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, 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_bgc_Nit_out=nt_bgc_Nit, nt_bgc_S_out=nt_bgc_S) + + narr = 1 + ncat * (3 + ntrcr) ! max number of state variable arrays + + ! Allocate works array + + if (allocated(works)) deallocate(works) + allocate ( works(nx,narr) ) + + call state_to_work (nx, & + ntrcr, & + narr, trcr_depend, & + aicen, trcrn, & + vicen, vsnon, & + aice0, works) + + ! Advect each tracer + + do nt = 1, narr + call fct_solve_icepack ( mesh, works(:,nt) ) + end do + + call work_to_state (nx, & + ntrcr, & + narr, trcr_depend, & + aicen, trcrn, & + vicen, vsnon, & + aice0, works) + + ! cut off icepack + + call cut_off_icepack (nx, & + ntrcr, narr, & + trcr_depend(:), trcr_base(:,:), & + n_trcr_strata(:), nt_strata(:,:), & + aicen(:,:), trcrn (:,:,:), & + vicen(:,:), vsnon (:,:), & + aice0(:)) + + do i=1,nx + if (ncat > 1) then ! Do we really need this? + + call cleanup_itd (dt, ntrcr, & + nilyr, nslyr, & + ncat, hin_max(:), & + aicen(i,:), trcrn(i,1:ntrcr,:), & + vicen(i,:), vsnon(i,:), & + aice0(i), aice(i), & + n_aero, & + nbtrcr, nblyr, & + tr_aero, & + tr_pond_topo, & + heat_capacity, & + first_ice(i,:), & + trcr_depend(1:ntrcr), trcr_base(1:ntrcr,:), & + n_trcr_strata(1:ntrcr), nt_strata(1:ntrcr,:), & + fpond(i), fresh(i), & + fsalt(i), fhocn(i), & + faero_ocn(i,:), fzsal(i), & + flux_bio(i,1:nbtrcr)) + + call icepack_aggregate (ncat, & + aicen(i,:), & + trcrn(i,1:ntrcr,:), & + vicen(i,:), & + vsnon(i,:), & + aice (i), & + trcr (i,1:ntrcr), & + vice (i), & + vsno (i), & + aice0(i), & + ntrcr, & + trcr_depend (1:ntrcr), & + trcr_base (1:ntrcr,:), & + n_trcr_strata(1:ntrcr), & + nt_strata (1:ntrcr,:)) + end if + end do end subroutine tracer_advection_icepack @@ -619,206 +737,598 @@ subroutine work_to_state (nx, & vicen, vsnon, & aice0, works) - use icedrv_main, only: ncat, nslyr, nilyr, salinz - use icepack_intfc - use icedrv_system, only: icedrv_system_abort - use icedrv_flux, only: salinz - - integer (kind=int_kind), intent(in) :: & - nx , & ! block dimensions - ntrcr , & ! number of tracers in use - narr ! number of 2D state variable arrays in works array - - integer (kind=int_kind), dimension (ntrcr), intent(in) :: & - trcr_depend ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - - real (kind=dbl_kind), dimension (nx,ncat), intent(out) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (nx,ntrcr,ncat), intent(out) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), dimension (nx), intent(out) :: & - aice0 ! concentration of open water - - real (kind=dbl_kind), dimension(nx,narr), intent (inout) :: & - works ! work array - - ! local variables - - integer (kind=int_kind) :: & - nt_alvl, nt_apnd, nt_fbri, nt_Tsfc, ktherm - - logical (kind=log_kind) :: & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, heat_capacity - - integer (kind=int_kind) :: & - k, i, n, it , & ! counting indices - narrays , & ! counter for number of state variable arrays - nt_qsno , & - nt_qice , & - nt_sice - - real (kind=dbl_kind) :: & - rhos , & - rhoi , & - Lfresh , & - Tsmelt - - real (kind=dbl_kind), dimension(ncat) :: & - tmp, exc, puny - - real (kind=dbl_kind), parameter :: & - small = 0.000001_dbl_kind - - character(len=*), parameter :: subname = '(state_to_work)' - - call icepack_query_tracer_flags(tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) - call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & - nt_fbri_out=nt_fbri, nt_qsno_out=nt_qsno, & - nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_Tsfc_out=nt_Tsfc) - call icepack_query_parameters(rhoi_out=rhoi, rhos_out=rhoi, & - Lfresh_out=Lfresh, heat_capacity_out=heat_capacity, & - Tsmelt_out=Tsmelt, ktherm_out=ktherm, & - puny_out=puny) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & - file=__FILE__, line=__LINE__) - - ! Open water fraction - - trcrn(:,:,:) = c0 - aicen(:,:) = c0 - vicen(:,:) = c0 - vsnon(:,:) = c0 - - do i = 1, nx - if (works(i,1) <= puny) then - aice0(i) = c0 - else if (works(i,1) >= c1) then - aice0(i) = c1 - else - aice0(i) = works(i,1) - end if - enddo - narrays = 1 - - ! Sea ice area and volume per unit area of ice and snow - - do n=1,ncat - do i = 1, nx - if (works(i,narrays+1) > c1) then - works(i,narrays+1) = c1 - end if - if (works(i,narrays+1) <= small .or. works(i,narrays+2) <= small) then - works(i,narrays+1) = c0 - works(i,narrays+2) = c0 - works(i,narrays+3) = c0 - end if - if (works(i,narrays+3) <= small) then - works(i,narrays+3) = c0 - end if - aicen(i,n) = works(i,narrays+1) - vicen(i,n) = works(i,narrays+2) - vsnon(i,n) = works(i,narrays+3) - end do - - narrays = narrays + 3 + ntrcr - end do - - do i = 1, nx ! For each grid cell - if (sum(aicen(i,:)) > c1) then - tmp(:) = c0 - exc(:) = c0 - do n = 1, ncat - if (aicen(i,n) > puny) tmp(n) = c1 - end do - do n = 1, ncat - exc(n) = max(c0,(sum(aicen(i,:)) - c1)) & - * aicen(i,n) / sum(aicen(i,:)) - end do - do n = 1, ncat - aicen(i,n) = max(c0,aicen(i,n) - exc(n)) - aice0 = max(c0,sum(aicen(i,:))) - end do - end if - end do - - narrays = 1 - - do n=1, ncat - - narrays = narrays + 3 - - do it = 1, ntrcr - - if (trcr_depend(it) == 0) then - do i = 1, nx - if (aicen(i,n) > c0) then - if (it == nt_Tsfc) then - trcrn(i,it,n) = min(c0,works(i,narrays+it)/aicen(i,n)) - else - trcrn(i,it,n) = works(i,narrays+it) / aicen(i,n) + integer (kind=int_kind), intent(in) :: & + nx , & ! block dimensions + ntrcr , & ! number of tracers in use + narr ! number of 2D state variable arrays in works array + + integer (kind=int_kind), dimension (ntrcr), intent(in) :: & + trcr_depend ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon + + real (kind=dbl_kind), dimension (nx,ncat), intent(out) :: & + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) + + real (kind=dbl_kind), dimension (nx,ntrcr,ncat), intent(out) :: & + trcrn ! ice tracers + + real (kind=dbl_kind), dimension (nx), intent(out) :: & + aice0 ! concentration of open water + + real (kind=dbl_kind), dimension(nx,narr), intent (inout) :: & + works ! work array + + ! local variables + + integer (kind=int_kind) :: & + nt_alvl, nt_apnd, nt_fbri, nt_Tsfc, ktherm + + logical (kind=log_kind) :: & + tr_pond_cesm, tr_pond_lvl, tr_pond_topo, heat_capacity + + integer (kind=int_kind) :: & + k, i, n, it , & ! counting indices + narrays , & ! counter for number of state variable arrays + nt_qsno , & + nt_qice , & + nt_sice + + real (kind=dbl_kind) :: & + rhos , & + rhoi , & + Lfresh , & + Tsmelt + + real (kind=dbl_kind), dimension(ncat) :: & + tmp, exc + + real (kind=dbl_kind) :: puny + + real (kind=dbl_kind), parameter :: & + small = 0.000001_dbl_kind + + character(len=*), parameter :: subname = '(state_to_work)' + + call icepack_query_tracer_flags(tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & + nt_fbri_out=nt_fbri, nt_qsno_out=nt_qsno, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_Tsfc_out=nt_Tsfc) + call icepack_query_parameters(rhoi_out=rhoi, rhos_out=rhoi, & + Lfresh_out=Lfresh, heat_capacity_out=heat_capacity, & + Tsmelt_out=Tsmelt, ktherm_out=ktherm, & + puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + ! Open water fraction + + trcrn(:,:,:) = c0 + aicen(:,:) = c0 + vicen(:,:) = c0 + vsnon(:,:) = c0 + + do i = 1, nx + if (works(i,1) <= puny) then + aice0(i) = c0 + else if (works(i,1) >= c1) then + aice0(i) = c1 + else + aice0(i) = works(i,1) + end if + enddo + narrays = 1 + + ! Sea ice area and volume per unit area of ice and snow + + do n=1,ncat + do i = 1, nx + if (works(i,narrays+1) > c1) then + works(i,narrays+1) = c1 + end if + if (works(i,narrays+1) <= small .or. works(i,narrays+2) <= small) then + works(i,narrays+1) = c0 + works(i,narrays+2) = c0 + works(i,narrays+3) = c0 + end if + if (works(i,narrays+3) <= small) then + works(i,narrays+3) = c0 + end if + aicen(i,n) = works(i,narrays+1) + vicen(i,n) = works(i,narrays+2) + vsnon(i,n) = works(i,narrays+3) + end do + + narrays = narrays + 3 + ntrcr + end do + + do i = 1, nx ! For each grid cell + if (sum(aicen(i,:)) > c1) then + tmp(:) = c0 + exc(:) = c0 + do n = 1, ncat + if (aicen(i,n) > puny) tmp(n) = c1 + end do + do n = 1, ncat + exc(n) = max(c0,(sum(aicen(i,:)) - c1)) & + * aicen(i,n) / sum(aicen(i,:)) + end do + do n = 1, ncat + aicen(i,n) = max(c0,aicen(i,n) - exc(n)) + aice0 = max(c0,sum(aicen(i,:))) + end do + end if + end do + + narrays = 1 + + do n=1, ncat + + narrays = narrays + 3 + + do it = 1, ntrcr + + if (trcr_depend(it) == 0) then + do i = 1, nx + if (aicen(i,n) > c0) then + if (it == nt_Tsfc) then + trcrn(i,it,n) = min(c0,works(i,narrays+it)/aicen(i,n)) + else + trcrn(i,it,n) = works(i,narrays+it) / aicen(i,n) + end if + end if + enddo + elseif (trcr_depend(it) == 1) then + do i = 1, nx + if (vicen(i,n) > c0) then + if (it >= nt_qice .and. it < nt_qice+nilyr) then + trcrn(i,it,n) = min(c0,works(i,narrays+it)/vicen(i,n)) + if (.not. heat_capacity) trcrn(i,it,n) = -rhoi * Lfresh + else if (it >= nt_sice .and. it < nt_sice+nilyr) then + trcrn(i,it,n) = max(c0,works(i,narrays+it)/vicen(i,n)) + end if + end if + enddo + elseif (trcr_depend(it) == 2) then + do i = 1, nx + if (vsnon(i,n) > c0) then + if (it >= nt_qsno .and. it < nt_qsno+nslyr) then + trcrn(i,it,n) = min(c0,works(i,narrays+it)/vsnon(i,n)) - rhos*Lfresh + if (.not. heat_capacity) trcrn(i,it,n) = -rhos * Lfresh + end if end if - end if - enddo - elseif (trcr_depend(it) == 1) then - do i = 1, nx - if (vicen(i,n) > c0) then - if (it >= nt_qice .and. it < nt_qice+nilyr) then - trcrn(i,it,n) = min(c0,works(i,narrays+it)/vicen(i,n)) - if (.not. heat_capacity) trcrn(i,it,n) = -rhoi * Lfresh - else if (it >= nt_sice .and. it < nt_sice+nilyr) then - trcrn(i,it,n) = max(c0,works(i,narrays+it)/vicen(i,n)) + enddo + ! Tracers not yet checked or implemented + !elseif (trcr_depend(it) == 2+nt_alvl) then + ! do i = 1, nx + ! works(i,narrays+it) = aicen(i,n) & + ! * trcrn(i,nt_alvl,n) & + ! * trcrn(i,it,n) + ! enddo + !elseif (trcr_depend(it) == 2+nt_apnd .and. & + ! tr_pond_cesm .or. tr_pond_topo) then + ! do i = 1, nx + ! works(i,narrays+it) = aicen(i,n) & + ! * trcrn(i,nt_apnd,n) & + ! * trcrn(i,it,n) + ! enddo + !elseif (trcr_depend(it) == 2+nt_apnd .and. & + ! tr_pond_lvl) then + ! do i = 1, nx + ! works(i,narrays+it) = aicen(i,n) & + ! * trcrn(i,nt_alvl,n) & + ! * trcrn(i,nt_apnd,n) & + ! * trcrn(i,it,n) + ! enddo + !elseif (trcr_depend(it) == 2+nt_fbri) then + ! do i = 1, nx + ! works(i,narrays+it) = vicen(i,n) & + ! * trcrn(i,nt_fbri,n) & + ! * trcrn(i,it,n) + ! enddo + endif + enddo + + narrays = narrays + ntrcr + + enddo ! number of categories + + do i = 1, nx ! For each grid cell + if (ktherm == 1) then ! For bl99 themodynamics + ! always ridefine salinity + ! after advection + do k = 1, nilyr + trcrn(i,nt_sice+k-1,:) = salinz(i,k) + end do ! nilyr + end if ! ktherm==1 + end do + + end subroutine work_to_state + + !======================================================================= + + subroutine state_to_work (nx, & + ntrcr, & + narr, trcr_depend, & + aicen, trcrn, & + vicen, vsnon, & + aice0, works) + + integer (kind=int_kind), intent(in) :: & + nx , & ! block dimensions + ntrcr , & ! number of tracers in use + narr ! number of 2D state variable arrays in works array + + integer (kind=int_kind), dimension (ntrcr), intent(in) :: & + trcr_depend ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon + + real (kind=dbl_kind), dimension (nx,ncat), intent(in) :: & + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) + + real (kind=dbl_kind), dimension (nx,ntrcr,ncat), intent(in) :: & + trcrn ! ice tracers + + real (kind=dbl_kind), dimension (nx), intent(in) :: & + aice0 ! concentration of open water + + real (kind=dbl_kind), dimension(nx,narr), intent (out) :: & + works ! work array + + ! local variables + + integer (kind=int_kind) :: & + nt_alvl, nt_apnd, nt_fbri, nt_Tsfc + + logical (kind=log_kind) :: & + tr_pond_cesm, tr_pond_lvl, tr_pond_topo + + integer (kind=int_kind) :: & + i, n, it , & ! counting indices + narrays , & ! counter for number of state variable arrays + nt_qsno + + real (kind=dbl_kind) :: & + rhos , & + Lfresh + + character(len=*), parameter :: subname = '(state_to_work)' + + call icepack_query_tracer_flags(tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & + nt_fbri_out=nt_fbri, nt_qsno_out=nt_qsno, nt_Tsfc_out=nt_Tsfc) + call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! This array is used for performance (balance memory/cache vs + ! number of bound calls); a different number of arrays may perform + ! better depending on the machine used, number of processors, etc. + ! --tested on SGI R2000, using 4 pes for the ice model under MPI + !----------------------------------------------------------------- + + do i = 1, nx + works(i,1) = aice0(i) + enddo + narrays = 1 + + do n=1, ncat + + do i = 1, nx + works(i,narrays+1) = aicen(i,n) + works(i,narrays+2) = vicen(i,n) + works(i,narrays+3) = vsnon(i,n) + enddo ! i + narrays = narrays + 3 + + do it = 1, ntrcr + if (trcr_depend(it) == 0) then + do i = 1, nx + works(i,narrays+it) = aicen(i,n)*trcrn(i,it,n) + enddo + elseif (trcr_depend(it) == 1) then + do i = 1, nx + works(i,narrays+it) = vicen(i,n)*trcrn(i,it,n) + enddo + elseif (trcr_depend(it) == 2) then + do i = 1, nx + if (it >= nt_qsno .and. it < nt_qsno+nslyr) then + works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) - rhos*Lfresh + else + works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) + end if + enddo + elseif (trcr_depend(it) == 2+nt_alvl) then + do i = 1, nx + works(i,narrays+it) = aicen(i,n) & + * trcrn(i,nt_alvl,n) & + * trcrn(i,it,n) + enddo + elseif (trcr_depend(it) == 2+nt_apnd .and. & + tr_pond_cesm .or. tr_pond_topo) then + do i = 1, nx + works(i,narrays+it) = aicen(i,n) & + * trcrn(i,nt_apnd,n) & + * trcrn(i,it,n) + enddo + elseif (trcr_depend(it) == 2+nt_apnd .and. & + tr_pond_lvl) then + do i = 1, nx + works(i,narrays+it) = aicen(i,n) & + * trcrn(i,nt_alvl,n) & + * trcrn(i,nt_apnd,n) & + * trcrn(i,it,n) + enddo + elseif (trcr_depend(it) == 2+nt_fbri) then + do i = 1, nx + works(i,narrays+it) = vicen(i,n) & + * trcrn(i,nt_fbri,n) & + * trcrn(i,it,n) + enddo + endif + enddo + narrays = narrays + ntrcr + + enddo ! n + + if (narr /= narrays .and. mype == 0 ) write(nu_diag,*) & + "Wrong number of arrays in transport bound call" + + end subroutine state_to_work + + !======================================================================= + + subroutine cut_off_icepack (nx, & + ntrcr, narr, & + trcr_depend, & + trcr_base, & + n_trcr_strata, & + nt_strata, & + aicen, trcrn, & + vicen, vsnon, & + aice0) + + use icepack_intfc, only: icepack_compute_tracers + use icepack_intfc, only: icepack_aggregate + use icepack_intfc, only: icepack_init_trcr + use icepack_intfc, only: icepack_sea_freezing_temperature + use icepack_therm_shared, only: calculate_Tin_from_qin + use icepack_mushy_physics, only: icepack_mushy_temperature_mush + + integer (kind=int_kind), intent (in) :: & + nx , & ! block dimensions + ntrcr , & ! number of tracers in use + narr ! number of 2D state variable arrays in works array + + integer (kind=int_kind), dimension (ntrcr), intent(in) :: & + trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon + n_trcr_strata ! number of underlying tracer layers + + real (kind=dbl_kind), dimension (ntrcr,3), intent(in) :: & + trcr_base ! = 0 or 1 depending on tracer dependency + ! argument 2: (1) aice, (2) vice, (3) vsno + + integer (kind=int_kind), dimension (ntrcr,2), intent(in) :: & + nt_strata ! indices of underlying tracer layers + + real (kind=dbl_kind), dimension (nx,ncat), intent(inout) :: & + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) + + real (kind=dbl_kind), dimension (nx,ntrcr,ncat),intent(inout) :: & + trcrn ! ice tracers + + real (kind=dbl_kind), dimension (nx), intent(out) :: & + aice0 ! concentration of open watera + + ! local variables + + real (kind=dbl_kind), dimension(nilyr) :: & + qin , & ! ice enthalpy (J/m3) + zTin ! initial ice temperature + + real (kind=dbl_kind), dimension(nslyr) :: & + qsn , & ! snow enthalpy (J/m3) + zTsn ! initial snow temperature + integer (kind=int_kind) :: & + i, n, k, it , & ! counting indices + narrays , & ! counter for number of state variable arrays + icells , & ! number of ocean/ice cells + ktherm + + real (kind=dbl_kind), dimension(ncat) :: & + aicecat + + real (kind=dbl_kind) :: & + rhos, Lfresh, & + cp_ice, small, & + qrd_snow, qrd_ice, & + Tsfc, exc, & + depressT, Tf_new, & + T_air_C, hice, & + puny, Tsmelt, & + Tmin + + + logical (kind=log_kind) :: tr_brine, tr_lvl, flag_snow, flag_cold_ice, flag_warm_ice, & + heat_capacity + integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, nt_sice + integer (kind=int_kind) :: nt_fbri, nt_alvl, nt_vlvl + + character(len=*), parameter :: subname = '(cut_off_icepack)' + + call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl) + call icepack_query_tracer_indices( nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & + nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, & + nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) + call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, cp_ice_out=cp_ice) + call icepack_query_parameters(depressT_out=depressT, puny_out=puny, & + Tsmelt_out=Tsmelt, ktherm_out=ktherm, heat_capacity_out=heat_capacity) + call icepack_warnings_flush(nu_diag) + + small = puny + Tmin = -100.0_dbl_kind + + if (.not. heat_capacity) then ! for 0 layer thermodynamics + do n = 1, ncat + do i = 1, nx + if (trcrn(i,nt_Tsfc,n) > Tf(i) .or. trcrn(i,nt_Tsfc,n)< Tmin) then + trcrn(i,nt_Tsfc,n) = min(Tf(i), (T_air(i) + 273.15_dbl_kind)) + end if + end do + end do + end if + + if (heat_capacity) then ! only for bl99 and mushy thermodynamics + + ! Here we should implement some conditions to check the tracers + ! when ice is present, particularly enthalpy, surface temperature + ! and salinity. + + ! Test advection + + do n = 1, ncat ! For each thickness cathegory + do i = 1, nx ! For each grid point + + ! Forcing quantities at current time step + T_air_C = T_air(i) + 273.15_dbl_kind ! Convert from C to K + + call icepack_init_trcr(T_air_C, Tf(i), & + salinz(i,:), Tmltz(i,:), & + Tsfc, & + nilyr, nslyr, & + qin (:), qsn (:)) + + ! Correct qin profile for melting temperatures + + if (vicen(i,n) > small .and. aicen(i,n) > small) then + + ! Condition on surface temperature + if (trcrn(i,nt_Tsfc,n) > Tsmelt .or. trcrn(i,nt_Tsfc,n) < Tmin) then + trcrn(i,nt_Tsfc,n) = Tsfc + end if + + ! Condition on ice enthalpy + + flag_warm_ice = .false. + flag_cold_ice = .false. + flag_snow = .false. + + do k = 1, nilyr ! Check for problems + + if (ktherm == 2) then + zTin(k) = icepack_mushy_temperature_mush(trcrn(i,nt_qice+k-1,n),trcrn(i,nt_sice+k-1,n)) + else + zTin(k) = calculate_Tin_from_qin(trcrn(i,nt_qice+k-1,n),Tmltz(i,k)) + endif + + if (zTin(k) < Tmin ) flag_cold_ice = .true. + if (zTin(k) >= Tmltz(i,k)) flag_warm_ice = .true. + + end do !nilyr + + if (flag_cold_ice) then + + trcrn(i,nt_Tsfc,n) = Tsfc + + do k = 1, nilyr + trcrn(i,nt_qice+k-1,n) = min(c0, qin(k)) + end do ! nilyr + + if (vsnon(i,n) > small) then ! Only if there is snow + ! on top of the sea ice + do k = 1, nslyr + trcrn(i,nt_qsno+k-1,n) = qsn(k) + end do + else ! No snow + trcrn(i,nt_qsno:nt_qsno+nslyr-1,n) = c0 + end if + + end if ! flag cold ice + + if (flag_warm_ice) then ! This sea ice should have melted already + + aicen(i,n) = c0 + vicen(i,n) = c0 + vsnon(i,n) = c0 + trcrn(i,:,n) = c0 + trcrn(i,nt_Tsfc,n) = Tf_new + end if + + if (vsnon(i,n) > small) then + + flag_snow = .false. + + do k = 1, nslyr + if (trcrn(i,nt_qsno+k-1,n) >= -rhos*Lfresh) flag_snow = .true. + zTsn(k) = (Lfresh + trcrn(i,nt_qsno+k-1,n)/rhos)/cp_ice + if (zTsn(k) < Tmin) flag_snow = .true. + end do + + if (flag_snow) then + trcrn(i,nt_Tsfc,n) = Tsfc + do k = 1, nslyr + trcrn(i,nt_qsno+k-1,n) = qsn(k) + end do ! nslyr + do k = 1, nilyr + trcrn(i,nt_qice+k-1,n) = min(c0, qin(k)) + end do ! nilyr + end if ! flag snow + end if ! vsnon(i,n) > c0 + + else + + aicen(i,n) = c0 + vicen(i,n) = c0 + vsnon(i,n) = c0 + trcrn(i,:,n) = c0 + trcrn(i,nt_Tsfc,n) = Tf_new + end if - enddo - elseif (trcr_depend(it) == 2) then - do i = 1, nx - if (vsnon(i,n) > c0) then - if (it >= nt_qsno .and. it < nt_qsno+nslyr) then - trcrn(i,it,n) = min(c0,works(i,narrays+it)/vsnon(i,n)) - rhos*Lfresh - if (.not. heat_capacity) trcrn(i,it,n) = -rhos * Lfresh - end if - end if - enddo - ! Tracers not yet checked or implemented - !elseif (trcr_depend(it) == 2+nt_alvl) then - ! do i = 1, nx - ! works(i,narrays+it) = aicen(i,n) & - ! * trcrn(i,nt_alvl,n) & - ! * trcrn(i,it,n) - ! enddo - !elseif (trcr_depend(it) == 2+nt_apnd .and. & - ! tr_pond_cesm .or. tr_pond_topo) then - ! do i = 1, nx - ! works(i,narrays+it) = aicen(i,n) & - ! * trcrn(i,nt_apnd,n) & - ! * trcrn(i,it,n) - ! enddo - !elseif (trcr_depend(it) == 2+nt_apnd .and. & - ! tr_pond_lvl) then - ! do i = 1, nx - ! works(i,narrays+it) = aicen(i,n) & - ! * trcrn(i,nt_alvl,n) & - ! * trcrn(i,nt_apnd,n) & - ! * trcrn(i,it,n) - ! enddo - !elseif (trcr_depend(it) == 2+nt_fbri) then - ! do i = 1, nx - ! works(i,narrays+it) = vicen(i,n) & - ! * trcrn(i,nt_fbri,n) & - ! * trcrn(i,it,n) - ! enddo - endif - enddo + + end do ! nx + end do ! ncat + + do i = 1, nx + aice(i) = c0 + vice(i) = c0 + vsno(i) = c0 + do it = 1, ntrcr + trcr(i,it) = c0 + enddo + call icepack_aggregate (ncat, & + aicen(i,:), & + trcrn(i,1:ntrcr,:), & + vicen(i,:), & + vsnon(i,:), & + aice (i), & + trcr (i,1:ntrcr), & + vice (i), & + vsno (i), & + aice0(i), & + ntrcr, & + trcr_depend (1:ntrcr), & + trcr_base (1:ntrcr,:), & + n_trcr_strata(1:ntrcr), & + nt_strata (1:ntrcr,:)) + end do + + end if ! heat_capacity + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) - narrays = narrays + ntrcr + end subroutine cut_off_icepack - enddo ! number of categories +end submodule icedrv_advection -end module icedrv_advection diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 index 04d197d31..5eab0f927 100644 --- a/src/icepack_drivers/icedrv_allocate.F90 +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -48,8 +48,6 @@ module subroutine alloc_state aice0 (nx) , & ! concentration of open water uvel (nx) , & ! x-component of velocity (m/s) on the nodes vvel (nx) , & ! y-component of velocity (m/s) on the nodes - uvel_elem (nx_elem) , & ! x-component of velocity (m/s) on the elements - vvel_elem (nx_elem) , & ! y-component of velocity (m/s) on the elements divu (nx) , & ! strain rate I component, velocity divergence (1/s) shear (nx) , & ! strain rate II component (1/s) strength (nx) , & ! ice strength (N/m) @@ -181,12 +179,14 @@ module subroutine alloc_flux alidr_init(nx), & ! near-ir, direct (fraction) alvdf_init(nx), & ! visible, diffuse (fraction) alidf_init(nx), & ! near-ir, diffuse (fraction) - fpond(nx) , & ! fresh water flux to ponds (kg/m^2/s) - fresh(nx) , & ! fresh water flux to ocean (kg/m^2/s) - fsalt(nx) , & ! salt flux to ocean (kg/m^2/s) - fhocn(nx) , & ! net heat flux to ocean (W/m^2) - fswthru(nx) , & ! shortwave penetrating to ocean (W/m^2) - fswfac(nx) , & ! for history + fpond(nx) , & ! fresh water flux to ponds (kg/m^2/s) + fresh(nx) , & ! fresh water flux to ocean (kg/m^2/s) + fresh_tot(nx) , & ! total fresh water flux to ocean (kg/m^2/s) + fsalt(nx) , & ! salt flux to ocean (kg/m^2/s) + fhocn(nx) , & ! net heat flux to ocean (W/m^2) + fhocn_tot(nx) , & ! total net heat flux to ocean (W/m^2) + fswthru(nx) , & ! shortwave penetrating to ocean (W/m^2) + fswfac(nx) , & ! for history scale_factor(nx), & ! scaling factor for shortwave components meltsn(nx,ncat) , & ! snow melt in category n (m) melttn(nx,ncat) , & ! top melt in category n (m) diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 110adaec3..1da2ad54e 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -322,12 +322,14 @@ module subroutine init_coupler_flux() ! fluxes sent to ocean !----------------------------------------------------------------- - strocnxT(:) = c0 ! ice-ocean stress, x-direction (T-cell) - strocnyT(:) = c0 ! ice-ocean stress, y-direction (T-cell) - fresh (:) = c0 - fsalt (:) = c0 - fhocn (:) = c0 - fswthru (:) = c0 + strocnxT (:) = c0 ! ice-ocean stress, x-direction (T-cell) + strocnyT (:) = c0 ! ice-ocean stress, y-direction (T-cell) + fresh (:) = c0 + fresh_tot(:) = c0 + fsalt (:) = c0 + fhocn (:) = c0 + fhocn_tot(:) = c0 + fswthru (:) = c0 flux_bio(:,:) = c0 ! bgc fnit (:) = c0 fsil (:) = c0 @@ -829,6 +831,8 @@ end subroutine init_shortwave module subroutine init_fsd() + implicit none + wavefreq (:) = c0 dwavefreq (:) = c0 wave_sig_ht (:) = c0 @@ -843,43 +847,48 @@ end subroutine init_fsd !======================================================================= - subroutine init_wave_spec() - - ! local variables - integer (kind=int_kind) :: & - k - - real(kind=dbl_kind), dimension(nfreq) :: & - wave_spectrum_profile ! wave spectrum - - wave_spectrum(:,:) = c0 - - ! wave spectrum and frequencies - ! get hardwired frequency bin info and a dummy wave spectrum profile - call icepack_init_wave(nfreq=nfreq, & - wave_spectrum_profile=wave_spectrum_profile, & - wavefreq=wavefreq, dwavefreq=dwavefreq) + module subroutine init_wave_spec() - do k = 1, nfreq - wave_spectrum(:,k) = wave_spectrum_profile(k) - enddo + implicit none + + ! local variables + character(len=*), parameter :: subname='(init_wave_spec)' + + integer (kind=int_kind) :: k + + real(kind=dbl_kind), dimension(nfreq) :: & + wave_spectrum_profile ! wave spectrum + + wave_spectrum(:,:) = c0 + + ! wave spectrum and frequencies + ! get hardwired frequency bin info and a dummy wave spectrum profile + call icepack_init_wave(nfreq=nfreq, & + wave_spectrum_profile=wave_spectrum_profile, & + wavefreq=wavefreq, dwavefreq=dwavefreq) + + do k = 1, nfreq + wave_spectrum(:,k) = wave_spectrum_profile(k) + enddo end subroutine init_wave_spec !======================================================================= - subroutine init_faero() - - character(len=*), parameter :: subname='(faero_default)' + module subroutine init_faero() - faero_atm(:,1) = 1.e-12_dbl_kind ! kg/m^2 s - faero_atm(:,2) = 1.e-13_dbl_kind - faero_atm(:,3) = 1.e-14_dbl_kind - faero_atm(:,4) = 1.e-14_dbl_kind - faero_atm(:,5) = 1.e-14_dbl_kind - faero_atm(:,6) = 1.e-14_dbl_kind - - end subroutine faero_default + implicit none + + character(len=*), parameter :: subname='(init_faero)' + + faero_atm(:,1) = 1.e-12_dbl_kind ! kg/m^2 s + faero_atm(:,2) = 1.e-13_dbl_kind + faero_atm(:,3) = 1.e-14_dbl_kind + faero_atm(:,4) = 1.e-14_dbl_kind + faero_atm(:,5) = 1.e-14_dbl_kind + faero_atm(:,6) = 1.e-14_dbl_kind + + end subroutine init_faero !======================================================================= diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 3136d8ba8..e5cfe173c 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -100,8 +100,6 @@ module icedrv_main real (kind=dbl_kind), allocatable, save :: & ! DIM nx uvel(:) , & ! x-component of velocity (m/s) on the nodes vvel(:) , & ! y-component of velocity (m/s) on the nodes - uvel_elem(:) , & ! x-component of velocity (m/s) on the elements - vvel_elem(:) , & ! y-component of velocity (m/s) on the elements divu(:) , & ! strain rate I component, velocity divergence (1/s) shear(:) , & ! strain rate II component (1/s) strength(:) ! ice strength (N/m) @@ -251,6 +249,10 @@ module icedrv_main fsalt(:) , & ! salt flux to ocean (kg/m^2/s) fhocn(:) , & ! net heat flux to ocean (W/m^2) fswthru(:) ! shortwave penetrating to ocean (W/m^2) + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + fresh_tot(:) , & ! total fresh water flux to ocean (kg/m^2/s) + fhocn_tot(:) ! total salt flux to ocean (kg/m^2/s) ! internal @@ -843,6 +845,105 @@ module subroutine init_icepack(mesh) type(t_mesh), intent(in), target :: mesh end subroutine init_icepack + ! Copy variables from fesom to icepack + module subroutine fesom_to_icepack(mesh) + use mod_mesh + implicit none + type(t_mesh), intent(in), target :: mesh + end subroutine fesom_to_icepack + + ! Copy variables from fesom to icepack + module subroutine icepack_to_fesom( & + nx_in, & + aice_out, vice_out, vsno_out, & + fhocn_tot_out, fresh_tot_out, & + strocnxT_out, strocnyT_out) + use mod_mesh + implicit none + integer (kind=int_kind), intent(in) :: & + nx_in ! block dimensions + real (kind=dbl_kind), dimension(nx_in), intent(out), optional :: & + aice_out, & + vice_out, & + vsno_out, & + fhocn_tot_out, & + fresh_tot_out, & + strocnxT_out, & + strocnyT_out + end subroutine icepack_to_fesom + + ! Trancers advection + module subroutine tracer_advection_icepack(mesh) + use mod_mesh + implicit none + type(t_mesh), intent(in), target :: mesh + end subroutine tracer_advection_icepack + + ! Advection initialization + module subroutine init_advection_icepack(mesh) + use mod_mesh + implicit none + type(t_mesh), intent(in), target :: mesh + end subroutine init_advection_icepack + + ! Ocean mixed layer + + module subroutine ocn_mixed_layer_icepack( & + alvdr_ocn, swvdr, & + alidr_ocn, swidr, & + alvdf_ocn, swvdf, & + alidf_ocn, swidf, & + sst, flwout_ocn, & + fsens_ocn, shcoef, & + flat_ocn, lhcoef, & + evap_ocn, flw, & + delt, delq, & + aice, fhocn, & + fswthru, hmix, & + Tf, fresh, & + frain, fsnow, & + fhocn_tot, fresh_tot, & + frzmlt) + + implicit none + + real (kind=dbl_kind), intent(in) :: & + alvdr_ocn , & ! visible, direct (fraction) + alidr_ocn , & ! near-ir, direct (fraction) + alvdf_ocn , & ! visible, diffuse (fraction) + alidf_ocn , & ! near-ir, diffuse (fraction) + swvdr , & ! sw down, visible, direct (W/m^2) + swvdf , & ! sw down, visible, diffuse (W/m^2) + swidr , & ! sw down, near IR, direct (W/m^2) + swidf , & ! sw down, near IR, diffuse (W/m^2) + flw , & ! incoming longwave radiation (W/m^2) + Tf , & ! freezing temperature (C) + hmix , & ! mixed layer depth (m) + delt , & ! potential temperature difference (K) + delq , & ! specific humidity difference (kg/kg) + shcoef , & ! transfer coefficient for sensible heat + lhcoef , & ! transfer coefficient for latent heat + fswthru , & ! shortwave penetrating to ocean (W/m^2) + aice , & ! ice area fraction + sst , & ! sea surface temperature (C) + frain , & ! rainfall rate (kg/m^2/s) + fsnow ! snowfall rate (kg/m^2/s) + + real (kind=dbl_kind), intent(inout) :: & + flwout_ocn, & ! outgoing longwave radiation (W/m^2) + fsens_ocn , & ! sensible heat flux (W/m^2) + flat_ocn , & ! latent heat flux (W/m^2) + evap_ocn , & ! evaporative water flux (kg/m^2/s) + fhocn , & ! net heat flux to ocean (W/m^2) + fresh , & ! fresh water flux to ocean (kg/m^2/s) + frzmlt ! freezing/melting potential (W/m^2) + + real (kind=dbl_kind), intent(out) :: & + fhocn_tot , & ! net total heat flux to ocean (W/m^2) + fresh_tot ! fresh total water flux to ocean (kg/m^2/s) + + end subroutine ocn_mixed_layer_icepack + end interface end module icedrv_main diff --git a/src/icepack_drivers/icedrv_oml.F90 b/src/icepack_drivers/icedrv_oml.F90 new file mode 100644 index 000000000..2c3d94d01 --- /dev/null +++ b/src/icepack_drivers/icedrv_oml.F90 @@ -0,0 +1,106 @@ +!======================================================================= +! +! This submodule contain an ocean mixed layer implementation +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + + submodule (icedrv_main) icedrv_ocean_mix_layer + + contains + + module subroutine ocn_mixed_layer_icepack( & + alvdr_ocn, swvdr, & + alidr_ocn, swidr, & + alvdf_ocn, swvdf, & + alidf_ocn, swidf, & + sst, flwout_ocn, & + fsens_ocn, shcoef, & + flat_ocn, lhcoef, & + evap_ocn, flw, & + delt, delq, & + aice, fhocn, & + fswthru, hmix, & + Tf, fresh, & + frain, fsnow, & + fhocn_tot, fresh_tot, & + frzmlt) + + use i_therm_param, only: emiss_wat + + real (kind=dbl_kind), intent(in) :: & + alvdr_ocn , & ! visible, direct (fraction) + alidr_ocn , & ! near-ir, direct (fraction) + alvdf_ocn , & ! visible, diffuse (fraction) + alidf_ocn , & ! near-ir, diffuse (fraction) + swvdr , & ! sw down, visible, direct (W/m^2) + swvdf , & ! sw down, visible, diffuse (W/m^2) + swidr , & ! sw down, near IR, direct (W/m^2) + swidf , & ! sw down, near IR, diffuse (W/m^2) + flw , & ! incoming longwave radiation (W/m^2) + Tf , & ! freezing temperature (C) + hmix , & ! mixed layer depth (m) + delt , & ! potential temperature difference (K) + delq , & ! specific humidity difference (kg/kg) + shcoef , & ! transfer coefficient for sensible heat + lhcoef , & ! transfer coefficient for latent heat + fswthru , & ! shortwave penetrating to ocean (W/m^2) + aice , & ! ice area fraction + sst , & ! sea surface temperature (C) + frain , & ! rainfall rate (kg/m^2/s) + fsnow ! snowfall rate (kg/m^2/s) + + real (kind=dbl_kind), intent(inout) :: & + flwout_ocn, & ! outgoing longwave radiation (W/m^2) + fsens_ocn , & ! sensible heat flux (W/m^2) + flat_ocn , & ! latent heat flux (W/m^2) + evap_ocn , & ! evaporative water flux (kg/m^2/s) + fhocn , & ! net heat flux to ocean (W/m^2) + fresh , & ! fresh water flux to ocean (kg/m^2/s) + frzmlt ! freezing/melting potential (W/m^2) + + real (kind=dbl_kind), intent(out) :: & + fhocn_tot , & ! net total heat flux to ocean (W/m^2) + fresh_tot ! fresh total water flux to ocean (kg/m^2/s) + + real (kind=dbl_kind), parameter :: & + frzmlt_max = c1000 ! max magnitude of frzmlt (W/m^2) + + real (kind=dbl_kind) :: & + TsfK , & ! surface temperature (K) + swabs, & ! surface absorbed shortwave heat flux (W/m^2) + sst_n, & ! temporary new sst + fhocn_n, & + fresh_n + + character(len=*),parameter :: subname='(icepack_ocn_mixed_layer)' + + ! shortwave radiative flux ! Visible is absorbed by clorophil afterwards + swabs = (c1-alidr_ocn) * swidr + (c1-alidf_ocn) * swidf + & + (c1-alvdr_ocn) * swvdr + (c1-alvdf_ocn) * swvdf + + ! ocean surface temperature in Kelvin + TsfK = sst + Tffresh + + ! longwave radiative flux + ! Water emissivity added to be consistent + ! with the standard FESOM2 version + flwout_ocn = - emiss_wat * stefan_boltzmann * TsfK**4 + + ! downward latent and sensible heat fluxes + fsens_ocn = shcoef * delt + flat_ocn = lhcoef * delq + evap_ocn = -flat_ocn / Lvap + + ! Compute heat change due to exchange between ocean and atmosphere + + fhocn_tot = fhocn + fswthru & ! these are *aice already + + (fsens_ocn + flat_ocn + flwout_ocn + flw + swabs & + + Lfresh*fsnow) * (c1-aice) + max(c0,frzmlt)*aice + + fresh_tot = fresh + (-evap_ocn + frain + fsnow)*(c1-aice) + + end subroutine ocn_mixed_layer_icepack + + end submodule icedrv_ocean_mix_layer diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 index c1ce2d19b..07d052b2a 100644 --- a/src/icepack_drivers/icedrv_transfer.F90 +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -10,18 +10,7 @@ contains - module subroutine fesom_to_icepack() - - implicit none - - character(len=*), parameter :: subname='(fesom_to_icepack)' - - real (kind=dbl_kind), parameter :: & - frcvdr = 0.28_dbl_kind, & ! frac of incoming sw in vis direct band - frcvdf = 0.24_dbl_kind, & ! frac of incoming sw in vis diffuse band - frcidr = 0.31_dbl_kind, & ! frac of incoming sw in near IR direct band - frcidf = 0.17_dbl_kind, & ! frac of incoming sw in near IR diffuse band - ex = 0.286_dbl_kind + module subroutine fesom_to_icepack(mesh) use g_forcing_arrays, only: Tair, shum, u_wind, v_wind, & ! Atmospheric forcing fields shortwave, longwave, prec_rain, & @@ -29,10 +18,50 @@ module subroutine fesom_to_icepack() use g_forcing_param, only: ncar_bulk_z_wind, ncar_bulk_z_tair, & ncar_bulk_z_shum use g_sbf, only: l_mslp - use i_arrays, only: S_oc_array, T_oc_array, & ! Ocean and sea ice field - u_w, v_w, & - u_ice, v_ice + use i_arrays, only: S_oc_array, T_oc_array, & ! Ocean and sea ice fields + u_w, v_w, & + u_ice, v_ice, & + stress_atmice_x, stress_atmice_y + use i_param, only: cd_oce_ice ! Sea ice parameters + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_sea_freezing_temperature + use g_comm_auto, only: exchange_nod + use icedrv_system, only: icedrv_system_abort + use g_config, only: dt + use mod_mesh + use o_mesh + use g_parsup + + implicit none + + character(len=*), parameter :: subname='(fesom_to_icepack)' + + logical (kind=log_kind) :: & + calc_strair + real (kind=dbl_kind), parameter :: & + frcvdr = 0.28_dbl_kind, & ! frac of incoming sw in vis direct band + frcvdf = 0.24_dbl_kind, & ! frac of incoming sw in vis diffuse band + frcidr = 0.31_dbl_kind, & ! frac of incoming sw in near IR direct band + frcidf = 0.17_dbl_kind, & ! frac of incoming sw in near IR diffuse band + R_dry = 287.05_dbl_kind, & ! specific gas constant for dry air (J/K/kg) + R_vap = 461.495_dbl_kind, & ! specific gas constant for water vapo (J/K/kg) + rhowat = 1025.0_dbl_kind, & ! Water density + cc = rhowat*4190.0_dbl_kind, & ! Volumetr. heat cap. of water [J/m**3/K](cc = rhowat*cp_water) + ex = 0.286_dbl_kind + + integer(kind=dbl_kind) :: i, n, k, elem + real (kind=int_kind) :: tx, ty, tvol + + real (kind=dbl_kind) :: & + aux, & + cprho + + type(t_mesh), target, intent(in) :: mesh + +#include "../associate_mesh.h" + ! Ice uvel(:) = u_ice(:) @@ -49,14 +78,19 @@ module subroutine fesom_to_icepack() frain(:) = prec_rain(:) * 1000.0_dbl_kind fsnow(:) = prec_snow(:) * 1000.0_dbl_kind + wind(:) = sqrt(uatm(:)**2 + vatm(:)**2) + zlvl_t = ncar_bulk_z_tair zlvl_q = ncar_bulk_z_shum zlvl_v = ncar_bulk_z_wind if ( l_mslp ) then - potT(:) = T_air(:)*(press_air(:)/100000.0_dbl_kind)^ex + potT(:) = T_air(:)*(press_air(:)/100000.0_dbl_kind)**ex + rhoa(:) = press_air(:) / (R_dry * T_air(:) * (c1 + ((R_vap/R_dry) * Qa) )) else + ! The option below is used in FESOM2 potT(:) = T_air(:) + rhoa(:) = 1.3_dbl_kind endif ! Ocean @@ -73,17 +107,78 @@ module subroutine fesom_to_icepack() swidr = fsw*frcidr ! near IR direct swidf = fsw*frcidf ! near IR diffuse + call icepack_query_parameters(calc_strair_out=calc_strair, cprho_out=cprho) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + if (.not. calc_strair) then + strax(:) = stress_atmice_x(:) + stray(:) = stress_atmice_y(:) + endif + + do i = 1, nx + ! ocean - ice stress + aux = sqrt((uvel(i)-uocn(i))**2+(vvel(i)-vocn(i))**2)*rhowat*cd_oce_ice + strocnxT(i) = aux*(uvel(i) - uocn(i)) + strocnyT(i) = aux*(vvel(i) - vocn(i)) + ! freezing - melting potential + Tf(i) = icepack_sea_freezing_temperature(sss(i)) + frzmlt(i) = min((Tf(i)-sst(i)) * cprho * hmix(i) / dt, 1000.0_dbl_kind) + enddo + + ! Compute convergence and shear on the nodes + + do n = 1, nx_nh + tvol = c0 + tx = c0 + ty = c0 + do k = 1, nod_in_elem2D_num(n) + elem = nod_in_elem2D(k,n) + tvol = tvol + elem_area(elem) + tx = tx + rdg_conv_elem(elem) * elem_area(elem) + ty = ty + rdg_shear_elem(elem) * elem_area(elem) + enddo + rdg_conv(n) = tx / tvol + rdg_shear(n) = ty / tvol + enddo + + call exchange_nod(rdg_conv, rdg_shear) + end subroutine fesom_to_icepack !======================================================================= - module subroutine icepack_to_fesom() + module subroutine icepack_to_fesom( nx_in, & + aice_out, vice_out, vsno_out, & + fhocn_tot_out, fresh_tot_out, & + strocnxT_out, strocnyT_out) implicit none + integer (kind=int_kind), intent(in) :: & + nx_in ! block dimensions -!======================================================================= + real (kind=dbl_kind), dimension(nx_in), intent(out), optional :: & + aice_out, & + vice_out, & + vsno_out, & + fhocn_tot_out, & + fresh_tot_out, & + strocnxT_out, & + strocnyT_out + + character(len=*),parameter :: subname='(icepack_to_fesom)' + + + if (present(aice_out) ) aice_out = aice + if (present(vice_out) ) vice_out = vice + if (present(vsno_out) ) vsno_out = vsno + if (present(fresh_tot_out) ) fresh_tot_out = fresh_tot + if (present(fhocn_tot_out) ) fhocn_tot_out = fhocn_tot + if (present(strocnxT_out) ) strocnxT_out = strocnxT + if (present(strocnyT_out) ) strocnyT_out = strocnyT end subroutine icepack_to_fesom From 60567a71d6cf431cec444a023ec062d8310c5fc1 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 28 May 2020 15:23:30 +0200 Subject: [PATCH 18/54] Transfer clock variables --- src/icepack_drivers/icedrv_transfer.F90 | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 index 07d052b2a..6e8637596 100644 --- a/src/icepack_drivers/icedrv_transfer.F90 +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -29,9 +29,11 @@ module subroutine fesom_to_icepack(mesh) use g_comm_auto, only: exchange_nod use icedrv_system, only: icedrv_system_abort use g_config, only: dt + use o_param, only: mstep use mod_mesh use o_mesh use g_parsup + use g_clock implicit none @@ -145,6 +147,27 @@ module subroutine fesom_to_icepack(mesh) call exchange_nod(rdg_conv, rdg_shear) + ! Clock variables + + days_per_year = ndpyr + daymo = num_day_in_month(fleapyear,:) + if (fleapyear==1) then + daycal = daycal366 + else + daycal = daycal365 + end if + istep1 = mstep + time = mstep*dt + mday = day_in_month + month_i = month + nyr = yearnew + sec = timenew + yday = real(ndpyr, kind=dbl_kind) + dayyr = real(days_per_year, kind=dbl_kind) + secday = real(sec, kind=dbl_kind) + calendar_type = 'Gregorian' + dt_dyn = dt/real(ndtd,kind=dbl_kind) ! dynamics et al timestep + end subroutine fesom_to_icepack !======================================================================= From 70cb8cdaeca766eca92841915550b1467c86903a Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 28 May 2020 17:10:52 +0200 Subject: [PATCH 19/54] Added icepack step submodule --- src/icepack_drivers/icedrv_allocate.F90 | 9 +- src/icepack_drivers/icedrv_main.F90 | 62 +- src/icepack_drivers/icedrv_oml.F90 | 106 -- src/icepack_drivers/icedrv_step.F90 | 1200 +++++++++++++++++++++++ 4 files changed, 1210 insertions(+), 167 deletions(-) delete mode 100644 src/icepack_drivers/icedrv_oml.F90 create mode 100644 src/icepack_drivers/icedrv_step.F90 diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 index 5eab0f927..70426b74e 100644 --- a/src/icepack_drivers/icedrv_allocate.F90 +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -236,11 +236,12 @@ module subroutine alloc_flux fsalt_ai(nx), & ! salt flux to ocean (kg/m^2/s) fhocn_ai(nx), & ! net heat flux to ocean (W/m^2) fswthru_ai(nx), & ! shortwave penetrating to ocean (W/m^2) - rside(nx) , & ! fraction of ice that melts laterally - fsw(nx) , & ! incoming shortwave radiation (W/m^2) + rside(nx) , & ! fraction of ice that melts laterally + fside(nx) , & ! lateral heat flux (W/m^2) + fsw(nx) , & ! incoming shortwave radiation (W/m^2) cos_zen(nx) , & ! cosine solar zenith angle, < 0 for sun below horizon - rdg_conv(nx) , & ! convergence term for ridging on nodes (1/s) - rdg_shear(nx), & ! shear term for ridging on nodes (1/s) + rdg_conv(nx) , & ! convergence term for ridging on nodes (1/s) + rdg_shear(nx) , & ! shear term for ridging on nodes (1/s) rdg_conv_elem(nx_elem), & ! convergence term for ridging on elements (1/s) rdg_shear_elem(nx_elem), & ! shear term for ridging on elements (1/s) salinz(nx,nilyr+1) , & ! initial salinity profile (ppt) diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index e5cfe173c..d0087aeff 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -339,7 +339,8 @@ module icedrv_main real (kind=dbl_kind), allocatable, save :: & ! DIM nx rside(:), & ! fraction of ice that melts laterally - cos_zen(:), & ! cosine solar zenith angle, < 0 for sun below horizon + fside(:), & ! lateral heat flux (W/m^2) + cos_zen(:), & ! cosine solar zenith angle, < 0 for sun below horizon rdg_conv_elem(:), & ! convergence term for ridging on elements (1/s) rdg_shear_elem(:), & ! shear term for ridging on elements (1/s) rdg_conv(:), & ! convergence term for ridging on nodes (1/s) @@ -886,63 +887,10 @@ module subroutine init_advection_icepack(mesh) type(t_mesh), intent(in), target :: mesh end subroutine init_advection_icepack - ! Ocean mixed layer - - module subroutine ocn_mixed_layer_icepack( & - alvdr_ocn, swvdr, & - alidr_ocn, swidr, & - alvdf_ocn, swvdf, & - alidf_ocn, swidf, & - sst, flwout_ocn, & - fsens_ocn, shcoef, & - flat_ocn, lhcoef, & - evap_ocn, flw, & - delt, delq, & - aice, fhocn, & - fswthru, hmix, & - Tf, fresh, & - frain, fsnow, & - fhocn_tot, fresh_tot, & - frzmlt) - + ! Driving subroutine for column physics + module subroutine step_icepack implicit none - - real (kind=dbl_kind), intent(in) :: & - alvdr_ocn , & ! visible, direct (fraction) - alidr_ocn , & ! near-ir, direct (fraction) - alvdf_ocn , & ! visible, diffuse (fraction) - alidf_ocn , & ! near-ir, diffuse (fraction) - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf , & ! sw down, near IR, diffuse (W/m^2) - flw , & ! incoming longwave radiation (W/m^2) - Tf , & ! freezing temperature (C) - hmix , & ! mixed layer depth (m) - delt , & ! potential temperature difference (K) - delq , & ! specific humidity difference (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - fswthru , & ! shortwave penetrating to ocean (W/m^2) - aice , & ! ice area fraction - sst , & ! sea surface temperature (C) - frain , & ! rainfall rate (kg/m^2/s) - fsnow ! snowfall rate (kg/m^2/s) - - real (kind=dbl_kind), intent(inout) :: & - flwout_ocn, & ! outgoing longwave radiation (W/m^2) - fsens_ocn , & ! sensible heat flux (W/m^2) - flat_ocn , & ! latent heat flux (W/m^2) - evap_ocn , & ! evaporative water flux (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - frzmlt ! freezing/melting potential (W/m^2) - - real (kind=dbl_kind), intent(out) :: & - fhocn_tot , & ! net total heat flux to ocean (W/m^2) - fresh_tot ! fresh total water flux to ocean (kg/m^2/s) - - end subroutine ocn_mixed_layer_icepack + end subroutine step_icepack end interface diff --git a/src/icepack_drivers/icedrv_oml.F90 b/src/icepack_drivers/icedrv_oml.F90 deleted file mode 100644 index 2c3d94d01..000000000 --- a/src/icepack_drivers/icedrv_oml.F90 +++ /dev/null @@ -1,106 +0,0 @@ -!======================================================================= -! -! This submodule contain an ocean mixed layer implementation -! -! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) -! -!======================================================================= - - submodule (icedrv_main) icedrv_ocean_mix_layer - - contains - - module subroutine ocn_mixed_layer_icepack( & - alvdr_ocn, swvdr, & - alidr_ocn, swidr, & - alvdf_ocn, swvdf, & - alidf_ocn, swidf, & - sst, flwout_ocn, & - fsens_ocn, shcoef, & - flat_ocn, lhcoef, & - evap_ocn, flw, & - delt, delq, & - aice, fhocn, & - fswthru, hmix, & - Tf, fresh, & - frain, fsnow, & - fhocn_tot, fresh_tot, & - frzmlt) - - use i_therm_param, only: emiss_wat - - real (kind=dbl_kind), intent(in) :: & - alvdr_ocn , & ! visible, direct (fraction) - alidr_ocn , & ! near-ir, direct (fraction) - alvdf_ocn , & ! visible, diffuse (fraction) - alidf_ocn , & ! near-ir, diffuse (fraction) - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf , & ! sw down, near IR, diffuse (W/m^2) - flw , & ! incoming longwave radiation (W/m^2) - Tf , & ! freezing temperature (C) - hmix , & ! mixed layer depth (m) - delt , & ! potential temperature difference (K) - delq , & ! specific humidity difference (kg/kg) - shcoef , & ! transfer coefficient for sensible heat - lhcoef , & ! transfer coefficient for latent heat - fswthru , & ! shortwave penetrating to ocean (W/m^2) - aice , & ! ice area fraction - sst , & ! sea surface temperature (C) - frain , & ! rainfall rate (kg/m^2/s) - fsnow ! snowfall rate (kg/m^2/s) - - real (kind=dbl_kind), intent(inout) :: & - flwout_ocn, & ! outgoing longwave radiation (W/m^2) - fsens_ocn , & ! sensible heat flux (W/m^2) - flat_ocn , & ! latent heat flux (W/m^2) - evap_ocn , & ! evaporative water flux (kg/m^2/s) - fhocn , & ! net heat flux to ocean (W/m^2) - fresh , & ! fresh water flux to ocean (kg/m^2/s) - frzmlt ! freezing/melting potential (W/m^2) - - real (kind=dbl_kind), intent(out) :: & - fhocn_tot , & ! net total heat flux to ocean (W/m^2) - fresh_tot ! fresh total water flux to ocean (kg/m^2/s) - - real (kind=dbl_kind), parameter :: & - frzmlt_max = c1000 ! max magnitude of frzmlt (W/m^2) - - real (kind=dbl_kind) :: & - TsfK , & ! surface temperature (K) - swabs, & ! surface absorbed shortwave heat flux (W/m^2) - sst_n, & ! temporary new sst - fhocn_n, & - fresh_n - - character(len=*),parameter :: subname='(icepack_ocn_mixed_layer)' - - ! shortwave radiative flux ! Visible is absorbed by clorophil afterwards - swabs = (c1-alidr_ocn) * swidr + (c1-alidf_ocn) * swidf + & - (c1-alvdr_ocn) * swvdr + (c1-alvdf_ocn) * swvdf - - ! ocean surface temperature in Kelvin - TsfK = sst + Tffresh - - ! longwave radiative flux - ! Water emissivity added to be consistent - ! with the standard FESOM2 version - flwout_ocn = - emiss_wat * stefan_boltzmann * TsfK**4 - - ! downward latent and sensible heat fluxes - fsens_ocn = shcoef * delt - flat_ocn = lhcoef * delq - evap_ocn = -flat_ocn / Lvap - - ! Compute heat change due to exchange between ocean and atmosphere - - fhocn_tot = fhocn + fswthru & ! these are *aice already - + (fsens_ocn + flat_ocn + flwout_ocn + flw + swabs & - + Lfresh*fsnow) * (c1-aice) + max(c0,frzmlt)*aice - - fresh_tot = fresh + (-evap_ocn + frain + fsnow)*(c1-aice) - - end subroutine ocn_mixed_layer_icepack - - end submodule icedrv_ocean_mix_layer diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 new file mode 100644 index 000000000..4c7e8e01b --- /dev/null +++ b/src/icepack_drivers/icedrv_step.F90 @@ -0,0 +1,1200 @@ +!======================================================================= +! +! Contains Icepack component driver routines common to all drivers. +! +! Authors: Lorenzo Zampieri ( lorenzo.zampieri@awi.de ) +!======================================================================= + +submodule (icedrv_main) icedrv_step + + use icedrv_constants, only: c0, nu_diag, c4 + use icedrv_kinds + use icedrv_system, only: icedrv_system_abort + use icepack_intfc, only: icepack_warnings_flush + use icepack_intfc, only: icepack_warnings_aborted + use icepack_intfc, only: icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_indices + use icepack_intfc, only: icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_parameters + + implicit none + +!======================================================================= + + contains + +!======================================================================= +! +! Scales radiation fields computed on the previous time step. +! + + subroutine prep_radiation () + + ! column package includes + use icepack_intfc, only: icepack_prep_radiation + + implicit none + + ! local variables + integer (kind=int_kind) :: & + i ! horizontal indices + + character(len=*), parameter :: subname='(prep_radiation)' + + !----------------------------------------------------------------- + ! Compute netsw scaling factor (new netsw / old netsw) + !----------------------------------------------------------------- + + do i = 1, nx + + alvdr_init(i) = alvdr_ai(i) + alvdf_init(i) = alvdf_ai(i) + alidr_init(i) = alidr_ai(i) + alidf_init(i) = alidf_ai(i) + + call icepack_prep_radiation(ncat=ncat, nilyr=nilyr, nslyr=nslyr, & + aice=aice(i), aicen=aicen(i,:), & + swvdr=swvdr(i), swvdf=swvdf(i), & + swidr=swidr(i), swidf=swidf(i), & + alvdr_ai=alvdr_ai(i), alvdf_ai=alvdf_ai(i), & + alidr_ai=alidr_ai(i), alidf_ai=alidf_ai(i), & + scale_factor=scale_factor(i), & + fswsfcn=fswsfcn(i,:), fswintn=fswintn(i,:), & + fswthrun=fswthrun(i,:), fswpenln=fswpenln(i,:,:), & + Sswabsn=Sswabsn(i,:,:), Iswabsn=Iswabsn(i,:,:)) + + enddo ! i + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine prep_radiation + +!======================================================================= +! +! Driver for updating ice and snow internal temperatures and +! computing thermodynamic growth rates and coupler fluxes. +! + + subroutine step_therm1 (dt) + + ! column packge includes + use icepack_intfc, only: icepack_step_therm1 + + implicit none + + logical (kind=log_kind) :: & + prescribed_ice ! if .true., use prescribed ice instead of computed + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + i , & ! horizontal indices + n , & ! thickness category index + k, kk ! indices for aerosols + + integer (kind=int_kind) :: & + ntrcr, nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, nt_vlvl, nt_Tsfc, & + nt_iage, nt_FY, nt_qice, nt_sice, nt_aero, nt_qsno + + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_aero, tr_pond, tr_pond_cesm, & + tr_pond_lvl, tr_pond_topo, calc_Tsfc + + real (kind=dbl_kind), dimension(n_aero,2,ncat) :: & + aerosno, aeroice ! kg/m^2 + + real (kind=dbl_kind) :: & + puny + + character(len=*), parameter :: subname='(step_therm1)' + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_sizes( & + ntrcr_out=ntrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_flags( & + tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_aero_out=tr_aero, tr_pond_out=tr_pond, tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_indices( & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, & + nt_aero_out=nt_aero, nt_qsno_out=nt_qsno) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + + prescribed_ice = .false. + aerosno(:,:,:) = c0 + aeroice(:,:,:) = c0 + + do i = 1, nx + + !----------------------------------------------------------------- + ! Save the ice area passed to the coupler (so that history fields + ! can be made consistent with coupler fields). + ! Save the initial ice area and volume in each category. + !----------------------------------------------------------------- + + aice_init (i) = aice (i) + + do n = 1, ncat + aicen_init(i,n) = aicen(i,n) + vicen_init(i,n) = vicen(i,n) + vsnon_init(i,n) = vsnon(i,n) + enddo + + enddo ! i + + do i = 1, nx + if (tr_aero) then + ! trcrn(nt_aero) has units kg/m^3 + do n=1,ncat + do k=1,n_aero + aerosno (k,:,n) = & + trcrn(i,nt_aero+(k-1)*4 :nt_aero+(k-1)*4+1,n) & + * vsnon_init(i,n) + aeroice (k,:,n) = & + trcrn(i,nt_aero+(k-1)*4+2:nt_aero+(k-1)*4+3,n) & + * vicen_init(i,n) + enddo + enddo + endif ! tr_aero + + call icepack_step_therm1(dt=dt, ncat=ncat, nilyr=nilyr, nslyr=nslyr, & + aicen_init = aicen_init(i,:), & + vicen_init = vicen_init(i,:), & + vsnon_init = vsnon_init(i,:), & + aice = aice(i), aicen = aicen(i,:), & + vice = vice(i), vicen = vicen(i,:), & + vsno = vsno(i), vsnon = vsnon(i,:), & + uvel = uvel(i), vvel = vvel(i), & + Tsfc = trcrn(i,nt_Tsfc,:), & + zqsn = trcrn(i,nt_qsno:nt_qsno+nslyr-1,:), & + zqin = trcrn(i,nt_qice:nt_qice+nilyr-1,:), & + zSin = trcrn(i,nt_sice:nt_sice+nilyr-1,:), & + alvl = trcrn(i,nt_alvl,:), & + vlvl = trcrn(i,nt_vlvl,:), & + apnd = trcrn(i,nt_apnd,:), & + hpnd = trcrn(i,nt_hpnd,:), & + ipnd = trcrn(i,nt_ipnd,:), & + iage = trcrn(i,nt_iage,:), & + FY = trcrn(i,nt_FY,:), & + aerosno = aerosno(:,:,:), & + aeroice = aeroice(:,:,:), & + uatm = uatm(i), vatm = vatm(i), & + wind = wind(i), & + zlvl_v = zlvl_v, & + zlvl_q = zlvl_q, & + zlvl_t = zlvl_t, & + Qa = Qa(i), rhoa = rhoa(i), & + Tair = T_air(i), Tref = Tref(i), & + Qref = Qref(i), Uref = Uref(i), & + Cdn_atm_ratio = Cdn_atm_ratio(i),& + Cdn_ocn = Cdn_ocn(i), & + Cdn_ocn_skin = Cdn_ocn_skin(i), & + Cdn_ocn_floe = Cdn_ocn_floe(i), & + Cdn_ocn_keel = Cdn_ocn_keel(i), & + Cdn_atm = Cdn_atm(i), & + Cdn_atm_skin = Cdn_atm_skin(i), & + Cdn_atm_floe = Cdn_atm_floe(i), & + Cdn_atm_pond = Cdn_atm_pond(i), & + Cdn_atm_rdg = Cdn_atm_rdg(i), & + hfreebd = hfreebd(i), hkeel = hkeel(i), & + hdraft = hdraft(i), hridge = hridge(i), & + distrdg = distrdg(i), dkeel = dkeel(i), & + lfloe = lfloe(i), dfloe = dfloe(i), & + strax = strax(i), stray = stray(i), & + strairxT = strairxT(i), strairyT = strairyT(i), & + potT = potT(i), sst = sst(i), & + sss = sss(i), Tf = Tf(i), & + strocnxT = strocnxT(i), strocnyT = strocnyT(i), & + fbot = fbot(i), frzmlt = frzmlt(i), & + Tbot = Tbot(i), Tsnice = Tsnice(i), & + rside = rside(i), fside = fside(i), & + fsnow = fsnow(i), frain = frain(i), & + fpond = fpond(i), & + fsurf = fsurf(i), fsurfn = fsurfn(i,:), & + fcondtop = fcondtop(i), fcondtopn = fcondtopn(i,:), & + fcondbot = fcondbot(i), fcondbotn = fcondbotn(i,:), & + fswsfcn = fswsfcn(i,:), fswintn = fswintn(i,:), & + fswthrun = fswthrun(i,:), fswabs = fswabs(i), & + flwout = flwout(i), flw = flw(i), & + fsens = fsens(i), fsensn = fsensn(i,:), & + flat = flat(i), flatn = flatn(i,:), & + fresh = fresh(i), fsalt = fsalt(i), & + fhocn = fhocn(i), fswthru = fswthru(i), & + flatn_f = flatn_f(i,:), fsensn_f = fsensn_f(i,:), & + fsurfn_f = fsurfn_f(i,:), & + fcondtopn_f = fcondtopn_f(i,:), & + faero_atm = faero_atm(i,1:n_aero), & + faero_ocn = faero_ocn(i,1:n_aero), & + Sswabsn = Sswabsn(i,:,:),Iswabsn = Iswabsn(i,:,:), & + evap = evap(i), evaps = evaps(i), evapi = evapi(i), & + dhsn = dhsn(i,:), ffracn = ffracn(i,:), & + meltt = meltt(i), melttn = melttn(i,:), & + meltb = meltb(i), meltbn = meltbn(i,:), & + melts = melts(i), meltsn = meltsn(i,:), & + congel = congel(i), congeln = congeln(i,:), & + snoice = snoice(i), snoicen = snoicen(i,:), & + dsnown = dsnown(i,:), & + lmask_n = lmask_n(i), lmask_s = lmask_s(i), & + mlt_onset=mlt_onset(i), frz_onset = frz_onset(i), & + yday = yday, prescribed_ice = prescribed_ice) + + if (tr_aero) then + do n = 1, ncat + if (vicen(i,n) > puny) & + aeroice(:,:,n) = aeroice(:,:,n)/vicen(i,n) + if (vsnon(i,n) > puny) & + aerosno(:,:,n) = aerosno(:,:,n)/vsnon(i,n) + do k = 1, n_aero + do kk = 1, 2 + trcrn(i,nt_aero+(k-1)*4+kk-1,n)=aerosno(k,kk,n) + trcrn(i,nt_aero+(k-1)*4+kk+1,n)=aeroice(k,kk,n) + enddo + enddo + enddo + endif ! tr_aero + + enddo ! i + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine step_therm1 + +!======================================================================= +! Driver for thermodynamic changes not needed for coupling: +! transport in thickness space, lateral growth and melting. +! + + subroutine step_therm2 (dt) + + ! column package_includes + use icepack_intfc, only: icepack_step_therm2 + + implicit none + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + i ! horizontal index + + integer (kind=int_kind) :: & + ntrcr, nbtrcr + + logical (kind=log_kind) :: & + tr_fsd ! floe size distribution tracers + + character(len=*), parameter :: subname='(step_therm2)' + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + + do i = 1, nx + + ! wave_sig_ht - compute here to pass to add new ice + if (tr_fsd) & + wave_sig_ht(i) = c4*SQRT(SUM(wave_spectrum(i,:)*dwavefreq(:))) + + call icepack_step_therm2(dt=dt, ncat=ncat, & + nltrcr=nltrcr, nilyr=nilyr, nslyr=nslyr, & + hin_max=hin_max(:), nblyr=nblyr, & + aicen=aicen(i,:), & + vicen=vicen(i,:), & + vsnon=vsnon(i,:), & + aicen_init=aicen_init(i,:), & + vicen_init=vicen_init(i,:), & + trcrn=trcrn(i,1:ntrcr,:), & + aice0=aice0(i), & + aice =aice(i), & + 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,:), & + Tf=Tf(i), sss=sss(i), & + salinz=salinz(i,:), fside=fside(i), & + rside=rside(i), meltl=meltl(i), & + frzmlt=frzmlt(i), frazil=frazil(i), & + frain=frain(i), fpond=fpond(i), & + fresh=fresh(i), fsalt=fsalt(i), & + fhocn=fhocn(i), update_ocn_f=update_ocn_f, & + bgrid=bgrid, cgrid=cgrid, & + igrid=igrid, faero_ocn=faero_ocn(i,:), & + first_ice=first_ice(i,:), & + fzsal=fzsal(i), & + flux_bio=flux_bio(i,1:nbtrcr), & + ocean_bio=ocean_bio(i,1:nbtrcr), & + frazil_diag=frazil_diag(i), & + frz_onset=frz_onset(i), & + yday=yday, & + nfsd=nfsd, wave_sig_ht=wave_sig_ht(i), & + wave_spectrum=wave_spectrum(i,:), & + wavefreq=wavefreq(:), & + dwavefreq=dwavefreq(:), & + d_afsd_latg=d_afsd_latg(i,:), & + d_afsd_newi=d_afsd_newi(i,:), & + d_afsd_latm=d_afsd_latm(i,:), & + d_afsd_weld=d_afsd_weld(i,:), & + floe_rad_c=floe_rad_c(:), & + floe_binwidth=floe_binwidth(:)) + + enddo ! i + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine step_therm2 + +!======================================================================= +! +! finalize thermo updates +! + + subroutine update_state (dt, daidt, dvidt, dagedt, offset) + + ! column package includes + use icepack_intfc, only: icepack_aggregate + + implicit none + + real (kind=dbl_kind), intent(in) :: & + dt , & ! time step + offset ! d(age)/dt time offset = dt for thermo, 0 for dyn + + real (kind=dbl_kind), dimension(:), intent(inout) :: & + daidt, & ! change in ice area per time step + dvidt, & ! change in ice volume per time step + dagedt ! change in ice age per time step + + integer (kind=int_kind) :: & + i, & ! horizontal indices + ntrcr, & ! + nt_iage ! + + logical (kind=log_kind) :: & + tr_iage ! ice age tracer + + character(len=*), parameter :: subname='(update_state)' + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_indices(nt_iage_out=nt_iage) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_flags(tr_iage_out=tr_iage) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !$OMP PARALLEL DO PRIVATE(i) + do i = 1, nx + + !----------------------------------------------------------------- + ! Aggregate the updated state variables (includes ghost cells). + !----------------------------------------------------------------- + + call icepack_aggregate (ncat=ncat, & + aicen=aicen(i,:), trcrn=trcrn(i,1:ntrcr,:), & + vicen=vicen(i,:), vsnon=vsnon(i,:), & + aice =aice (i), trcr =trcr (i,1:ntrcr), & + vice =vice (i), vsno =vsno (i), & + aice0=aice0(i), & + 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,:)) + + !----------------------------------------------------------------- + ! Compute thermodynamic area and volume tendencies. + !----------------------------------------------------------------- + + daidt(i) = (aice(i) - daidt(i)) / dt + dvidt(i) = (vice(i) - dvidt(i)) / dt + if (tr_iage) then + if (offset > c0) then ! thermo + if (trcr(i,nt_iage) > c0) & + dagedt(i) = (trcr(i,nt_iage) & + - dagedt(i) - offset) / dt + else ! dynamics + dagedt(i) = (trcr(i,nt_iage) & + - dagedt(i)) / dt + endif + endif + + enddo ! i + !$OMP END PARALLEL DO + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine update_state + +!======================================================================= +! +! Run one time step of wave-fracturing the floe size distribution +! + + subroutine step_dyn_wave (dt) + + ! column package includes + use icepack_intfc, only: icepack_step_wavefracture + + implicit none + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + i, j, & ! horizontal indices + ntrcr, & ! + nbtrcr ! + + character (len=char_len) :: wave_spec_type + + character(len=*), parameter :: subname = '(step_dyn_wave)' + + call icepack_query_parameters(wave_spec_type_out=wave_spec_type) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + do i = 1, nx + d_afsd_wave(i,:) = c0 + call icepack_step_wavefracture (wave_spec_type=wave_spec_type, & + dt=dt, ncat=ncat, nfsd=nfsd, nfreq=nfreq, & + aice = aice (i), & + vice = vice (i), & + aicen = aicen (i,:), & + floe_rad_l = floe_rad_l (:), & + floe_rad_c = floe_rad_c (:), & + wave_spectrum = wave_spectrum(i,:), & + wavefreq = wavefreq (:), & + dwavefreq = dwavefreq (:), & + trcrn = trcrn (i,:,:), & + d_afsd_wave = d_afsd_wave (i,:)) + end do ! i + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + end subroutine step_dyn_wave + +!======================================================================= +! +! Run one time step of ridging. +! + + subroutine step_dyn_ridge (dt, ndtd) + + ! column package includes + use icepack_intfc, only: icepack_step_ridge + + implicit none + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + ndtd ! number of dynamics subcycles + + ! local variables + + integer (kind=int_kind) :: & + i, & ! horizontal indices + ntrcr, & ! + nbtrcr ! + + character(len=*), parameter :: subname='(step_dyn_ridge)' + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + ! Ridging + !----------------------------------------------------------------- + + + do i = 1, nx + + call icepack_step_ridge (dt=dt, ndtd=ndtd, & + nilyr=nilyr, nslyr=nslyr, & + nblyr=nblyr, & + ncat=ncat, hin_max=hin_max(:), & + rdg_conv=rdg_conv(i), rdg_shear=rdg_shear(i), & + aicen=aicen(i,:), & + trcrn=trcrn(i,1:ntrcr,:), & + vicen=vicen(i,:), vsnon=vsnon(i,:), & + aice0=aice0(i), & + 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,:), & + dardg1dt=dardg1dt(i), dardg2dt=dardg2dt(i), & + dvirdgdt=dvirdgdt(i), opening=opening(i), & + fpond=fpond(i), & + fresh=fresh(i), fhocn=fhocn(i), & + n_aero=n_aero, & + faero_ocn=faero_ocn(i,:), & + aparticn=aparticn(i,:), krdgn=krdgn(i,:), & + aredistn=aredistn(i,:), vredistn=vredistn(i,:), & + dardg1ndt=dardg1ndt(i,:), dardg2ndt=dardg2ndt(i,:), & + dvirdgndt=dvirdgndt(i,:), & + araftn=araftn(i,:), vraftn=vraftn(i,:), & + aice=aice(i), fsalt=fsalt(i), & + first_ice=first_ice(i,:), fzsal=fzsal(i), & + flux_bio=flux_bio(i,1:nbtrcr)) + + enddo + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine step_dyn_ridge + +!======================================================================= +! +! Computes radiation fields +! + + subroutine step_radiation (dt) + + ! column package includes + use icepack_intfc, only: icepack_step_radiation + + implicit none + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + i, n, k ! horizontal indices + + integer (kind=int_kind) :: & + max_aero, max_algae, nt_Tsfc, nt_alvl, & + nt_apnd, nt_hpnd, nt_ipnd, nt_aero, nlt_chl_sw, & + ntrcr, nbtrcr_sw, nt_fbri + + integer (kind=int_kind), dimension(:), allocatable :: & + nlt_zaero_sw, nt_zaero, nt_bgc_N + + logical (kind=log_kind) :: & + tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero + + real (kind=dbl_kind), dimension(ncat) :: & + fbri ! brine height to ice thickness + + real(kind= dbl_kind), dimension(:,:), allocatable :: & + ztrcr_sw + + logical (kind=log_kind) :: & + l_print_point ! flag for printing debugging information + + character(len=*), parameter :: subname='(step_radiation)' + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_tracer_sizes( & + max_aero_out=max_aero, max_algae_out=max_algae) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + allocate(nlt_zaero_sw(max_aero)) + allocate(nt_zaero(max_aero)) + allocate(nt_bgc_N(max_algae)) + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_sw_out=nbtrcr_sw) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_flags( & + tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_zaero_out=tr_zaero) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_indices( & + nt_Tsfc_out=nt_Tsfc, nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & + nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, & + nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw, & + nt_fbri_out=nt_fbri, nt_zaero_out=nt_zaero, nt_bgc_N_out=nt_bgc_N) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_parameters(dEdd_algae_out=dEdd_algae, modal_aero_out=modal_aero) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + + allocate(ztrcr_sw(nbtrcr_sw,ncat)) + + l_print_point = .false. + + do i = 1, nx + + fbri(:) = c0 + ztrcr_sw(:,:) = c0 + do n = 1, ncat + if (tr_brine) fbri(n) = trcrn(i,nt_fbri,n) + enddo + + + call icepack_step_radiation(dt=dt, ncat=ncat, & + nblyr=nblyr, nilyr=nilyr, & + nslyr=nslyr, dEdd_algae=dEdd_algae, & + swgrid=swgrid(:), igrid=igrid(:), & + fbri=fbri(:), & + aicen=aicen(i,:), vicen=vicen(i,:), & + vsnon=vsnon(i,:), & + Tsfcn=trcrn(i,nt_Tsfc,:), & + alvln=trcrn(i,nt_alvl,:), & + apndn=trcrn(i,nt_apnd,:), & + hpndn=trcrn(i,nt_hpnd,:), & + ipndn=trcrn(i,nt_ipnd,:), & + aeron=trcrn(i,nt_aero:nt_aero+4*n_aero-1,:), & + bgcNn=trcrn(i,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:), & + zaeron=trcrn(i,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:), & + trcrn_bgcsw=ztrcr_sw, & + TLAT=lat_val(i), TLON=lon_val(i), & + calendar_type=calendar_type, & + days_per_year=days_per_year, sec=sec, & + nextsw_cday=nextsw_cday, yday=yday, & + kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & + waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & + gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & + bcenh=bcenh(:,:,:), modal_aero=modal_aero, & + swvdr=swvdr(i), swvdf=swvdf(i), & + swidr=swidr(i), swidf=swidf(i), & + coszen=cos_zen(i), fsnow=fsnow(i), & + alvdrn=alvdrn(i,:), alvdfn=alvdfn(i,:), & + alidrn=alidrn(i,:), alidfn=alidfn(i,:), & + fswsfcn=fswsfcn(i,:), fswintn=fswintn(i,:), & + fswthrun=fswthrun(i,:), fswpenln=fswpenln(i,:,:), & + Sswabsn=Sswabsn(i,:,:), Iswabsn=Iswabsn(i,:,:), & + albicen=albicen(i,:), albsnon=albsnon(i,:), & + albpndn=albpndn(i,:), apeffn=apeffn(i,:), & + snowfracn=snowfracn(i,:), & + dhsn=dhsn(i,:), ffracn=ffracn(i,:), & + l_print_point=l_print_point) + + + if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then + do n = 1, ncat + do k = 1, nbtrcr_sw + trcrn_sw(i,k,n) = ztrcr_sw(k,n) + enddo + enddo + endif + + enddo ! i + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + deallocate(ztrcr_sw) + deallocate(nlt_zaero_sw) + deallocate(nt_zaero) + deallocate(nt_bgc_N) + + end subroutine step_radiation + +!======================================================================= +! +! Ocean mixed layer calculation (internal to sea ice model). +! Allows heat storage in ocean for uncoupled runs. +! + + subroutine ocean_mixed_layer (dt) + + use icepack_intfc, only: icepack_ocn_mixed_layer, icepack_atm_boundary + + implicit none + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + i ! horizontal indices + + real (kind=dbl_kind) :: & + albocn + + real (kind=dbl_kind), dimension(nx) :: & + delt , & ! potential temperature difference (K) + delq , & ! specific humidity difference (kg/kg) + shcoef, & ! transfer coefficient for sensible heat + lhcoef ! transfer coefficient for latent heat + + character(len=*), parameter :: subname='(ocean_mixed_layer)' + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(albocn_out=albocn) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Compute boundary layer quantities + !----------------------------------------------------------------- + + do i = 1, nx + call icepack_atm_boundary(sfctype = 'ocn', & + Tsf = sst(i), & + potT = potT(i), & + uatm = uatm(i), & + vatm = vatm(i), & + wind = wind(i), & + zlvl_t = zlvl_t, & + zlvl_q = zlvl_q, & + zlvl_v = zlvl_v, & + Qa = Qa(i), & + rhoa = rhoa(i), & + strx = strairx_ocn(i), & + stry = strairy_ocn(i), & + Tref = Tref_ocn(i), & + Qref = Qref_ocn(i), & + delt = delt(i), & + delq = delq(i), & + lhcoef = lhcoef(i), & + shcoef = shcoef(i), & + Cdn_atm = Cdn_atm(i), & + Cdn_atm_ratio_n = Cdn_atm_ratio(i)) + enddo ! i + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Ocean albedo + ! For now, assume albedo = albocn in each spectral band. + !----------------------------------------------------------------- + + alvdr_ocn(:) = albocn + alidr_ocn(:) = albocn + alvdf_ocn(:) = albocn + alidf_ocn(:) = albocn + + !----------------------------------------------------------------- + ! Compute ocean fluxes and update SST + !----------------------------------------------------------------- + + do i = 1, nx + call ocn_mixed_layer_icepack( alvdr_ocn=alvdr_ocn(i), swvdr=swvdr(i), & + alidr_ocn=alidr_ocn(i), swidr=swidr(i), & + alvdf_ocn=alvdf_ocn(i), swvdf=swvdf(i), & + alidf_ocn=alidf_ocn(i), swidf=swidf(i), & + flwout_ocn=flwout_ocn(i),sst=sst(i), & + fsens_ocn=fsens_ocn(i), shcoef=shcoef(i), & + flat_ocn=flat_ocn(i), lhcoef=lhcoef(i), & + evap_ocn=evap_ocn(i), flw=flw(i), & + delt=delt(i), delq=delq(i), & + aice=aice(i), fhocn=fhocn(i), & + fswthru=fswthru(i), hmix=hmix(i), & + Tf=Tf(i), fresh=fresh(i), & + frain=frain(i), fsnow=fsnow(i), & + fhocn_tot=fhocn_tot(i), fresh_tot=fresh_tot(i), & + frzmlt=frzmlt(i) ) + enddo ! i + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine ocean_mixed_layer + +!======================================================================= + + subroutine ocn_mixed_layer_icepack( & + alvdr_ocn, swvdr, & + alidr_ocn, swidr, & + alvdf_ocn, swvdf, & + alidf_ocn, swidf, & + sst, flwout_ocn, & + fsens_ocn, shcoef, & + flat_ocn, lhcoef, & + evap_ocn, flw, & + delt, delq, & + aice, fhocn, & + fswthru, hmix, & + Tf, fresh, & + frain, fsnow, & + fhocn_tot, fresh_tot, & + frzmlt) + + use i_therm_param, only: emiss_wat + + implicit none + + real (kind=dbl_kind), intent(in) :: & + alvdr_ocn , & ! visible, direct (fraction) + alidr_ocn , & ! near-ir, direct (fraction) + alvdf_ocn , & ! visible, diffuse (fraction) + alidf_ocn , & ! near-ir, diffuse (fraction) + swvdr , & ! sw down, visible, direct (W/m^2) + swvdf , & ! sw down, visible, diffuse (W/m^2) + swidr , & ! sw down, near IR, direct (W/m^2) + swidf , & ! sw down, near IR, diffuse (W/m^2) + flw , & ! incoming longwave radiation (W/m^2) + Tf , & ! freezing temperature (C) + hmix , & ! mixed layer depth (m) + delt , & ! potential temperature difference (K) + delq , & ! specific humidity difference (kg/kg) + shcoef , & ! transfer coefficient for sensible heat + lhcoef , & ! transfer coefficient for latent heat + fswthru , & ! shortwave penetrating to ocean (W/m^2) + aice , & ! ice area fraction + sst , & ! sea surface temperature (C) + frain , & ! rainfall rate (kg/m^2/s) + fsnow ! snowfall rate (kg/m^2/s) + + real (kind=dbl_kind), intent(inout) :: & + flwout_ocn, & ! outgoing longwave radiation (W/m^2) + fsens_ocn , & ! sensible heat flux (W/m^2) + flat_ocn , & ! latent heat flux (W/m^2) + evap_ocn , & ! evaporative water flux (kg/m^2/s) + fhocn , & ! net heat flux to ocean (W/m^2) + fresh , & ! fresh water flux to ocean (kg/m^2/s) + frzmlt ! freezing/melting potential (W/m^2) + + real (kind=dbl_kind), intent(out) :: & + fhocn_tot , & ! net total heat flux to ocean (W/m^2) + fresh_tot ! fresh total water flux to ocean (kg/m^2/s) + + real (kind=dbl_kind), parameter :: & + frzmlt_max = c1000 ! max magnitude of frzmlt (W/m^2) + + real (kind=dbl_kind) :: & + TsfK , & ! surface temperature (K) + swabs, & ! surface absorbed shortwave heat flux (W/m^2) + Tffresh, & ! 273.15 + Lfresh, & + Lvap, & + stefan_boltzmann + + character(len=*),parameter :: subname='(icepack_ocn_mixed_layer)' + + call icepack_query_parameters( Tffresh_out=Tffresh, Lfresh_out=Lfresh, & + stefan_boltzmann_out=stefan_boltzmann, & + Lvap_out=Lvap ) + + ! shortwave radiative flux ! Visible is absorbed by clorophil + ! afterwards + swabs = (c1-alidr_ocn) * swidr + (c1-alidf_ocn) * swidf + & + (c1-alvdr_ocn) * swvdr + (c1-alvdf_ocn) * swvdf + + ! ocean surface temperature in Kelvin + TsfK = sst + Tffresh + + ! longwave radiative flux + ! Water emissivity added to be consistent + ! with the standard FESOM2 version + flwout_ocn = - emiss_wat * stefan_boltzmann * TsfK**4 + + ! downward latent and sensible heat fluxes + fsens_ocn = shcoef * delt + flat_ocn = lhcoef * delq + evap_ocn = -flat_ocn / Lvap + + ! Compute heat change due to exchange between ocean and atmosphere + + fhocn_tot = fhocn + fswthru & ! these are *aice already + + (fsens_ocn + flat_ocn + flwout_ocn + flw + swabs & + + Lfresh*fsnow) * (c1-aice) + max(c0,frzmlt)*aice + + fresh_tot = fresh + (-evap_ocn + frain + fsnow)*(c1-aice) + + end subroutine ocn_mixed_layer_icepack + +!======================================================================= + + subroutine coupling_prep(dt) + + ! local variables + + implicit none + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind) :: & + n , & ! thickness category index + i , & ! horizontal index + k , & ! tracer index + nbtrcr + + real (kind=dbl_kind) :: & + netsw, & ! flag for shortwave radiation presence + rhofresh, & ! + puny ! + + character(len=*), parameter :: subname='(coupling_prep)' + + !----------------------------------------------------------------- + ! Save current value of frzmlt for diagnostics. + ! Update mixed layer with heat and radiation from ice. + !----------------------------------------------------------------- + + call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + do i = 1, nx + frzmlt_init (i) = frzmlt(i) + enddo + + call ocean_mixed_layer (dt) ! ocean surface fluxes and sst + + !----------------------------------------------------------------- + ! Aggregate albedos + !----------------------------------------------------------------- + + do i = 1, nx + alvdf(i) = c0 + alidf(i) = c0 + alvdr(i) = c0 + alidr(i) = c0 + + albice(i) = c0 + albsno(i) = c0 + albpnd(i) = c0 + apeff_ai(i) = c0 + snowfrac(i) = c0 + enddo + do n = 1, ncat + do i = 1, nx + if (aicen(i,n) > puny) then + + alvdf(i) = alvdf(i) + alvdfn(i,n)*aicen(i,n) + alidf(i) = alidf(i) + alidfn(i,n)*aicen(i,n) + alvdr(i) = alvdr(i) + alvdrn(i,n)*aicen(i,n) + alidr(i) = alidr(i) + alidrn(i,n)*aicen(i,n) + + netsw = swvdr(i) + swidr(i) + swvdf(i) + swidf(i) + if (netsw > puny) then ! sun above horizon + albice(i) = albice(i) + albicen(i,n)*aicen(i,n) + albsno(i) = albsno(i) + albsnon(i,n)*aicen(i,n) + albpnd(i) = albpnd(i) + albpndn(i,n)*aicen(i,n) + endif + + apeff_ai(i) = apeff_ai(i) + apeffn(i,n)*aicen(i,n) ! for history + snowfrac(i) = snowfrac(i) + snowfracn(i,n)*aicen(i,n) ! for history + + endif ! aicen > puny + enddo + enddo + + do i = 1, nx + + !----------------------------------------------------------------- + ! reduce fresh by fpond for coupling + !----------------------------------------------------------------- + + if (l_mpond_fresh) then + fpond(i) = fpond(i) * rhofresh/dt + fresh(i) = fresh(i) - fpond(i) + endif + + !---------------------------------------------------------------- + ! Store grid box mean albedos and fluxes before scaling by aice + !---------------------------------------------------------------- + + alvdf_ai (i) = alvdf (i) + alidf_ai (i) = alidf (i) + alvdr_ai (i) = alvdr (i) + alidr_ai (i) = alidr (i) + fresh_ai (i) = fresh (i) + fsalt_ai (i) = fsalt (i) + fhocn_ai (i) = fhocn (i) + fswthru_ai(i) = fswthru(i) + fzsal_ai (i) = fzsal (i) + fzsal_g_ai(i) = fzsal_g(i) + + if (nbtrcr > 0) then + do k = 1, nbtrcr + flux_bio_ai (i,k) = flux_bio (i,k) + enddo + endif + + !----------------------------------------------------------------- + ! Save net shortwave for scaling factor in scale_factor + !----------------------------------------------------------------- + scale_factor(i) = & + swvdr(i)*(c1 - alvdr_ai(i)) & + + swvdf(i)*(c1 - alvdf_ai(i)) & + + swidr(i)*(c1 - alidr_ai(i)) & + + swidf(i)*(c1 - alidf_ai(i)) + enddo + + end subroutine coupling_prep + +!======================================================================= + + module subroutine step_icepack() + + use g_config, only: dt + + implicit none + + integer (kind=int_kind) :: & + k ! dynamics supercycling index + + logical (kind=log_kind) :: & + calc_Tsfc, skl_bgc, solve_zsal, z_tracers, tr_brine, & ! from icepack + tr_fsd, wave_spec + + real (kind=dbl_kind) :: & + offset ! d(age)/dt time offset + + character(len=*), parameter :: subname='(ice_step)' + + + !----------------------------------------------------------------- + ! query Icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) + call icepack_query_parameters(solve_zsal_out=solve_zsal, calc_Tsfc_out=calc_Tsfc, & + wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + ! initialize diagnostics + !----------------------------------------------------------------- + + call init_history_therm + call init_history_bgc + + !----------------------------------------------------------------- + ! Scale radiation fields + !----------------------------------------------------------------- + + if (calc_Tsfc) call prep_radiation () + + !----------------------------------------------------------------- + ! thermodynamics and biogeochemistry + !----------------------------------------------------------------- + + call step_therm1 (dt) ! vertical thermodynamics + call step_therm2 (dt) ! ice thickness distribution thermo + + ! clean up, update tendency diagnostics + + offset = dt + call update_state (dt, daidtt, dvidtt, dagedtt, offset) + + !----------------------------------------------------------------- + ! dynamics, transport, ridging + !----------------------------------------------------------------- + + call init_history_dyn + + ! 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 + + ! ridging + call step_dyn_ridge (dt_dyn, ndtd) + + ! clean up, update tendency diagnostics + offset = c0 + call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + + enddo + + !----------------------------------------------------------------- + ! albedo, shortwave radiation + !----------------------------------------------------------------- + + call step_radiation (dt) + + !----------------------------------------------------------------- + ! get ready for coupling and the next time step + !----------------------------------------------------------------- + + call coupling_prep (dt) + + end subroutine step_icepack + + +!======================================================================= + +end submodule icedrv_step + +!======================================================================= From fa0d0771d425e708228bca48d34f74dc608404d2 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 29 May 2020 12:34:52 +0200 Subject: [PATCH 20/54] Integration of icepack in fesom2 code --- src/fvom_main.F90 | 23 ++++---- src/ice_oce_coupling.F90 | 28 +++++++++- src/ice_setup_step.F90 | 13 ++++- src/icepack_drivers/icedrv_allocate.F90 | 12 ++--- src/icepack_drivers/icedrv_init.F90 | 38 +++++++++---- src/icepack_drivers/icedrv_main.F90 | 72 ++----------------------- src/icepack_drivers/icedrv_step.F90 | 23 ++++++-- 7 files changed, 108 insertions(+), 101 deletions(-) diff --git a/src/fvom_main.F90 b/src/fvom_main.F90 index 78d9266af..dbc324eba 100755 --- a/src/fvom_main.F90 +++ b/src/fvom_main.F90 @@ -74,17 +74,6 @@ program main call mesh_setup(mesh) if (mype==0) write(*,*) 'FESOM mesh_setup... complete' - -#if defined (__icepack) - !===================== - ! Setup icepack - !===================== - if (mype==0) write(*,*) 'Icepack: reading namelists from namelist.icepack' - call set_icepack - call alloc_icepack - call init_icepack(mesh) - if (mype==0) write(*,*) 'Icepack: setup complete' -#endif !===================== ! Allocate field variables @@ -182,6 +171,18 @@ program main if (use_global_tides) then call foreph_ini(yearnew, month) end if + +#if defined (__icepack) + !===================== + ! Setup icepack + !===================== + if (mype==0) write(*,*) 'Icepack: reading namelists from namelist.icepack' + call set_icepack + call alloc_icepack + call init_icepack(mesh) + if (mype==0) write(*,*) 'Icepack: setup complete' +#endif + do n=1, nsteps if (use_global_tides) then call foreph(mesh) diff --git a/src/ice_oce_coupling.F90 b/src/ice_oce_coupling.F90 index 3e7cf14d3..50627ae3e 100755 --- a/src/ice_oce_coupling.F90 +++ b/src/ice_oce_coupling.F90 @@ -12,6 +12,11 @@ subroutine oce_fluxes_mom(mesh) use i_PARAM USE g_CONFIG use g_comm_auto + +#if defined (__icepack) + use icedrv_main, only: icepack_to_fesom +#endif + implicit none integer :: n, elem, elnodes(3),n1 @@ -20,9 +25,14 @@ subroutine oce_fluxes_mom(mesh) #include "associate_mesh.h" - ! ================== + ! ================== ! momentum flux: ! ================== +#if defined (__icepack) + call icepack_to_fesom(nx_in=(myDim_nod2D+eDim_nod2D), & + aice_out=a_ice) +#endif + do n=1,myDim_nod2D+eDim_nod2D if(a_ice(n)>0.001_WP) then aux=sqrt((u_ice(n)-u_w(n))**2+(v_ice(n)-v_w(n))**2)*density_0*Cd_oce_ice @@ -116,6 +126,10 @@ subroutine oce_fluxes(mesh) use g_support use i_therm_param +#if defined (__icepack) + use icedrv_main, only: icepack_to_fesom +#endif + implicit none type(t_mesh), intent(in) , target :: mesh integer :: n, elem, elnodes(3),n1 @@ -139,8 +153,20 @@ subroutine oce_fluxes(mesh) ! ~~~~|~~~~|~~~~ ! V | ! + +#if defined (__icepack) + call icepack_to_fesom(nx_in=(myDim_nod2D+eDim_nod2D), & + aice_out=a_ice, & + vice_out=m_ice, & + vsno_out=m_snow, & + fhocn_tot_out=net_heat_flux, & + fresh_tot_out=fresh_wa_flux ) + heat_flux = - net_heat_flux + water_flux = - (fresh_wa_flux/1000.0_WP) - runoff +#else heat_flux = -net_heat_flux water_flux = -fresh_wa_flux +#endif call exchange_nod(heat_flux, water_flux) ! do we really need it? !___________________________________________________________________ diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index a21efdce9..9d3939133 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -152,6 +152,11 @@ subroutine ice_timestep(step, mesh) use g_CONFIG use i_PARAM, only: whichEVP use mod_mesh + +#if defined (__icepack) + use icedrv_main, only: step_icepack +#endif + implicit none type(t_mesh), intent(in) , target :: mesh integer :: step @@ -171,7 +176,12 @@ subroutine ice_timestep(step, mesh) call par_ex stop END SELECT - t1=MPI_Wtime() + t1=MPI_Wtime() + +#if defined (__icepack) + t2=MPI_Wtime() + call step_icepack(mesh) ! Advection and Thermodynamic Parts +#else ! ===== Advection part ! old FCT routines @@ -191,6 +201,7 @@ subroutine ice_timestep(step, mesh) ! ===== Thermodynamic part if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call thermodynamics...'//achar(27)//'[0m' call thermodynamics(mesh) +#endif t3=MPI_Wtime() rtime_ice = rtime_ice + (t3-t0) rtime_tot = rtime_tot + (t3-t0) diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 index 70426b74e..1b8a7b1c1 100644 --- a/src/icepack_drivers/icedrv_allocate.F90 +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -5,7 +5,7 @@ ! Author: Lorenzo Zampieri ( lorenzo.zampieri@awi.de ) ! ------------------------------------------------------------- - submodule (icedrv_main) allocate_icepack + submodule (icedrv_main) allocate_icepack use icepack_intfc, only: icepack_max_nbtrcr, icepack_max_algae, icepack_max_aero use icepack_intfc, only: icepack_nmodal1, icepack_nmodal2 @@ -19,7 +19,7 @@ contains - module subroutine alloc_state + subroutine alloc_state implicit none @@ -88,7 +88,7 @@ end subroutine alloc_state ! Lorenzo Zampieri 02/2019 ! --------------------------------------------------------------- - module subroutine alloc_flux + subroutine alloc_flux implicit none @@ -259,7 +259,7 @@ end subroutine alloc_flux ! Lorenzo Zampieri 02/2019 ! --------------------------------------------------------------- - module subroutine alloc_flux_bgc + subroutine alloc_flux_bgc implicit none @@ -307,7 +307,7 @@ module subroutine alloc_flux_bgc end subroutine alloc_flux_bgc - module subroutine alloc_column + subroutine alloc_column implicit none @@ -449,6 +449,6 @@ end subroutine alloc_icepack ! ------------------------------------------------------------------------------ - end submodule allocate_icepack + end submodule allocate_icepack ! ------------------------------------------------------------------------------ diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 1da2ad54e..0a12c95d9 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -27,7 +27,7 @@ contains - module subroutine init_state() + subroutine init_state() use icepack_intfc, only: icepack_aggregate @@ -205,10 +205,11 @@ end subroutine init_state !======================================================================= - module subroutine init_coupler_flux() + subroutine init_coupler_flux() use icepack_intfc, only: icepack_liquidus_temperature - + + implicit none real (kind=dbl_kind) :: fcondtopn_d(6), fsurfn_d(6) real (kind=dbl_kind) :: stefan_boltzmann, Tffresh @@ -361,7 +362,9 @@ end subroutine init_coupler_flux !======================================================================= - module subroutine init_flux_atm_ocn() + subroutine init_flux_atm_ocn() + + implicit none character(len=*), parameter :: subname='(init_flux_atm_ocn)' @@ -398,6 +401,8 @@ end subroutine init_flux_atm_ocn module subroutine init_history_therm() + implicit none + logical (kind=log_kind) :: formdrag, tr_iage integer (kind=int_kind) :: nt_iage real (kind=dbl_kind) :: vonkar, zref, iceruf @@ -486,6 +491,8 @@ end subroutine init_history_therm module subroutine init_history_dyn() + implicit none + logical (kind=log_kind) :: tr_iage integer (kind=int_kind) :: nt_iage character(len=*), parameter :: subname='(init_history_dyn)' @@ -529,6 +536,8 @@ end subroutine init_history_dyn module subroutine init_history_bgc() + implicit none + character(len=*), parameter :: subname='(init_history_bgc)' PP_net (:) = c0 @@ -561,10 +570,12 @@ end subroutine init_history_bgc !======================================================================= - module subroutine init_thermo_vertical() + subroutine init_thermo_vertical() use icepack_intfc, only: icepack_init_thermo + implicit none + integer (kind=int_kind) :: & i, & ! horizontal indices k ! ice layer index @@ -600,12 +611,15 @@ end subroutine init_thermo_vertical !======================================================================= - module subroutine init_shortwave() + subroutine init_shortwave() use icepack_intfc, only: icepack_step_radiation use icepack_intfc, only: icepack_max_aero use icepack_intfc, only: icepack_max_algae use icepack_intfc, only: icepack_init_orbit + use g_config, only: dt + + implicit none integer (kind=int_kind) :: & i, k , & ! horizontal indices @@ -829,7 +843,7 @@ end subroutine init_shortwave !======================================================================= - module subroutine init_fsd() + subroutine init_fsd() implicit none @@ -847,7 +861,7 @@ end subroutine init_fsd !======================================================================= - module subroutine init_wave_spec() + subroutine init_wave_spec() implicit none @@ -875,7 +889,7 @@ end subroutine init_wave_spec !======================================================================= - module subroutine init_faero() + subroutine init_faero() implicit none @@ -929,6 +943,7 @@ module subroutine init_icepack(mesh) endif call set_grid_icepack(mesh) + call init_advection_icepack(mesh) 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) ! initialize the ice thickness distribution @@ -958,7 +973,8 @@ module subroutine init_icepack(mesh) endif endif call init_fsd - + + call fesom_to_icepack(mesh) call init_state ! initialize the ice state call init_history_therm ! initialize thermo history variables @@ -972,7 +988,7 @@ end subroutine init_icepack !======================================================================= - module subroutine init_state_var () + subroutine init_state_var () use icepack_intfc, only: icepack_init_fsd use icepack_intfc, only: icepack_aggregate diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index d0087aeff..a4b87b9f4 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -19,7 +19,8 @@ module icedrv_main !--------- subroutines to be seen outside icepack !======================================================================= - public :: set_icepack, alloc_icepack, init_icepack + public :: set_icepack, alloc_icepack, init_icepack, step_icepack, & + icepack_to_fesom !======================================================================= !--------- Everything else is private @@ -754,46 +755,11 @@ module subroutine set_grid_icepack(mesh) type(t_mesh), intent(in), target :: mesh end subroutine set_grid_icepack - ! Allocate state and grid variables - module subroutine alloc_state() - implicit none - end subroutine alloc_state - - ! Allocate flux variables - module subroutine alloc_flux() - implicit none - end subroutine alloc_flux - - ! Allocate flux bgc variables - module subroutine alloc_flux_bgc() - implicit none - end subroutine alloc_flux_bgc - - ! Allocate column variables - module subroutine alloc_column() - implicit none - end subroutine alloc_column - ! Allocate all module subroutine alloc_icepack() implicit none end subroutine alloc_icepack - ! Initialize ice state - module subroutine init_state() - implicit none - end subroutine init_state - - ! Initialize coupler flux - module subroutine init_coupler_flux() - implicit none - end subroutine init_coupler_flux - - ! Initialize fluxes to and from atm. and ocean - module subroutine init_flux_atm_ocn() - implicit none - end subroutine init_flux_atm_ocn - ! Initialize thermodynamic history module subroutine init_history_therm() implicit none @@ -809,36 +775,6 @@ module subroutine init_history_bgc() implicit none end subroutine init_history_bgc - ! Initialize vertical column - module subroutine init_thermo_vertical() - implicit none - end subroutine init_thermo_vertical - - ! Initialize shartwave radiation - module subroutine init_shortwave() - implicit none - end subroutine init_shortwave - - ! Initialize floe size distribution - module subroutine init_fsd() - implicit none - end subroutine init_fsd - - ! Initialize state variables - module subroutine init_state_var() - implicit none - end subroutine init_state_var - - ! Initialize wave spectrum - module subroutine init_wave_spec() - implicit none - end subroutine init_wave_spec - - ! Initialize constant aerosols values - module subroutine init_faero() - implicit none - end subroutine init_faero - ! Initialize all module subroutine init_icepack(mesh) use mod_mesh @@ -888,8 +824,10 @@ module subroutine init_advection_icepack(mesh) end subroutine init_advection_icepack ! Driving subroutine for column physics - module subroutine step_icepack + module subroutine step_icepack(mesh) + use mod_mesh implicit none + type(t_mesh), intent(in), target :: mesh end subroutine step_icepack end interface diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 4c7e8e01b..5efd53980 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -979,7 +979,7 @@ end subroutine ocn_mixed_layer_icepack subroutine coupling_prep(dt) - ! local variables + ! local variables implicit none @@ -1101,10 +1101,11 @@ end subroutine coupling_prep !======================================================================= - module subroutine step_icepack() + module subroutine step_icepack(mesh) use g_config, only: dt - + use mod_mesh + implicit none integer (kind=int_kind) :: & @@ -1116,7 +1117,9 @@ module subroutine step_icepack() real (kind=dbl_kind) :: & offset ! d(age)/dt time offset - + + type(t_mesh), target, intent(in) :: mesh + character(len=*), parameter :: subname='(ice_step)' @@ -1132,6 +1135,18 @@ module subroutine step_icepack() if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) + !----------------------------------------------------------------- + ! copy variables from fesom2 (also ice velocities) + !----------------------------------------------------------------- + + call fesom_to_icepack(mesh) + + !----------------------------------------------------------------- + ! advect tracers + !----------------------------------------------------------------- + + call tracer_advection_icepack(mesh) + !----------------------------------------------------------------- ! initialize diagnostics !----------------------------------------------------------------- From bcbe1b2a2d3ff946954cf025fb64414a4220d596 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 2 Jun 2020 10:23:43 +0200 Subject: [PATCH 21/54] Working version --- src/ice_EVP.F90 | 26 +++++++++++++++ src/ice_oce_coupling.F90 | 40 ++++++++++++++++++------ src/icepack_drivers/icedrv_advection.F90 | 14 ++++----- src/icepack_drivers/icedrv_allocate.F90 | 14 +++++---- src/icepack_drivers/icedrv_init.F90 | 10 +++--- src/icepack_drivers/icedrv_main.F90 | 23 +++++++++++--- src/icepack_drivers/icedrv_set.F90 | 37 ++++++++++++++++------ src/icepack_drivers/icedrv_step.F90 | 40 +++++++++++++++++++----- src/icepack_drivers/icedrv_system.F90 | 2 +- src/icepack_drivers/icedrv_transfer.F90 | 12 +++++-- 10 files changed, 165 insertions(+), 53 deletions(-) diff --git a/src/ice_EVP.F90 b/src/ice_EVP.F90 index 5bc9ebc26..075e51103 100755 --- a/src/ice_EVP.F90 +++ b/src/ice_EVP.F90 @@ -30,6 +30,11 @@ subroutine stress_tensor(ice_strength, mesh) use i_arrays use g_parsup USE g_CONFIG + +#if defined (__icepack) +use icedrv_main, only: rdg_conv_elem, rdg_shear_elem +#endif + implicit none real(kind=WP), intent(in) :: ice_strength(mydim_elem2D) @@ -113,8 +118,15 @@ subroutine stress_tensor(ice_strength, mesh) sigma12(el) = det2*(sigma12(el)+dte*r3) sigma11(el) = 0.5_WP*(si1+si2) sigma22(el) = 0.5_WP*(si1-si2) + +#if defined (__iceapck) + rdg_conv_elem(el) = -min((eps11+eps22),0.0_WP) + rdg_shear_elem(el) = 0.5_WP*(delta - abs(eps11+eps22)) +#endif + endif end do + end subroutine stress_tensor !=================================================================== subroutine stress_tensor_no1(ice_strength, mesh) @@ -359,6 +371,10 @@ subroutine EVPdynamics(mesh) USE g_comm_auto use ice_EVP_interfaces +#if defined (__icepack) +use icedrv_main, only: rdg_conv_elem, rdg_shear_elem +#endif + IMPLICIT NONE integer :: steps, shortstep real(kind=WP) :: rdt, asum, msum, r_a, r_b @@ -496,6 +512,11 @@ subroutine EVPdynamics(mesh) ! And the ice stepping starts do shortstep=1, evp_rheol_steps + +#if defined (__iceapck) + rdg_conv_elem = 0.0_WP |rdg_shear_elem = 0.0_WP + rdg_shear_elem = 0.0_WP +#endif call stress_tensor(ice_strength, mesh) call stress2rhs(inv_areamass,ice_strength, mesh) @@ -541,4 +562,9 @@ subroutine EVPdynamics(mesh) call exchange_nod(U_ice,V_ice) END DO + +#if defined (__icepack) +call exchange_nod(rdg_conv_elem,rdg_shear_elem) +#endif + end subroutine EVPdynamics diff --git a/src/ice_oce_coupling.F90 b/src/ice_oce_coupling.F90 index 50627ae3e..676959eff 100755 --- a/src/ice_oce_coupling.F90 +++ b/src/ice_oce_coupling.F90 @@ -127,7 +127,8 @@ subroutine oce_fluxes(mesh) use i_therm_param #if defined (__icepack) - use icedrv_main, only: icepack_to_fesom + use icedrv_main, only: icepack_to_fesom, & + init_flux_atm_ocn #endif implicit none @@ -155,17 +156,28 @@ subroutine oce_fluxes(mesh) ! #if defined (__icepack) - call icepack_to_fesom(nx_in=(myDim_nod2D+eDim_nod2D), & - aice_out=a_ice, & - vice_out=m_ice, & - vsno_out=m_snow, & - fhocn_tot_out=net_heat_flux, & - fresh_tot_out=fresh_wa_flux ) + a_ice_old(:) = a_ice(:) + m_ice_old(:) = a_ice(:) + m_snow_old(:) = m_snow(:) + + call icepack_to_fesom (nx_in=(myDim_nod2D+eDim_nod2D), & + aice_out=a_ice, & + vice_out=m_ice, & + vsno_out=m_snow, & + fhocn_tot_out=net_heat_flux, & + fresh_tot_out=fresh_wa_flux, & + fsalt_out=real_salt_flux, & + dhi_dt_out=thdgrsn, & + dhs_dt_out=thdgr ) + heat_flux = - net_heat_flux water_flux = - (fresh_wa_flux/1000.0_WP) - runoff + + call init_flux_atm_ocn() + #else - heat_flux = -net_heat_flux - water_flux = -fresh_wa_flux + heat_flux = - net_heat_flux + water_flux = - fresh_wa_flux #endif call exchange_nod(heat_flux, water_flux) ! do we really need it? @@ -195,6 +207,12 @@ subroutine oce_fluxes(mesh) relax_salt(n)=surf_relax_S*(Ssurf(n)-tr_arr(1,n,2)) end do +#if defined (__icepack) + + ! No global conservations + +#else + ! enforce the total freshwater/salt flux be zero ! 1. water flux ! if (.not. use_virt_salt) can be used! ! we conserve only the fluxes from the database plus evaporation. @@ -216,7 +234,7 @@ subroutine oce_fluxes(mesh) flux = flux-thdgr*rhoice*inv_rhowat-thdgrsn*rhosno*inv_rhowat end if - call integrate_nod(flux, net, mesh) + !call integrate_nod(flux, net, mesh) ! here the + sign must be used because we switched up the sign of the ! water_flux with water_flux = -fresh_wa_flux, but evap, prec_... and runoff still ! have there original sign @@ -228,6 +246,8 @@ subroutine oce_fluxes(mesh) virtual_salt=virtual_salt-net/ocean_area end if +#endif + ! 3. restoring to SSS climatology call integrate_nod(relax_salt, net, mesh) relax_salt=relax_salt-net/ocean_area diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index cdaf5c3ed..365b6d0be 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -612,7 +612,7 @@ module subroutine tracer_advection_icepack(mesh) ! ntrace is not equal to ntrcr! integer (kind=int_kind) :: ntrcr, ntrace, narr, nbtrcr, i, & - nx, nt, nt1, k + nt, nt1, k integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, & nt_sice, nt_fbri, nt_iage, nt_FY, nt_alvl, nt_vlvl, & nt_apnd, nt_hpnd, nt_ipnd, nt_bgc_Nit, nt_bgc_S @@ -795,7 +795,7 @@ subroutine work_to_state (nx, & call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & nt_fbri_out=nt_fbri, nt_qsno_out=nt_qsno, & nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_Tsfc_out=nt_Tsfc) - call icepack_query_parameters(rhoi_out=rhoi, rhos_out=rhoi, & + call icepack_query_parameters(rhoi_out=rhoi, rhos_out=rhos, & Lfresh_out=Lfresh, heat_capacity_out=heat_capacity, & Tsmelt_out=Tsmelt, ktherm_out=ktherm, & puny_out=puny) @@ -1151,10 +1151,10 @@ subroutine cut_off_icepack (nx, & cp_ice, small, & qrd_snow, qrd_ice, & Tsfc, exc, & - depressT, Tf_new, & + depressT, Tmin, & T_air_C, hice, & - puny, Tsmelt, & - Tmin + puny, Tsmelt + logical (kind=log_kind) :: tr_brine, tr_lvl, flag_snow, flag_cold_ice, flag_warm_ice, & @@ -1259,7 +1259,7 @@ subroutine cut_off_icepack (nx, & vicen(i,n) = c0 vsnon(i,n) = c0 trcrn(i,:,n) = c0 - trcrn(i,nt_Tsfc,n) = Tf_new + trcrn(i,nt_Tsfc,n) = Tf(i) end if @@ -1290,7 +1290,7 @@ subroutine cut_off_icepack (nx, & vicen(i,n) = c0 vsnon(i,n) = c0 trcrn(i,:,n) = c0 - trcrn(i,nt_Tsfc,n) = Tf_new + trcrn(i,nt_Tsfc,n) = Tf(i) end if diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 index 1b8a7b1c1..b0ef189a4 100644 --- a/src/icepack_drivers/icedrv_allocate.F90 +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -58,18 +58,18 @@ subroutine alloc_state aicen_init(nx,ncat) , & ! initial ice concentration, for linear ITD vicen_init(nx,ncat) , & ! initial ice volume (m), for linear ITD vsnon_init(nx,ncat) , & ! initial snow volume (m), for aerosol - trcr (nx,ntrcr) , & ! ice tracers: 1: surface temperature of ice/snow (C) - trcrn (nx,ntrcr,ncat) , & ! tracers: 1: surface temperature of ice/snow (C) + trcr (nx,max_ntrcr) , & ! ice tracers: 1: surface temperature of ice/snow (C) + trcrn (nx,max_ntrcr,ncat) , & ! tracers: 1: surface temperature of ice/snow (C) stat=ierr) if (ierr/=0) write(*,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) allocate ( & - trcr_depend(ntrcr) , & ! - n_trcr_strata(ntrcr) , & ! number of underlying tracer layers - nt_strata(ntrcr,2) , & ! indices of underlying tracer layers - trcr_base(ntrcr,3) , & ! = 0 or 1 depending on tracer dependency, (1) aice, (2) vice, (3) vsno + trcr_depend(max_ntrcr) , & ! + n_trcr_strata(max_ntrcr) , & ! number of underlying tracer layers + nt_strata(max_ntrcr,2) , & ! indices of underlying tracer layers + trcr_base(max_ntrcr,3) , & ! = 0 or 1 depending on tracer dependency, (1) aice, (2) vice, (3) vsno stat=ierr) if (ierr/=0) write(*,*) 'Memory issue in task ', mype @@ -114,6 +114,8 @@ subroutine alloc_flux dvirdgdt(nx), & ! rate of ice volume ridged (m/s) closing(nx) , & ! rate of closing due to divergence/shear (1/s) opening(nx) , & ! rate of opening due to divergence/shear (1/s) + dhi_dt(nx) , & ! ice volume tendency due to thermodynamics (m/s) + dhs_dt(nx) , & ! snow volume tendency due to thermodynamics (m/s) dardg1ndt(nx,ncat), & ! rate of area loss by ridging ice (1/s) dardg2ndt(nx,ncat), & ! rate of area gain by new ridges (1/s) dvirdgndt(nx,ncat), & ! rate of ice volume ridged (m/s) diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 0a12c95d9..30f35d16b 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -362,7 +362,7 @@ end subroutine init_coupler_flux !======================================================================= - subroutine init_flux_atm_ocn() + module subroutine init_flux_atm_ocn() implicit none @@ -607,6 +607,8 @@ subroutine init_thermo_vertical() enddo ! k enddo ! i + if (mype==0) write(*,*) maxval(salinz), minval(salinz) + end subroutine init_thermo_vertical !======================================================================= @@ -1081,14 +1083,14 @@ subroutine init_state_var () endif do i = 1, nx - if (sst(i) <= Tf(i)) then + if (sst(i) <= Tf(i)) then ! do n = 1, ncat ! ice volume, snow volume aicen(i,n) = ainit(n) vicen(i,n) = hinit(n) * ainit(n) ! m vsnon(i,n) = c0 ! tracers - call icepack_init_trcr(Tair = T_air(i), & + call icepack_init_trcr(Tair = T_air(i), & Tf = Tf(i), & Sprofile = salinz(i,:), & Tprofile = Tmltz(i,:), & @@ -1110,7 +1112,7 @@ subroutine init_state_var () enddo ! snow enthalpy do k = 1, nslyr - trcrn(i,nt_qsno+k-1,n) = qsn(k) + trcrn(i,nt_qsno+k-1,n) = -rhos * Lfresh enddo ! nslyr ! brine fraction if (tr_brine) trcrn(i,nt_fbri,n) = c1 diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index a4b87b9f4..098b0c569 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -20,7 +20,8 @@ module icedrv_main !======================================================================= public :: set_icepack, alloc_icepack, init_icepack, step_icepack, & - icepack_to_fesom + icepack_to_fesom, rdg_conv_elem, rdg_shear_elem, & + init_flux_atm_ocn !======================================================================= !--------- Everything else is private @@ -143,7 +144,9 @@ module icedrv_main dardg2dt(:), & ! rate of area gain by new ridges (1/s) dvirdgdt(:), & ! rate of ice volume ridged (m/s) closing(:), & ! rate of closing due to divergence/shear (1/s) - opening(:), & ! rate of opening due to divergence/shear (1/s) + opening(:), & ! rate of opening due to divergence/shear (1/s) + dhi_dt(:), & ! ice volume tendency due to thermodynamics (m/s) + dhs_dt(:), & ! snow volume tendency due to thermodynamics (m/s) ! ridging diagnostics in categories dardg1ndt(:,:), & ! rate of area loss by ridging ice (1/s) dardg2ndt(:,:), & ! rate of area gain by new ridges (1/s) @@ -205,7 +208,7 @@ module icedrv_main hmix(:) ! mixed layer depth (m) ! out to atmosphere (if calc_Tsfc) - ! note Tsfc is in ice_state.F + ! note Tsfc is a tracer real (kind=dbl_kind), allocatable, save :: & ! DIM nx fsens(:) , & ! sensible heat flux (W/m^2) @@ -760,6 +763,11 @@ module subroutine alloc_icepack() implicit none end subroutine alloc_icepack + ! Initialize fluxes to atmosphere and ocean + module subroutine init_flux_atm_ocn() + implicit none + end subroutine init_flux_atm_ocn + ! Initialize thermodynamic history module subroutine init_history_therm() implicit none @@ -794,7 +802,9 @@ module subroutine icepack_to_fesom( & nx_in, & aice_out, vice_out, vsno_out, & fhocn_tot_out, fresh_tot_out, & - strocnxT_out, strocnyT_out) + strocnxT_out, strocnyT_out, & + dhs_dt_out, dhi_dt_out, & + fsalt_out) use mod_mesh implicit none integer (kind=int_kind), intent(in) :: & @@ -806,7 +816,10 @@ module subroutine icepack_to_fesom( & fhocn_tot_out, & fresh_tot_out, & strocnxT_out, & - strocnyT_out + strocnyT_out, & + fsalt_out, & + dhs_dt_out, & + dhi_dt_out end subroutine icepack_to_fesom ! Trancers advection diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 74b2c3ce4..430276cc8 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -27,6 +27,7 @@ module subroutine set_icepack() use g_parsup, only: myDim_nod2D, eDim_nod2D, & myDim_elem2D, eDim_elem2D, & mpi_comm_fesom + use i_param, only: whichEVP implicit none @@ -400,6 +401,13 @@ module subroutine set_icepack() if (mype == 0) write(*,*) 'Diagnostic output will be in file ' if (mype == 0) write(*,*) ' icepack.diagnostics' + diag_filename = 'icepack.errors' + open (ice_stderr, file=diag_filename, status='unknown', iostat=diag_error) + if (diag_error /= 0) then + if (mype == 0) write(*,*) 'Error while opening error file' + if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + diag_filename = 'icepack.diagnostics' open (nu_diag, file=diag_filename, status='unknown', iostat=diag_error) if (diag_error /= 0) then @@ -411,6 +419,15 @@ module subroutine set_icepack() if (mype == 0) write(nu_diag,*) ' ICEPACK model diagnostic output ' if (mype == 0) write(nu_diag,*) '-----------------------------------' if (mype == 0) write(nu_diag,*) ' ' + + if (whichEVP == 1 .or. whichEVP == 2) then + if (mype == 0) write (nu_diag,*) 'WARNING: whichEVP = 1 or 2' + if (mype == 0) write (nu_diag,*) 'Adaptive or Modified EVP formulations' + if (mype == 0) write (nu_diag,*) 'are not allowed when using Icepack (yet).' + if (mype == 0) write (nu_diag,*) 'Standard EVP will be used instead' + if (mype == 0) write (nu_diag,*) ' whichEVP = 0' + whichEVP = 0 + endif if (ncat == 1 .and. kitd == 1) then if (mype == 0) write (nu_diag,*) 'Remapping the ITD is not allowed for ncat=1.' @@ -516,7 +533,7 @@ module subroutine set_icepack() endif if (tr_pond_cesm) then - if (mype == 0) write (nu_diag,*) 'ERROR: formdrag=T but frzpnd=cesm' + if (mype == 0) write (ice_stderr,*) 'ERROR: formdrag=T but frzpnd=cesm' if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) endif @@ -720,8 +737,8 @@ module subroutine set_icepack() endif if (ntrcr > max_ntrcr-1) then - if (mype == 0) write(nu_diag,*) 'max_ntrcr-1 < number of namelist tracers' - if (mype == 0) write(nu_diag,*) 'max_ntrcr-1 = ',max_ntrcr-1,' ntrcr = ',ntrcr + if (mype == 0) write(ice_stderr,*) 'max_ntrcr-1 < number of namelist tracers' + if (mype == 0) write(ice_stderr,*) 'max_ntrcr-1 = ',max_ntrcr-1,' ntrcr = ',ntrcr if (mype == 0) call icedrv_system_abort(file=__FILE__,line=__LINE__) endif @@ -744,19 +761,19 @@ module subroutine set_icepack() if (formdrag) then if (nt_apnd==0) then - write(nu_diag,*)'ERROR: nt_apnd:',nt_apnd + write(ice_stderr,*)'ERROR: nt_apnd:',nt_apnd call icedrv_system_abort(file=__FILE__,line=__LINE__) elseif (nt_hpnd==0) then - write(nu_diag,*)'ERROR: nt_hpnd:',nt_hpnd + write(ice_stderr,*)'ERROR: nt_hpnd:',nt_hpnd call icedrv_system_abort(file=__FILE__,line=__LINE__) elseif (nt_ipnd==0) then - write(nu_diag,*)'ERROR: nt_ipnd:',nt_ipnd + write(ice_stderr,*)'ERROR: nt_ipnd:',nt_ipnd call icedrv_system_abort(file=__FILE__,line=__LINE__) elseif (nt_alvl==0) then - write(nu_diag,*)'ERROR: nt_alvl:',nt_alvl + write(ice_stderr,*)'ERROR: nt_alvl:',nt_alvl call icedrv_system_abort(file=__FILE__,line=__LINE__) elseif (nt_vlvl==0) then - write(nu_diag,*)'ERROR: nt_vlvl:',nt_vlvl + write(ice_stderr,*)'ERROR: nt_vlvl:',nt_vlvl call icedrv_system_abort(file=__FILE__,line=__LINE__) endif endif @@ -815,7 +832,7 @@ module subroutine set_icepack() nt_apnd_in=nt_apnd, nt_hpnd_in=nt_hpnd, nt_ipnd_in=nt_ipnd, & nt_aero_in=nt_aero, nt_fsd_in=nt_fsd) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -843,7 +860,7 @@ module subroutine set_grid_icepack(mesh) !----------------------------------------------------------------- call icepack_query_parameters(puny_out=puny) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 5efd53980..ee3a7df5c 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -863,7 +863,8 @@ subroutine ocean_mixed_layer (dt) Tf=Tf(i), fresh=fresh(i), & frain=frain(i), fsnow=fsnow(i), & fhocn_tot=fhocn_tot(i), fresh_tot=fresh_tot(i), & - frzmlt=frzmlt(i) ) + frzmlt=frzmlt(i), fsalt=fsalt(i), & + sss=sss(i) ) enddo ! i call icepack_warnings_flush(nu_diag) @@ -889,9 +890,11 @@ subroutine ocn_mixed_layer_icepack( & Tf, fresh, & frain, fsnow, & fhocn_tot, fresh_tot, & - frzmlt) + frzmlt, fsalt, & + sss) - use i_therm_param, only: emiss_wat + use i_therm_param, only: emiss_wat + use g_forcing_param, only: use_virt_salt implicit none @@ -914,8 +917,10 @@ subroutine ocn_mixed_layer_icepack( & fswthru , & ! shortwave penetrating to ocean (W/m^2) aice , & ! ice area fraction sst , & ! sea surface temperature (C) + sss , & ! sea surface salinity frain , & ! rainfall rate (kg/m^2/s) - fsnow ! snowfall rate (kg/m^2/s) + fsnow , & ! snowfall rate (kg/m^2/s) + fsalt ! salt flux from ice to the ocean (kg/m^2/s) real (kind=dbl_kind), intent(inout) :: & flwout_ocn, & ! outgoing longwave radiation (W/m^2) @@ -929,6 +934,7 @@ subroutine ocn_mixed_layer_icepack( & real (kind=dbl_kind), intent(out) :: & fhocn_tot , & ! net total heat flux to ocean (W/m^2) fresh_tot ! fresh total water flux to ocean (kg/m^2/s) + real (kind=dbl_kind), parameter :: & frzmlt_max = c1000 ! max magnitude of frzmlt (W/m^2) @@ -936,16 +942,19 @@ subroutine ocn_mixed_layer_icepack( & real (kind=dbl_kind) :: & TsfK , & ! surface temperature (K) swabs, & ! surface absorbed shortwave heat flux (W/m^2) - Tffresh, & ! 273.15 + Tffresh, & ! 0 C in K Lfresh, & - Lvap, & - stefan_boltzmann + Lvap, & + lfs_corr, & ! fresh water correction for linear free surface + stefan_boltzmann, & + ice_ref_salinity character(len=*),parameter :: subname='(icepack_ocn_mixed_layer)' call icepack_query_parameters( Tffresh_out=Tffresh, Lfresh_out=Lfresh, & stefan_boltzmann_out=stefan_boltzmann, & - Lvap_out=Lvap ) + ice_ref_salinity_out=ice_ref_salinity, & + Lvap_out=Lvap ) ! shortwave radiative flux ! Visible is absorbed by clorophil ! afterwards @@ -970,6 +979,11 @@ subroutine ocn_mixed_layer_icepack( & fhocn_tot = fhocn + fswthru & ! these are *aice already + (fsens_ocn + flat_ocn + flwout_ocn + flw + swabs & + Lfresh*fsnow) * (c1-aice) + max(c0,frzmlt)*aice + + if (use_virt_salt) then + lfs_corr = fsalt/ice_ref_salinity/p001 + fresh = fresh - lfs_corr * ice_ref_salinity / sss + endif fresh_tot = fresh + (-evap_ocn + frain + fsnow)*(c1-aice) @@ -1147,6 +1161,13 @@ module subroutine step_icepack(mesh) call tracer_advection_icepack(mesh) + !----------------------------------------------------------------- + ! tendencies needed by fesom + !----------------------------------------------------------------- + + dhi_dt(:) = vice(:) + dhs_dt(:) = vsno(:) + !----------------------------------------------------------------- ! initialize diagnostics !----------------------------------------------------------------- @@ -1205,6 +1226,9 @@ module subroutine step_icepack(mesh) call coupling_prep (dt) + dhi_dt(:) = ( vice(:) - dhi_dt(:) ) / dt + dhs_dt(:) = ( vsno(:) - dhi_dt(:) ) / dt + end subroutine step_icepack diff --git a/src/icepack_drivers/icedrv_system.F90 b/src/icepack_drivers/icedrv_system.F90 index 40c28589a..35e5eb0d6 100644 --- a/src/icepack_drivers/icedrv_system.F90 +++ b/src/icepack_drivers/icedrv_system.F90 @@ -8,7 +8,7 @@ module icedrv_system use icedrv_kinds use g_parsup, only: par_ex - use icedrv_constants, only: nu_diag + use icedrv_constants, only: ice_stderr use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted implicit none diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 index 6e8637596..9925543d8 100644 --- a/src/icepack_drivers/icedrv_transfer.F90 +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -176,7 +176,9 @@ end subroutine fesom_to_icepack module subroutine icepack_to_fesom( nx_in, & aice_out, vice_out, vsno_out, & fhocn_tot_out, fresh_tot_out, & - strocnxT_out, strocnyT_out) + strocnxT_out, strocnyT_out, & + dhs_dt_out, dhi_dt_out, & + fsalt_out) implicit none @@ -190,7 +192,10 @@ module subroutine icepack_to_fesom( nx_in, & fhocn_tot_out, & fresh_tot_out, & strocnxT_out, & - strocnyT_out + strocnyT_out, & + fsalt_out, & + dhs_dt_out, & + dhi_dt_out character(len=*),parameter :: subname='(icepack_to_fesom)' @@ -202,6 +207,9 @@ module subroutine icepack_to_fesom( nx_in, & if (present(fhocn_tot_out) ) fhocn_tot_out = fhocn_tot if (present(strocnxT_out) ) strocnxT_out = strocnxT if (present(strocnyT_out) ) strocnyT_out = strocnyT + if (present(dhi_dt_out) ) dhi_dt_out = dhi_dt + if (present(dhs_dt_out) ) dhs_dt_out = dhs_dt + if (present(fsalt_out) ) fsalt_out = fsalt end subroutine icepack_to_fesom From a05cec8feb7faaff92fcee3db793ae6e5a104ed7 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 2 Jun 2020 10:38:00 +0200 Subject: [PATCH 22/54] Error messages in the separate file icepack.errors --- src/icepack_drivers/icedrv_advection.F90 | 10 +-- src/icepack_drivers/icedrv_allocate.F90 | 16 ++--- src/icepack_drivers/icedrv_init.F90 | 42 ++++++------- src/icepack_drivers/icedrv_step.F90 | 77 ++++++++++++------------ src/icepack_drivers/icedrv_system.F90 | 16 ++--- src/icepack_drivers/icedrv_transfer.F90 | 2 +- 6 files changed, 83 insertions(+), 80 deletions(-) diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index 365b6d0be..bbc50e92c 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -799,7 +799,7 @@ subroutine work_to_state (nx, & Lfresh_out=Lfresh, heat_capacity_out=heat_capacity, & Tsmelt_out=Tsmelt, ktherm_out=ktherm, & puny_out=puny) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -1002,7 +1002,7 @@ subroutine state_to_work (nx, & call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & nt_fbri_out=nt_fbri, nt_qsno_out=nt_qsno, nt_Tsfc_out=nt_Tsfc) call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -1077,7 +1077,7 @@ subroutine state_to_work (nx, & enddo ! n - if (narr /= narrays .and. mype == 0 ) write(nu_diag,*) & + if (narr /= narrays .and. mype == 0 ) write(ice_stderr,*) & "Wrong number of arrays in transport bound call" end subroutine state_to_work @@ -1171,7 +1171,7 @@ subroutine cut_off_icepack (nx, & call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, cp_ice_out=cp_ice) call icepack_query_parameters(depressT_out=depressT, puny_out=puny, & Tsmelt_out=Tsmelt, ktherm_out=ktherm, heat_capacity_out=heat_capacity) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) small = puny Tmin = -100.0_dbl_kind @@ -1323,7 +1323,7 @@ subroutine cut_off_icepack (nx, & end if ! heat_capacity - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 index b0ef189a4..e2d6d6108 100644 --- a/src/icepack_drivers/icedrv_allocate.F90 +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -27,7 +27,7 @@ subroutine alloc_state character(len=*), parameter :: subname='(alloc_state)' call icepack_query_tracer_sizes(ntrcr_out=ntrcr) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) & call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) @@ -38,7 +38,7 @@ subroutine alloc_state lat_val(nx) , & stat=ierr) - if (ierr/=0) write(*,*) 'Memory issue in task ', mype + if (ierr/=0) write(ice_stderr,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) allocate ( & @@ -62,7 +62,7 @@ subroutine alloc_state trcrn (nx,max_ntrcr,ncat) , & ! tracers: 1: surface temperature of ice/snow (C) stat=ierr) - if (ierr/=0) write(*,*) 'Memory issue in task ', mype + if (ierr/=0) write(ice_stderr,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) allocate ( & @@ -72,7 +72,7 @@ subroutine alloc_state trcr_base(max_ntrcr,3) , & ! = 0 or 1 depending on tracer dependency, (1) aice, (2) vice, (3) vsno stat=ierr) - if (ierr/=0) write(*,*) 'Memory issue in task ', mype + if (ierr/=0) write(ice_stderr,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) trcr_depend = 0 @@ -250,7 +250,7 @@ subroutine alloc_flux Tmltz(nx,nilyr+1) , & ! initial melting temperature (C) stat=ierr) - if (ierr/=0) write(*,*) 'Memory issue in task ', mype + if (ierr/=0) write(ice_stderr,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) end subroutine alloc_flux @@ -304,7 +304,7 @@ subroutine alloc_flux_bgc zaeros(nx,icepack_max_aero) , & ! ocean aerosols (mmol/m^3) stat=ierr) - if (ierr/=0) write(*,*) 'Memory issue in task ', mype + if (ierr/=0) write(ice_stderr,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) end subroutine alloc_flux_bgc @@ -322,7 +322,7 @@ subroutine alloc_column call icepack_query_tracer_sizes( max_nbtrcr_out=max_nbtrcr, & max_algae_out=max_algae, max_aero_out=max_aero, & nmodal1_out=nmodal1, nmodal2_out=nmodal2, max_don_out=max_don) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) & call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) @@ -431,7 +431,7 @@ subroutine alloc_column c_fsd_range(nfsd) , & ! fsd floe_rad bounds (m) stat=ierr) - if (ierr/=0) write(*,*) 'Memory issue in task ', mype + if (ierr/=0) write(ice_stderr,*) 'Memory issue in task ', mype if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) end subroutine alloc_column diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 30f35d16b..99fc6a7e6 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -70,7 +70,7 @@ subroutine init_state() 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_aero_out=nt_aero, nt_fsd_out=nt_fsd) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -228,7 +228,7 @@ subroutine init_coupler_flux() call icepack_query_parameters(stefan_boltzmann_out=stefan_boltzmann, & Tffresh_out=Tffresh, vonkar_out=vonkar, zref_out=zref, iceruf_out=iceruf) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -289,7 +289,7 @@ subroutine init_coupler_flux() do i = 1, nx Tf (i) = icepack_liquidus_temperature(sss(i)) ! freezing temp (C) enddo - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -419,7 +419,7 @@ module subroutine init_history_therm() call icepack_query_parameters(dragio_out=dragio, & vonkar_out=vonkar, zref_out=zref, iceruf_out=iceruf) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -503,7 +503,7 @@ module subroutine init_history_dyn() call icepack_query_tracer_flags(tr_iage_out=tr_iage) call icepack_query_tracer_indices(nt_iage_out=nt_iage) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -591,7 +591,7 @@ subroutine init_thermo_vertical() call icepack_query_parameters(depressT_out=depressT) call icepack_init_thermo(nilyr=nilyr, sprofile=sprofile) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -665,7 +665,7 @@ subroutine init_shortwave() nt_fbri_out=nt_fbri, nt_tsfc_out=nt_tsfc, & nt_bgc_N_out=nt_bgc_N, nt_zaero_out=nt_zaero, & nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -715,9 +715,9 @@ subroutine init_shortwave() ! initialize orbital parameters ! These come from the driver in the coupled model. - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) call icepack_init_orbit() - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) & call icedrv_system_abort(i, istep1, subname, __FILE__,__LINE__) endif @@ -772,7 +772,7 @@ subroutine init_shortwave() l_print_point=l_print_point, & initonly = .true.) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -930,16 +930,16 @@ module subroutine init_icepack(mesh) call icepack_query_tracer_flags(tr_aero_out=tr_aero) call icepack_query_tracer_flags(tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) ! generate some output if (mype==0) then - call icepack_write_tracer_flags(nu_diag) - call icepack_write_tracer_sizes(nu_diag) - call icepack_write_tracer_indices(nu_diag) - call icepack_warnings_flush(nu_diag) + call icepack_write_tracer_flags(ice_stderr) + call icepack_write_tracer_sizes(ice_stderr) + call icepack_write_tracer_indices(ice_stderr) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) endif @@ -949,7 +949,7 @@ module subroutine init_icepack(mesh) 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) ! initialize the ice thickness distribution - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted(subname)) then call icedrv_system_abort(file=__FILE__,line=__LINE__) @@ -957,7 +957,7 @@ module subroutine init_icepack(mesh) if (mype==0) then call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted(subname)) & call icedrv_system_abort(file=__FILE__,line=__LINE__) end if @@ -969,7 +969,7 @@ module subroutine init_icepack(mesh) floe_rad_c=floe_rad_c, & ! fsd size bin centre in m (radius) floe_binwidth=floe_binwidth, & ! fsd size bin width in m (radius) c_fsd_range=c_fsd_range) ! string for history output - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted(subname)) then call icedrv_system_abort(file=__FILE__,line=__LINE__) endif @@ -1039,7 +1039,7 @@ subroutine init_state_var () nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fsd_out=nt_fsd, & nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, puny_out=puny) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -1117,7 +1117,7 @@ subroutine init_state_var () ! brine fraction if (tr_brine) trcrn(i,nt_fbri,n) = c1 enddo ! ncat - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) endif @@ -1155,7 +1155,7 @@ subroutine init_state_var () enddo - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index ee3a7df5c..75cdf918a 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -7,15 +7,15 @@ submodule (icedrv_main) icedrv_step - use icedrv_constants, only: c0, nu_diag, c4 + use icedrv_constants, only: c0, c4, nu_diag, ice_stderr use icedrv_kinds - use icedrv_system, only: icedrv_system_abort - use icepack_intfc, only: icepack_warnings_flush - use icepack_intfc, only: icepack_warnings_aborted - use icepack_intfc, only: icepack_query_tracer_flags - use icepack_intfc, only: icepack_query_tracer_indices - use icepack_intfc, only: icepack_query_tracer_sizes - use icepack_intfc, only: icepack_query_parameters + use icedrv_system, only: icedrv_system_abort + use icepack_intfc, only: icepack_warnings_flush + use icepack_intfc, only: icepack_warnings_aborted + use icepack_intfc, only: icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_indices + use icepack_intfc, only: icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_parameters implicit none @@ -64,7 +64,7 @@ subroutine prep_radiation () Sswabsn=Sswabsn(i,:,:), Iswabsn=Iswabsn(i,:,:)) enddo ! i - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -118,13 +118,13 @@ subroutine step_therm1 (dt) call icepack_query_parameters(puny_out=puny) call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) call icepack_query_tracer_sizes( & ntrcr_out=ntrcr) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -132,7 +132,7 @@ subroutine step_therm1 (dt) tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_aero_out=tr_aero, tr_pond_out=tr_pond, tr_pond_cesm_out=tr_pond_cesm, & tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -142,7 +142,7 @@ subroutine step_therm1 (dt) nt_iage_out=nt_iage, nt_FY_out=nt_FY, & nt_qice_out=nt_qice, nt_sice_out=nt_sice, & nt_aero_out=nt_aero, nt_qsno_out=nt_qsno) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -282,7 +282,7 @@ subroutine step_therm1 (dt) endif ! tr_aero enddo ! i - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -322,7 +322,7 @@ subroutine step_therm2 (dt) call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -377,7 +377,7 @@ subroutine step_therm2 (dt) floe_binwidth=floe_binwidth(:)) enddo ! i - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -419,21 +419,20 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) !----------------------------------------------------------------- call icepack_query_tracer_sizes(ntrcr_out=ntrcr) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) call icepack_query_tracer_indices(nt_iage_out=nt_iage) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) call icepack_query_tracer_flags(tr_iage_out=tr_iage) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) - !$OMP PARALLEL DO PRIVATE(i) do i = 1, nx !----------------------------------------------------------------- @@ -470,8 +469,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) endif enddo ! i - !$OMP END PARALLEL DO - call icepack_warnings_flush(nu_diag) + + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -504,7 +503,7 @@ subroutine step_dyn_wave (dt) character(len=*), parameter :: subname = '(step_dyn_wave)' call icepack_query_parameters(wave_spec_type_out=wave_spec_type) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -524,7 +523,7 @@ subroutine step_dyn_wave (dt) d_afsd_wave = d_afsd_wave (i,:)) end do ! i - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -562,7 +561,7 @@ subroutine step_dyn_ridge (dt, ndtd) !----------------------------------------------------------------- call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -603,7 +602,7 @@ subroutine step_dyn_ridge (dt, ndtd) enddo - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -657,7 +656,7 @@ subroutine step_radiation (dt) call icepack_query_tracer_sizes( & max_aero_out=max_aero, max_algae_out=max_algae) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) allocate(nlt_zaero_sw(max_aero)) @@ -665,13 +664,13 @@ subroutine step_radiation (dt) allocate(nt_bgc_N(max_algae)) call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_sw_out=nbtrcr_sw) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) call icepack_query_tracer_flags( & tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_zaero_out=tr_zaero) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -680,12 +679,12 @@ subroutine step_radiation (dt) nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, & nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw, & nt_fbri_out=nt_fbri, nt_zaero_out=nt_zaero, nt_bgc_N_out=nt_bgc_N) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) call icepack_query_parameters(dEdd_algae_out=dEdd_algae, modal_aero_out=modal_aero) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -752,7 +751,7 @@ subroutine step_radiation (dt) endif enddo ! i - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -799,7 +798,7 @@ subroutine ocean_mixed_layer (dt) !----------------------------------------------------------------- call icepack_query_parameters(albocn_out=albocn) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -830,7 +829,7 @@ subroutine ocean_mixed_layer (dt) Cdn_atm = Cdn_atm(i), & Cdn_atm_ratio_n = Cdn_atm_ratio(i)) enddo ! i - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -867,7 +866,7 @@ subroutine ocean_mixed_layer (dt) sss=sss(i) ) enddo ! i - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -1020,7 +1019,7 @@ subroutine coupling_prep(dt) call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -1145,7 +1144,7 @@ module subroutine step_icepack(mesh) call icepack_query_parameters(solve_zsal_out=solve_zsal, calc_Tsfc_out=calc_Tsfc, & wave_spec_out=wave_spec) call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -1226,6 +1225,10 @@ module subroutine step_icepack(mesh) call coupling_prep (dt) + !----------------------------------------------------------------- + ! tendencies needed by fesom + !----------------------------------------------------------------- + dhi_dt(:) = ( vice(:) - dhi_dt(:) ) / dt dhs_dt(:) = ( vsno(:) - dhi_dt(:) ) / dt diff --git a/src/icepack_drivers/icedrv_system.F90 b/src/icepack_drivers/icedrv_system.F90 index 35e5eb0d6..8262015ad 100644 --- a/src/icepack_drivers/icedrv_system.F90 +++ b/src/icepack_drivers/icedrv_system.F90 @@ -36,16 +36,16 @@ subroutine icedrv_system_abort(icell, istep, string, file, line) character(len=*), parameter :: subname='(icedrv_system_abort)' - write(nu_diag,*) ' ' + write(ice_stderr,*) ' ' - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) - write(nu_diag,*) ' ' - write(nu_diag,*) subname,' ABORTED: ' - if (present(file)) write (nu_diag,*) subname,' called from', trim(file) - if (present(line)) write (nu_diag,*) subname,' line number', line - if (present(istep)) write (nu_diag,*) subname,' istep =', istep - if (present(string)) write (nu_diag,*) subname,' string =', trim(string) + write(ice_stderr,*) ' ' + write(ice_stderr,*) subname,' ABORTED: ' + if (present(file)) write (ice_stderr,*) subname,' called from', trim(file) + if (present(line)) write (ice_stderr,*) subname,' line number', line + if (present(istep)) write (ice_stderr,*) subname,' istep =', istep + if (present(string)) write (ice_stderr,*) subname,' string =', trim(string) ! Stop FESOM2 diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 index 9925543d8..dbd894e2d 100644 --- a/src/icepack_drivers/icedrv_transfer.F90 +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -110,7 +110,7 @@ module subroutine fesom_to_icepack(mesh) swidf = fsw*frcidf ! near IR diffuse call icepack_query_parameters(calc_strair_out=calc_strair, cprho_out=cprho) - call icepack_warnings_flush(nu_diag) + call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) From 05cc4da482ad0cdabcec9d0f1aeb33e3ec927760 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 2 Jun 2020 11:03:26 +0200 Subject: [PATCH 23/54] Ocean evaporation passed from Icepack to Fesom --- src/ice_oce_coupling.F90 | 5 +++-- src/icepack_drivers/icedrv_main.F90 | 6 ++++-- src/icepack_drivers/icedrv_step.F90 | 4 +--- src/icepack_drivers/icedrv_transfer.F90 | 6 ++++-- 4 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/ice_oce_coupling.F90 b/src/ice_oce_coupling.F90 index 676959eff..b67dfdffb 100755 --- a/src/ice_oce_coupling.F90 +++ b/src/ice_oce_coupling.F90 @@ -168,7 +168,8 @@ subroutine oce_fluxes(mesh) fresh_tot_out=fresh_wa_flux, & fsalt_out=real_salt_flux, & dhi_dt_out=thdgrsn, & - dhs_dt_out=thdgr ) + dhs_dt_out=thdgr, & + evap_ocn_out=evaporation ) heat_flux = - net_heat_flux water_flux = - (fresh_wa_flux/1000.0_WP) - runoff @@ -209,7 +210,7 @@ subroutine oce_fluxes(mesh) #if defined (__icepack) - ! No global conservations + ! No global conservations for the moment #else diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 098b0c569..f99f8e5d1 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -804,7 +804,7 @@ module subroutine icepack_to_fesom( & fhocn_tot_out, fresh_tot_out, & strocnxT_out, strocnyT_out, & dhs_dt_out, dhi_dt_out, & - fsalt_out) + fsalt_out, evap_ocn_out ) use mod_mesh implicit none integer (kind=int_kind), intent(in) :: & @@ -819,7 +819,9 @@ module subroutine icepack_to_fesom( & strocnyT_out, & fsalt_out, & dhs_dt_out, & - dhi_dt_out + dhi_dt_out, & + evap_ocn_out + end subroutine icepack_to_fesom ! Trancers advection diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 75cdf918a..40e33043a 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -928,9 +928,7 @@ subroutine ocn_mixed_layer_icepack( & evap_ocn , & ! evaporative water flux (kg/m^2/s) fhocn , & ! net heat flux to ocean (W/m^2) fresh , & ! fresh water flux to ocean (kg/m^2/s) - frzmlt ! freezing/melting potential (W/m^2) - - real (kind=dbl_kind), intent(out) :: & + frzmlt , & ! freezing/melting potential (W/m^2) fhocn_tot , & ! net total heat flux to ocean (W/m^2) fresh_tot ! fresh total water flux to ocean (kg/m^2/s) diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 index dbd894e2d..28537172c 100644 --- a/src/icepack_drivers/icedrv_transfer.F90 +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -178,7 +178,7 @@ module subroutine icepack_to_fesom( nx_in, & fhocn_tot_out, fresh_tot_out, & strocnxT_out, strocnyT_out, & dhs_dt_out, dhi_dt_out, & - fsalt_out) + fsalt_out, evap_ocn_out ) implicit none @@ -195,7 +195,8 @@ module subroutine icepack_to_fesom( nx_in, & strocnyT_out, & fsalt_out, & dhs_dt_out, & - dhi_dt_out + dhi_dt_out, & + evap_ocn_out character(len=*),parameter :: subname='(icepack_to_fesom)' @@ -210,6 +211,7 @@ module subroutine icepack_to_fesom( nx_in, & if (present(dhi_dt_out) ) dhi_dt_out = dhi_dt if (present(dhs_dt_out) ) dhs_dt_out = dhs_dt if (present(fsalt_out) ) fsalt_out = fsalt + if (present(evap_ocn_out) ) evap_ocn_out = evap_ocn end subroutine icepack_to_fesom From 69ae7dca179ca78fbc576a8cd929f040556e6480 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 2 Jun 2020 13:43:09 +0200 Subject: [PATCH 24/54] Stable version - results to be checked --- config/namelist.icepack | 173 +--------------------------- src/ice_oce_coupling.F90 | 16 +-- src/ice_setup_step.F90 | 13 ++- src/icepack_drivers/icedrv_init.F90 | 8 +- src/icepack_drivers/icedrv_main.F90 | 7 +- src/icepack_drivers/icedrv_step.F90 | 26 ++++- 6 files changed, 55 insertions(+), 188 deletions(-) diff --git a/config/namelist.icepack b/config/namelist.icepack index bd1678624..5f7a828f4 100755 --- a/config/namelist.icepack +++ b/config/namelist.icepack @@ -30,17 +30,17 @@ &tracer_nml tr_iage = .false. tr_FY = .false. - tr_lvl = .true. + tr_lvl = .false. tr_pond_cesm = .false. tr_pond_topo = .false. - tr_pond_lvl = .true. + tr_pond_lvl = .false. tr_aero = .false. tr_fsd = .false. / &thermo_nml kitd = 1 - ktherm = 2 + ktherm = 1 conduct = 'bubbly' a_rapid_mode = 0.5e-3 Rac_rapid_mode = 10.0 @@ -51,7 +51,7 @@ / &shortwave_nml - shortwave = 'dEdd' + shortwave = 'ccsm3' albedo_type = 'ccsm3' albicev = 0.78 albicei = 0.36 @@ -89,26 +89,9 @@ fbot_xfer_type = 'constant' update_ocn_f = .false. l_mpond_fresh = .false. - tfrz_option = 'mushy' + tfrz_option = 'linear_salt' oceanmixed_ice = .true. wave_spec_type = 'none' - restore_ocn = .false. - trestore = 90 - precip_units = 'mks' - default_season = 'spring' - atm_data_type = 'clim' - ocn_data_type = 'SHEBA' - bgc_data_type = 'default' - fyear_init = 2015 - ycycle = 1 - data_dir = '/Users/ftuser/Desktop/CICE-Consortium/ICEPACK_DATA/' - atm_data_file = 'unknown_atm_data_file' - ocn_data_file = 'unknown_ocn_data_file' - bgc_data_file = 'unknown_bgc_data_file' - ice_data_file = 'open_clos_lindsay.dat' - atm_data_format = 'bin' - ocn_data_format = 'bin' - bgc_data_format = 'bin' / &dynamics_nml @@ -119,149 +102,3 @@ Cf = 17. / -&zbgc_nml - tr_brine = .false. - tr_zaero = .false. - modal_aero = .false. - skl_bgc = .false. - z_tracers = .false. - dEdd_algae = .false. - solve_zbgc = .false. - bgc_flux_type = 'Jin2006' - restore_bgc = .false. - scale_bgc = .false. - solve_zsal = .false. - tr_bgc_Nit = .false. - tr_bgc_C = .false. - tr_bgc_chl = .false. - tr_bgc_Am = .false. - tr_bgc_Sil = .false. - tr_bgc_DMS = .false. - tr_bgc_PON = .false. - tr_bgc_hum = .false. - tr_bgc_DON = .false. - tr_bgc_Fe = .false. - grid_o = 0.006 - l_sk = 0.024 - grid_oS = 0.0 - l_skS = 0.028 - phi_snow = -0.3 - initbio_frac = 0.8 - frazil_scav = 0.8 - ratio_Si2N_diatoms = 1.8 - ratio_Si2N_sp = 0.0 - ratio_Si2N_phaeo = 0.0 - ratio_S2N_diatoms = 0.03 - ratio_S2N_sp = 0.03 - ratio_S2N_phaeo = 0.03 - ratio_Fe2C_diatoms = 0.0033 - ratio_Fe2C_sp = 0.0033 - ratio_Fe2C_phaeo = 0.1 - ratio_Fe2N_diatoms = 0.023 - ratio_Fe2N_sp = 0.023 - ratio_Fe2N_phaeo = 0.7 - ratio_Fe2DON = 0.023 - ratio_Fe2DOC_s = 0.1 - ratio_Fe2DOC_l = 0.033 - fr_resp = 0.05 - tau_min = 5200.0 - tau_max = 173000.0 - algal_vel = 0.0000000111 - R_dFe2dust = 0.035 - dustFe_sol = 0.005 - chlabs_diatoms = 0.03 - chlabs_sp = 0.01 - chlabs_phaeo = 0.05 - alpha2max_low_diatoms = 0.8 - alpha2max_low_sp = 0.67 - alpha2max_low_phaeo = 0.67 - beta2max_diatoms = 0.018 - beta2max_sp = 0.0025 - beta2max_phaeo = 0.01 - mu_max_diatoms = 1.44 - mu_max_sp = 0.851 - mu_max_phaeo = 0.851 - grow_Tdep_diatoms = 0.06 - grow_Tdep_sp = 0.06 - grow_Tdep_phaeo = 0.06 - fr_graze_diatoms = 0.0 - fr_graze_sp = 0.1 - fr_graze_phaeo = 0.1 - mort_pre_diatoms = 0.007 - mort_pre_sp = 0.007 - mort_pre_phaeo = 0.007 - mort_Tdep_diatoms = 0.03 - mort_Tdep_sp = 0.03 - mort_Tdep_phaeo = 0.03 - k_exude_diatoms = 0.0 - k_exude_sp = 0.0 - k_exude_phaeo = 0.0 - K_Nit_diatoms = 1.0 - K_Nit_sp = 1.0 - K_Nit_phaeo = 1.0 - K_Am_diatoms = 0.3 - K_Am_sp = 0.3 - K_Am_phaeo = 0.3 - K_Sil_diatoms = 4.0 - K_Sil_sp = 0.0 - K_Sil_phaeo = 0.0 - K_Fe_diatoms = 1.0 - K_Fe_sp = 0.2 - K_Fe_phaeo = 0.1 - f_don_protein = 0.6 - kn_bac_protein = 0.03 - f_don_Am_protein = 0.25 - f_doc_s = 0.4 - f_doc_l = 0.4 - f_exude_s = 1.0 - f_exude_l = 1.0 - k_bac_s = 0.03 - k_bac_l = 0.03 - T_max = 0.0 - fsal = 1.0 - op_dep_min = 0.1 - fr_graze_s = 0.5 - fr_graze_e = 0.5 - fr_mort2min = 0.5 - fr_dFe = 0.3 - k_nitrif = 0.0 - t_iron_conv = 3065.0 - max_loss = 0.9 - max_dfe_doc1 = 0.2 - fr_resp_s = 0.75 - y_sk_DMS = 0.5 - t_sk_conv = 3.0 - t_sk_ox = 10.0 - algaltype_diatoms = 0.0 - algaltype_sp = 0.5 - algaltype_phaeo = 0.5 - nitratetype = -1.0 - ammoniumtype = 1.0 - silicatetype = -1.0 - dmspptype = 0.5 - dmspdtype = -1.0 - humtype = 1.0 - doctype_s = 0.5 - doctype_l = 0.5 - dontype_protein = 0.5 - fedtype_1 = 0.5 - feptype_1 = 0.5 - zaerotype_bc1 = 1.0 - zaerotype_bc2 = 1.0 - zaerotype_dust1 = 1.0 - zaerotype_dust2 = 1.0 - zaerotype_dust3 = 1.0 - zaerotype_dust4 = 1.0 - ratio_C2N_diatoms = 7.0 - ratio_C2N_sp = 7.0 - ratio_C2N_phaeo = 7.0 - ratio_chl2N_diatoms= 2.1 - ratio_chl2N_sp = 1.1 - ratio_chl2N_phaeo = 0.84 - F_abs_chl_diatoms = 2.0 - F_abs_chl_sp = 4.0 - F_abs_chl_phaeo = 5.0 - ratio_C2N_proteins = 7.0 -/ - - diff --git a/src/ice_oce_coupling.F90 b/src/ice_oce_coupling.F90 index b67dfdffb..fd68e2190 100755 --- a/src/ice_oce_coupling.F90 +++ b/src/ice_oce_coupling.F90 @@ -171,9 +171,13 @@ subroutine oce_fluxes(mesh) dhs_dt_out=thdgr, & evap_ocn_out=evaporation ) - heat_flux = - net_heat_flux - water_flux = - (fresh_wa_flux/1000.0_WP) - runoff + heat_flux(:) = - net_heat_flux(:) + water_flux(:) = - (fresh_wa_flux(:)/1000.0_WP) - runoff(:) + ! Evaporation + evaporation(:) = - evaporation(:) / 1000.0_WP + ice_sublimation(:) = 0.0_WP + call init_flux_atm_ocn() #else @@ -208,12 +212,6 @@ subroutine oce_fluxes(mesh) relax_salt(n)=surf_relax_S*(Ssurf(n)-tr_arr(1,n,2)) end do -#if defined (__icepack) - - ! No global conservations for the moment - -#else - ! enforce the total freshwater/salt flux be zero ! 1. water flux ! if (.not. use_virt_salt) can be used! ! we conserve only the fluxes from the database plus evaporation. @@ -247,8 +245,6 @@ subroutine oce_fluxes(mesh) virtual_salt=virtual_salt-net/ocean_area end if -#endif - ! 3. restoring to SSS climatology call integrate_nod(relax_salt, net, mesh) relax_salt=relax_salt-net/ocean_area diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index 9d3939133..0a3466063 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -161,6 +161,11 @@ subroutine ice_timestep(step, mesh) type(t_mesh), intent(in) , target :: mesh integer :: step REAL(kind=WP) :: t0,t1, t2, t3 + +#if defined (__icepack) +real(kind=WP) :: time_advec, time_therm +#endif + t0=MPI_Wtime() ! ===== Dynamics if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call EVPdynamics...'//achar(27)//'[0m' @@ -179,8 +184,7 @@ subroutine ice_timestep(step, mesh) t1=MPI_Wtime() #if defined (__icepack) - t2=MPI_Wtime() - call step_icepack(mesh) ! Advection and Thermodynamic Parts + call step_icepack(mesh, time_advec, time_therm) ! Advection and Thermodynamic Parts #else ! ===== Advection part @@ -208,8 +212,13 @@ subroutine ice_timestep(step, mesh) if(mod(step,logfile_outfreq)==0 .and. mype==0) then write(*,*) '___ICE STEP EXECUTION TIMES____________________________' write(*,"(A, ES10.3)") ' Ice Dyn. :', t1-t0 +#if defined (__icepack) + write(*,"(A, ES10.3)") ' Ice Advect. :', time_advec + write(*,"(A, ES10.3)") ' Ice Thermodyn. :', time_therm +#else write(*,"(A, ES10.3)") ' Ice Advect. :', t2-t1 write(*,"(A, ES10.3)") ' Ice Thermodyn. :', t3-t2 +#endif write(*,*) ' _______________________________' write(*,"(A, ES10.3)") ' Ice TOTAL :', t3-t0 write(*,*) diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 99fc6a7e6..e3b55cbe7 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -936,9 +936,9 @@ module subroutine init_icepack(mesh) ! generate some output if (mype==0) then - call icepack_write_tracer_flags(ice_stderr) - call icepack_write_tracer_sizes(ice_stderr) - call icepack_write_tracer_indices(ice_stderr) + call icepack_write_tracer_flags(nu_diag) + call icepack_write_tracer_sizes(nu_diag) + call icepack_write_tracer_indices(nu_diag) call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -957,7 +957,7 @@ module subroutine init_icepack(mesh) if (mype==0) then call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output - call icepack_warnings_flush(ice_stderr) + call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted(subname)) & call icedrv_system_abort(file=__FILE__,line=__LINE__) end if diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index f99f8e5d1..ae9a83455 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -839,10 +839,13 @@ module subroutine init_advection_icepack(mesh) end subroutine init_advection_icepack ! Driving subroutine for column physics - module subroutine step_icepack(mesh) + module subroutine step_icepack(mesh, time_advec, time_therm) use mod_mesh implicit none - type(t_mesh), intent(in), target :: mesh + real (kind=dbl_kind), intent(out) :: & + time_therm, & + time_advec + type(t_mesh), intent(in), target :: mesh end subroutine step_icepack end interface diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 40e33043a..a58e126bf 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -1112,7 +1112,7 @@ end subroutine coupling_prep !======================================================================= - module subroutine step_icepack(mesh) + module subroutine step_icepack(mesh, time_advec, time_therm) use g_config, only: dt use mod_mesh @@ -1127,7 +1127,12 @@ module subroutine step_icepack(mesh) tr_fsd, wave_spec real (kind=dbl_kind) :: & - offset ! d(age)/dt time offset + offset, & ! d(age)/dt time offset + t1, t2, t3 + + real (kind=dbl_kind), intent(out) :: & + time_therm, & + time_advec type(t_mesh), target, intent(in) :: mesh @@ -1146,6 +1151,12 @@ module subroutine step_icepack(mesh) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) + t1 = c0 + t2 = c0 + t3 = c0 + + !t1 = MPI_Wtime() + !----------------------------------------------------------------- ! copy variables from fesom2 (also ice velocities) !----------------------------------------------------------------- @@ -1158,6 +1169,8 @@ module subroutine step_icepack(mesh) call tracer_advection_icepack(mesh) + !t2 = MPI_Wtime() + !----------------------------------------------------------------- ! tendencies needed by fesom !----------------------------------------------------------------- @@ -1230,6 +1243,15 @@ module subroutine step_icepack(mesh) dhi_dt(:) = ( vice(:) - dhi_dt(:) ) / dt dhs_dt(:) = ( vsno(:) - dhi_dt(:) ) / dt + !t3 = MPI_Wtime() + + !----------------------------------------------------------------- + ! icepack timing + !----------------------------------------------------------------- + + time_advec = t2 - t1 + time_therm = t3 - t2 + end subroutine step_icepack From 41a5730a3e1a4d90c2ccf0a71d779459ff6e9b76 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 4 Jun 2020 14:28:12 +0200 Subject: [PATCH 25/54] Iepack output implemented --- config/namelist.icepack | 22 +++ src/ice_setup_step.F90 | 2 + src/icepack_drivers/icedrv_advection.F90 | 14 +- src/icepack_drivers/icedrv_init.F90 | 107 +++++++------ src/icepack_drivers/icedrv_io.F90 | 195 +++++++++++++++++++++++ src/icepack_drivers/icedrv_main.F90 | 14 +- src/icepack_drivers/icedrv_step.F90 | 2 +- src/icepack_drivers/icedrv_system.F90 | 8 +- src/io_meandata.F90 | 84 +++++++--- 9 files changed, 361 insertions(+), 87 deletions(-) create mode 100644 src/icepack_drivers/icedrv_io.F90 diff --git a/config/namelist.icepack b/config/namelist.icepack index 5f7a828f4..468f2ef3d 100755 --- a/config/namelist.icepack +++ b/config/namelist.icepack @@ -102,3 +102,25 @@ Cf = 17. / +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!! Icepack output namelist !!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +&nml_list_icepack +io_list_icepack = 'aicen ',1, 'd', 4, ! Sea ice concentration + 'vicen ',1, 'd', 4, ! Volume per unit area of ice + 'vsnon ',1, 'd', 4, ! Volume per unit area of snow + 'Tsfc ',1, 'd', 4, ! Sea ice surf. temperature + !'iage ',1, 'm', 4, ! Sea ice age + !'FY ',1, 'm', 4, ! First year ice + !'lvl ',1, 'm', 4, ! Ridged sea ice area and volume + !'pond_cesm ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'pond_topo ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'pond_lvl ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'brine ',1, 'm', 4, ! Volume fraction of ice with dynamic salt + !'qicen ',1, 'm', 4, ! Sea ice enthalpy + !'sicen ',1, 'm', 4, ! Sea ice salinity + !'qsnon ',1, 'm', 4, ! Snow enthalpy + !'test_a_b ',1, 'm', 4, ! Test advection + !'test_a_a ',1, 'm', 4, ! Test advection +/ diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index 0a3466063..37ab003d8 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -251,6 +251,7 @@ subroutine ice_initial_state(mesh) m_snow=0._WP if(mype==0) write(*,*) 'initialize the sea ice' +#if defined (__icepack) do i=1,myDim_nod2D+eDim_nod2D if (tr_arr(1,i,1)< 0.0_WP) then if (geo_coord_nod2D(2,i)>0._WP) then @@ -266,4 +267,5 @@ subroutine ice_initial_state(mesh) v_ice(i) = 0.0_WP endif enddo +#endif end subroutine ice_initial_state diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index bbc50e92c..9e1172be3 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -678,13 +678,13 @@ module subroutine tracer_advection_icepack(mesh) ! cut off icepack - call cut_off_icepack (nx, & - ntrcr, narr, & - trcr_depend(:), trcr_base(:,:), & - n_trcr_strata(:), nt_strata(:,:), & - aicen(:,:), trcrn (:,:,:), & - vicen(:,:), vsnon (:,:), & - aice0(:)) +! call cut_off_icepack (nx, & +! ntrcr, narr, & +! trcr_depend(:), trcr_base(:,:), & +! n_trcr_strata(:), nt_strata(:,:), & +! aicen(:,:), trcrn (:,:,:), & +! vicen(:,:), vsnon (:,:), & +! aice0(:)) do i=1,nx if (ncat > 1) then ! Do we really need this? diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index e3b55cbe7..2a6b25dcf 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -199,7 +199,7 @@ subroutine init_state() ! Set state variables !----------------------------------------------------------------- - call init_state_var + call init_state_var() end subroutine init_state @@ -607,7 +607,8 @@ subroutine init_thermo_vertical() enddo ! k enddo ! i - if (mype==0) write(*,*) maxval(salinz), minval(salinz) + if (mype==0) write(nu_diag,*) 'Maximum and minimum sea ice salinity' + if (mype==0) write(nu_diag,*) maxval(salinz), minval(salinz) end subroutine init_thermo_vertical @@ -986,6 +987,10 @@ module subroutine init_icepack(mesh) call init_shortwave ! initialize radiative transfer using current swdn call init_flux_atm_ocn ! initialize atmosphere, ocean fluxes + if (mype==0) write(*,*) maxval(aicen), minval(aicen) + if (mype==0) write(*,*) maxval(vicen), minval(vicen) + if (mype==0) write(*,*) maxval(trcrn(:,2:5,:)), minval(trcrn(:,2:5,:)) + end subroutine init_icepack !======================================================================= @@ -1073,55 +1078,57 @@ subroutine init_state_var () hinit(n) = c0 enddo - if (3 <= ncat) then - n = 3 - ainit(n) = c1 ! assumes we are using the default ITD boundaries - hinit(n) = c2 - else - ainit(ncat) = c1 - hinit(ncat) = c2 - endif + ! For the moment we start we no sea ice - do i = 1, nx - if (sst(i) <= Tf(i)) then ! - do n = 1, ncat - ! ice volume, snow volume - aicen(i,n) = ainit(n) - vicen(i,n) = hinit(n) * ainit(n) ! m - vsnon(i,n) = c0 - ! tracers - call icepack_init_trcr(Tair = T_air(i), & - Tf = Tf(i), & - Sprofile = salinz(i,:), & - Tprofile = Tmltz(i,:), & - Tsfc = Tsfc, & - nilyr=nilyr, nslyr=nslyr, & - qin=qin(:), qsn=qsn(:)) - - ! floe size distribution - if (tr_fsd) call icepack_init_fsd(nfsd=nfsd, ice_ic=ice_ic, & - floe_rad_c=floe_rad_c, & - floe_binwidth=floe_binwidth, & - afsd=trcrn(i,nt_fsd:nt_fsd+nfsd-1,n)) - ! surface temperature - trcrn(i,nt_Tsfc,n) = Tsfc ! deg C - ! ice enthalpy, salinity - do k = 1, nilyr - trcrn(i,nt_qice+k-1,n) = qin(k) - trcrn(i,nt_sice+k-1,n) = salinz(i,k) - enddo - ! snow enthalpy - do k = 1, nslyr - trcrn(i,nt_qsno+k-1,n) = -rhos * Lfresh - enddo ! nslyr - ! brine fraction - if (tr_brine) trcrn(i,nt_fbri,n) = c1 - enddo ! ncat - call icepack_warnings_flush(ice_stderr) - if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & - file=__FILE__, line=__LINE__) - endif - enddo +! if (3 <= ncat) then +! n = 3 +! ainit(n) = c1 ! assumes we are using the default ITD boundaries +! hinit(n) = c2 +! else +! ainit(ncat) = c1 +! hinit(ncat) = c2 +! endif +! +! do i = 1, nx +! if (sst(i) <= Tf(i)) then ! +! do n = 1, ncat +! ! ice volume, snow volume +! aicen(i,n) = ainit(n) +! vicen(i,n) = hinit(n) * ainit(n) ! m +! vsnon(i,n) = c0 +! ! tracers +! call icepack_init_trcr(Tair = T_air(i), & +! Tf = Tf(i), & +! Sprofile = salinz(i,:), & +! Tprofile = Tmltz(i,:), & +! Tsfc = Tsfc, & +! nilyr=nilyr, nslyr=nslyr, & +! qin=qin(:), qsn=qsn(:)) +! +! ! floe size distribution +! if (tr_fsd) call icepack_init_fsd(nfsd=nfsd, ice_ic=ice_ic, & +! floe_rad_c=floe_rad_c, & +! floe_binwidth=floe_binwidth, & +! afsd=trcrn(i,nt_fsd:nt_fsd+nfsd-1,n)) +! ! surface temperature +! trcrn(i,nt_Tsfc,n) = Tsfc ! deg C +! ! ice enthalpy, salinity +! do k = 1, nilyr +! trcrn(i,nt_qice+k-1,n) = qin(k) +! trcrn(i,nt_sice+k-1,n) = salinz(i,k) +! enddo +! ! snow enthalpy +! do k = 1, nslyr +! trcrn(i,nt_qsno+k-1,n) = -rhos * Lfresh +! enddo ! nslyr +! ! brine fraction +! if (tr_brine) trcrn(i,nt_fbri,n) = c1 +! enddo ! ncat +! call icepack_warnings_flush(ice_stderr) +! if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & +! file=__FILE__, line=__LINE__) +! endif +! enddo !----------------------------------------------------------------- ! compute aggregate ice state and open water area diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 new file mode 100644 index 000000000..2f5aca0f9 --- /dev/null +++ b/src/icepack_drivers/icedrv_io.F90 @@ -0,0 +1,195 @@ +!======================================================================= +! +! This submodule initializes the IO subroutines +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + + submodule (icedrv_main) icedrv_io + + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_tracer_indices + use icedrv_system, only: icedrv_system_abort + use io_meandata, only: def_stream3D + + contains + + module subroutine init_io_icepack(mesh) + + use mod_mesh + use g_parsup + + implicit none + + type(t_mesh), target, intent(in) :: mesh + + integer :: i, j, k, & + nt_Tsfc, nt_sice, nt_qice, nt_qsno, & + nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, & + nt_vlvl, nt_iage, nt_FY, nt_aero, & + ktherm, nt_fbri + + integer, save :: nm_io_unit = 102 ! unit to open namelist file + integer, save :: nm_icepack_unit = 103 + integer :: iost + character(len=10) :: id_string + character(500) :: longname, trname, units + + logical (kind=log_kind) :: & + solve_zsal, skl_bgc, z_tracers, & + tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_pond_topo, tr_pond_lvl, tr_brine, & + tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & + tr_bgc_Sil, tr_bgc_DMS, & + tr_bgc_chl, tr_bgc_Am, & + tr_bgc_PON, tr_bgc_DON, & + tr_zaero, tr_bgc_Fe, & + tr_bgc_hum + + integer, save :: io_listsize=0 + type io_entry + character(len=10) :: id ='unknown ' + integer :: freq =0 + character :: unit ='' + integer :: precision =0 + end type + + type(io_entry), save, allocatable, target :: io_list_icepack(:) + +#include "../associate_mesh.h" + + ! Get the tracers information from icepack + 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_indices( & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & + nt_aero_out=nt_aero, nt_qsno_out=nt_qsno) + call icepack_query_parameters(solve_zsal_out=solve_zsal, & + skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, ktherm_out=ktherm) + call icepack_query_tracer_flags( & + tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & + tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, & + tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Sil_out=tr_bgc_Sil, & + tr_bgc_DMS_out=tr_bgc_DMS, & + tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & + tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & + tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & + tr_bgc_hum_out=tr_bgc_hum) + + namelist /nml_listsize / io_listsize + namelist /nml_list_icepack / io_list_icepack + + ! OPEN and read namelist for icepack I/O + open( unit=nm_io_unit, file='namelist.io', form='formatted', access='sequential', status='old', iostat=iost ) + if (iost == 0) then + if (mype==0) write(*,*) ' file : ', 'namelist.io',' open ok' + else + if (mype==0) write(*,*) 'ERROR: --> bad opening file : ','namelist.io',' ; iostat=',iost + call par_ex + stop + end if + open( unit=nm_icepack_unit, file='namelist.icepack', form='formatted', access='sequential', status='old', iostat=iost ) + if (iost == 0) then + if (mype==0) write(*,*) ' file : ', 'namelist.icepack',' open ok' + else + if (mype==0) write(*,*) 'ERROR: --> bad opening file : ','namelist.icepack',' ; iostat=',iost + call par_ex + stop + end if + + read(nm_io_unit, nml=nml_listsize, iostat=iost ) + allocate(io_list_icepack(io_listsize)) + read(nm_icepack_unit, nml=nml_list_icepack, iostat=iost ) + close(nm_icepack_unit) + + + do i=1, io_listsize + if (trim(io_list_icepack(i)%id)=='unknown ') then + if (mype==0) write(*,*) 'io_listsize will be changed from ', io_listsize, ' to ', i-1, '!' + io_listsize=i-1 + exit + end if + end do + + do i=1, io_listsize + select case (trim(io_list_icepack(i)%id)) + case ('aicen ') + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'aicen', 'sea ice concentration', 'none', aicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('vicen ') + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vicen', 'volume per unit area of ice', 'm', vicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('vsnon ') + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vsnon', 'volume per unit area of snow', 'm', vsnon(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('Tsfc ') + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'Tsfc', 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + ! If the following tracers are not defined they will not be outputed + case ('iage ') + if (tr_iage) then + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'iage', 'sea ice age', 's', trcrn(:,nt_iage,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('FY ') + if (tr_FY) then + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'FY', 'first year ice', 'none', trcrn(:,nt_FY,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('lvl ') + if (tr_lvl) then + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'alvl', 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vlvl', 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('pond_cesm ') + if (tr_pond_cesm) then + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt ponds area', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vpnd', 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('pond_topo ') + if (tr_pond_topo) then + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt ponds area', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vpnd', 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'ipnd', 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('pond_lvl ') + if (tr_pond_lvl) then + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt ponds area', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vpnd', 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'ipnd', 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('brine ') + if (tr_brine) then + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'fbri', 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('qicen ') + do k = 1,nilyr ! Separate variable for each sea ice layer + write(trname,'(A6,i1)') 'qicen_', k + write(longname,'(A22,i1)') 'sea ice enthalpy lyr: ', k + units='J/m3' + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), trim(trname), trim(longname), trim(units), trcrn(:,nt_qice+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end do + case ('sicen ') + do k = 1,nilyr ! Separate variable for each sea ice layer + write(trname,'(A6,i1)') 'sicen_', k + write(longname,'(A22,i1)') 'sea ice salinity lyr: ', k + units='psu' + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), trim(trname), trim(longname), trim(units), trcrn(:,nt_sice+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end do + case ('qsnon ') + do k = 1,nslyr ! Separate variable for each snow layer + write(trname,'(A6,i1)') 'qsnon_', k + write(longname,'(A19,i1)') 'snow enthalpy lyr: ', k + units='J/m3' + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), trim(trname), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end do + case default + if (mype==0) write(*,*) 'stream ', io_list_icepack(i)%id, ' is not defined !' + end select + end do + + end subroutine init_io_icepack + + end submodule icedrv_io diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index ae9a83455..1ec0eac5d 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -19,9 +19,13 @@ module icedrv_main !--------- subroutines to be seen outside icepack !======================================================================= - public :: set_icepack, alloc_icepack, init_icepack, step_icepack, & + public :: & + ! Variables + ncat, & + ! Subroutines + set_icepack, alloc_icepack, init_icepack, step_icepack, & icepack_to_fesom, rdg_conv_elem, rdg_shear_elem, & - init_flux_atm_ocn + init_flux_atm_ocn, init_io_icepack !======================================================================= !--------- Everything else is private @@ -848,6 +852,12 @@ module subroutine step_icepack(mesh, time_advec, time_therm) type(t_mesh), intent(in), target :: mesh end subroutine step_icepack + ! Initialize output + module subroutine init_io_icepack(mesh) + implicit none + type(t_mesh), intent(in), target :: mesh + end subroutine init_io_icepack + end interface end module icedrv_main diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index a58e126bf..e6f4b4cb1 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -1167,7 +1167,7 @@ module subroutine step_icepack(mesh, time_advec, time_therm) ! advect tracers !----------------------------------------------------------------- - call tracer_advection_icepack(mesh) + !call tracer_advection_icepack(mesh) !t2 = MPI_Wtime() diff --git a/src/icepack_drivers/icedrv_system.F90 b/src/icepack_drivers/icedrv_system.F90 index 8262015ad..8a130bbd7 100644 --- a/src/icepack_drivers/icedrv_system.F90 +++ b/src/icepack_drivers/icedrv_system.F90 @@ -42,10 +42,10 @@ subroutine icedrv_system_abort(icell, istep, string, file, line) write(ice_stderr,*) ' ' write(ice_stderr,*) subname,' ABORTED: ' - if (present(file)) write (ice_stderr,*) subname,' called from', trim(file) - if (present(line)) write (ice_stderr,*) subname,' line number', line - if (present(istep)) write (ice_stderr,*) subname,' istep =', istep - if (present(string)) write (ice_stderr,*) subname,' string =', trim(string) + if (present(file)) write (ice_stderr,*) subname,' called from ', trim(file) + if (present(line)) write (ice_stderr,*) subname,' line number', line + if (present(istep)) write (ice_stderr,*) subname,' istep =', istep + if (present(string)) write (ice_stderr,*) subname,' string =', trim(string) ! Stop FESOM2 diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index d8999c612..a8104203c 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -21,7 +21,7 @@ module io_MEANDATA implicit none #include "netcdf.inc" private - public :: def_stream3D, output + public :: def_stream2D, def_stream3D, output ! !-------------------------------------------------------------------------------------------- ! @@ -505,6 +505,11 @@ end subroutine ini_mean_io !-------------------------------------------------------------------------------------------- ! function get_dimname(n, mesh) result(s) + +#if defined (__icepack) + use icedrv_main, only: ncat ! number of ice thickness cathegories +#endif + implicit none integer :: n type(t_mesh) , target :: mesh @@ -522,6 +527,10 @@ function get_dimname(n, mesh) result(s) s='nz1' elseif (n==std_dens_N) then s='ndens' +#if defined (__icepack) + elseif (n==ncat) then + s='ncat' +#endif else s='unknown' if (mype==0) write(*,*) 'WARNING: unknown dimension in mean I/O with zise of ', n @@ -556,7 +565,7 @@ subroutine create_new_file(entry) att_text='time' entry%error_status(c) = nf_put_att_text(entry%ncid, entry%tID, 'long_name', len_trim(att_text), trim(att_text)); c=c+1 - write(att_text, '(a14,I4.4,a1,I2.2,a1,I2.2,a6)') 'seconds since ', yearold, '-', 1, '-', 1, ' 0:0:0' + write(att_text, '(a14,I4.4,a1,I2.2,a1,I2.2,a6)'), 'seconds since ', yearold, '-', 1, '-', 1, ' 0:0:0' entry%error_status(c) = nf_put_att_text(entry%ncid, entry%tID, 'units', len_trim(att_text), trim(att_text)); c=c+1 if (entry%accuracy == i_real8) then @@ -644,7 +653,7 @@ subroutine write_mean(entry, mesh) real(real32), allocatable :: aux_r4(:) integer(int16), allocatable :: aux_i2(:) type(t_mesh), intent(in) , target :: mesh - integer :: i, size1, size2 + integer :: i, size1, size2, size_gen, size_lev, order integer :: c, lev #include "associate_mesh.h" @@ -699,39 +708,58 @@ subroutine write_mean(entry, mesh) elseif (entry%ndim==2) then size1=entry%glsize(1) size2=entry%glsize(2) + if (size1==nod2D .or. size1==elem2D) then + size_gen=size1 + size_lev=size2 + order=1 + else if (size2==nod2D .or. size2==elem2D) then + size_gen=size2 + size_lev=size1 + order=2 + end if !___________writing 8 byte real_________________________________________ if (entry%accuracy == i_real8) then - if (mype==0) allocate(aux_r8(size2)) - do lev=1, size1 - if (size1==nod2D .or. size2==nod2D) call gather_nod (entry%local_values_r8(lev,1:entry%lcsize(2)), aux_r8) - if (size1==elem2D .or. size2==elem2D) call gather_elem(entry%local_values_r8(lev,1:entry%lcsize(2)), aux_r8) + if (mype==0) allocate(aux_r8(size_gen)) + do lev=1, size_lev + if (size_gen==nod2D .and. order==1) call gather_nod (entry%local_values_r8(1:entry%lcsize(2),lev), aux_r8) + if (size_gen==elem2D .and. order==1) call gather_elem(entry%local_values_r8(1:entry%lcsize(2),lev), aux_r8) + if (size_gen==nod2D .and. order==2) call gather_nod (entry%local_values_r8(lev,1:entry%lcsize(2)), aux_r8) + if (size_gen==elem2D .and. order==2) call gather_elem(entry%local_values_r8(lev,1:entry%lcsize(2)), aux_r8) if (mype==0) then - entry%error_status(c)=nf_put_vara_double(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size2, 1/), aux_r8, 1); c=c+1 + if (order==1) entry%error_status(c)=nf_put_vara_double(entry%ncid, entry%varID, (/1, lev, entry%rec_count/), (/size_gen, 1, 1/), aux_r8, 1); c=c+1 + if (order==2) entry%error_status(c)=nf_put_vara_double(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size_gen, 1/), aux_r8, 1); c=c+1 end if end do if (mype==0) deallocate(aux_r8) -!___________writing real 4 byte real _________________________________________ - elseif (entry%accuracy == i_real4) then - if (mype==0) allocate(aux_r4(size2)) - do lev=1, size1 - if (size1==nod2D .or. size2==nod2D) call gather_nod (entry%local_values_r4(lev,1:entry%lcsize(2)), aux_r4) - if (size1==elem2D .or. size2==elem2D) call gather_elem(entry%local_values_r4(lev,1:entry%lcsize(2)), aux_r4) +!___________writing 4 byte real_________________________________________ + else if (entry%accuracy == i_real4) then + if (mype==0) allocate(aux_r4(size_gen)) + do lev=1, size_lev + if (size_gen==nod2D .and. order==1) call gather_nod (entry%local_values_r4(1:entry%lcsize(2),lev), aux_r4) + if (size_gen==elem2D .and. order==1) call gather_elem(entry%local_values_r4(1:entry%lcsize(2),lev), aux_r4) + if (size_gen==nod2D .and. order==2) call gather_nod (entry%local_values_r4(lev,1:entry%lcsize(2)), aux_r4) + if (size_gen==elem2D .and. order==2) call gather_elem(entry%local_values_r4(lev,1:entry%lcsize(2)), aux_r4) if (mype==0) then - entry%error_status(c)=nf_put_vara_real(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size2, 1/), aux_r4, 1); c=c+1 + if (order==1) entry%error_status(c)=nf_put_vara_real(entry%ncid, entry%varID, (/1, lev, entry%rec_count/), (/size_gen, 1, 1/), aux_r4, 1); c=c+1 + if (order==2) entry%error_status(c)=nf_put_vara_real(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size_gen, 1/), aux_r4, 1); c=c+1 end if end do if (mype==0) deallocate(aux_r4) -!___________writing real as 2 byte integer _________________________________________ - elseif (entry%accuracy == i_int2) then - if (mype==0) allocate(aux_i2(size2)) - do lev=1, size1 - if (size1==nod2D .or. size2==nod2D) call gather_nod (entry%local_values_i2(lev,1:entry%lcsize(2)), aux_i2) - if (size1==elem2D .or. size2==elem2D) call gather_elem(entry%local_values_i2(lev,1:entry%lcsize(2)), aux_i2) +!___________writing real as 2 byte integer________________________________ + else if (entry%accuracy == i_int2) then + if (mype==0) allocate(aux_i2(size_gen)) + do lev=1, size_lev + if (size_gen==nod2D .and. order==1) call gather_nod (entry%local_values_i2(1:entry%lcsize(2),lev), aux_i2) + if (size_gen==elem2D .and. order==1) call gather_elem(entry%local_values_i2(1:entry%lcsize(2),lev), aux_i2) + if (size_gen==nod2D .and. order==2) call gather_nod (entry%local_values_i2(lev,1:entry%lcsize(2)), aux_i2) + if (size_gen==elem2D .and. order==2) call gather_elem(entry%local_values_i2(lev,1:entry%lcsize(2)), aux_i2) if (mype==0) then - entry%error_status(c)=nf_put_vara_int2(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size2, 1/), aux_i2, 1); c=c+1 + if (order==1) entry%error_status(c)=nf_put_vara_int2(entry%ncid, entry%varID, (/1, lev, entry%rec_count/), (/size_gen, 1, 1/), aux_i2, 1); c=c+1 + if (order==2) entry%error_status(c)=nf_put_vara_int2(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size_gen, 1/), aux_i2, 1); c=c+1 end if end do if (mype==0) deallocate(aux_i2) +!___________else_________________________________________________________ else if (mype==0) write(*,*) 'not supported output accuracy for mean I/O file.' call par_ex @@ -803,6 +831,11 @@ end subroutine update_means !-------------------------------------------------------------------------------------------- ! subroutine output(istep, mesh) + +#if defined (__icepack) + use icedrv_main, only: init_io_icepack +#endif + implicit none integer :: istep @@ -816,7 +849,12 @@ subroutine output(istep, mesh) type(t_mesh), intent(in) , target :: mesh ctime=timeold+(dayold-1.)*86400 - if (lfirst) call ini_mean_io(mesh) + if (lfirst) then + call ini_mean_io(mesh) +#if defined (__icepack) + call init_io_icepack(mesh) +#endif + end if call update_means From 1d61256059be2a720c057ab9cf0e1e8fefe10cad Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 5 Jun 2020 10:35:19 +0200 Subject: [PATCH 26/54] Restart not working yet --- src/icepack_drivers/icedrv_io.F90 | 178 +++++++++++++++++++++++++++- src/icepack_drivers/icedrv_main.F90 | 9 +- src/io_restart.F90 | 112 ++++++++++++----- 3 files changed, 267 insertions(+), 32 deletions(-) diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index 2f5aca0f9..a7f5df23f 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -12,15 +12,17 @@ use icepack_intfc, only: icepack_query_tracer_flags use icepack_intfc, only: icepack_query_tracer_sizes use icepack_intfc, only: icepack_query_tracer_indices + use icepack_intfc, only: icepack_warnings_flush + use icepack_intfc, only: icepack_warnings_aborted use icedrv_system, only: icedrv_system_abort - use io_meandata, only: def_stream3D - + contains module subroutine init_io_icepack(mesh) use mod_mesh use g_parsup + use io_meandata, only: def_stream3D implicit none @@ -192,4 +194,174 @@ module subroutine init_io_icepack(mesh) end subroutine init_io_icepack - end submodule icedrv_io + ! + !-------------------------------------------------------------------------------------------- + ! + + module subroutine init_restart_icepack(year, mesh) + + use mod_mesh + use g_parsup + use g_config, only: runid, ResultPath + use io_restart, only: ip_id, def_variable_2d, def_dim + + implicit none + + type(t_mesh), target, intent(in) :: mesh + + integer, intent(in) :: year + integer (kind=int_kind) :: ncid + integer (kind=int_kind) :: i, j, k, iblk, & ! counting indices + nt_Tsfc, nt_sice, nt_qice, nt_qsno, & + nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, & + nt_vlvl, nt_iage, nt_FY, nt_aero, & + ktherm, nt_fbri + integer (kind=int_kind) :: varid + character(500) :: longname + character(500) :: filename + character(500) :: trname, units + character(4) :: cyear + + logical (kind=log_kind) :: & + solve_zsal, skl_bgc, z_tracers, & + tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_pond_topo, tr_pond_lvl, tr_brine, & + tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & + tr_bgc_Sil, tr_bgc_DMS, & + tr_bgc_chl, tr_bgc_Am, & + tr_bgc_PON, tr_bgc_DON, & + tr_zaero, tr_bgc_Fe, & + tr_bgc_hum + +#include "../associate_mesh.h" + + ! Get the tracers information from icepack + 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_indices( & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & + nt_aero_out=nt_aero, nt_qsno_out=nt_qsno) + call icepack_query_parameters(solve_zsal_out=solve_zsal, & + skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, ktherm_out=ktherm) + call icepack_query_tracer_flags( & + tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & + tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, & + tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Sil_out=tr_bgc_Sil, & + tr_bgc_DMS_out=tr_bgc_DMS, & + tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & + tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & + tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & + tr_bgc_hum_out=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + ! The following error message needs to be fixed + !if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + ! file=__FILE__, line=__LINE__) + + write(cyear,'(i4)') year + ! Create an icepack restart file + ! Only serial output implemented so far + ip_id%filename=trim(ResultPath)//trim(runid)//'.'//cyear//'.icepack.restart.nc' + if (ip_id%is_in_use) return + ip_id%is_in_use=.true. + + ! Define the dimensions of the netCDF file + ! + ! Note that at the moment FESOM2 supports only 3D output and restart (very + ! suboptimal). The different ice layers are thus splitted in different arrays + ! and + ! reconstructed after the restart. Multidimensional variables would solve + ! this. + + call def_dim(ip_id, 'node', nod2D) ! Number of nodes + call def_dim(ip_id, 'ncat', ncat) ! Number of thickness classes + + ! Define the netCDF variables for surface + ! and vertically constant fields + + !----------------------------------------------------------------- + ! 3D restart fields (ncat) + !----------------------------------------------------------------- + + call def_variable_2d(ip_id, 'aicen', (/nod2D, ncat/), 'sea ice concentration', 'none', aicen(:,:)); + call def_variable_2d(ip_id, 'vicen', (/nod2D, ncat/), 'volum per unit area of ice', 'm', vicen(:,:)); + call def_variable_2d(ip_id, 'vsnon', (/nod2D, ncat/), 'volum per unit area of snow', 'm', vsnon(:,:)); + call def_variable_2d(ip_id, 'Tsfc', (/nod2D, ncat/), 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:)); + + if (tr_iage) then + call def_variable_2d(ip_id, 'iage', (/nod2D, ncat/), 'sea ice age', 's', trcrn(:,nt_iage,:)); + end if + + if (tr_FY) then + call def_variable_2d(ip_id, 'FY', (/nod2D, ncat/), 'first year ice', 'none', trcrn(:,nt_FY,:)); + end if + + if (tr_lvl) then + call def_variable_2d(ip_id, 'alvl', (/nod2D, ncat/), 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:)); + call def_variable_2d(ip_id, 'vlvl', (/nod2D, ncat/), 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:)); + end if + + if (tr_pond_cesm) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + end if + + if (tr_pond_topo) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); + end if + + if (tr_pond_lvl) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); + call def_variable_2d(ip_id, 'ffracn', (/nod2D, ncat/), 'fraction of fsurfn over pond used to melt ipond', 'none', ffracn); + call def_variable_2d(ip_id, 'dhsn', (/nod2D, ncat/), 'depth difference for snow on sea ice and pond ice', 'm', dhsn); + end if + + if (tr_brine) then + call def_variable_2d(ip_id, 'fbri', (/nod2D, ncat/), 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:)); + call def_variable_2d(ip_id, 'first_ice', (/nod2D, ncat/), 'distinguishes ice that disappears', 'logical', first_ice_real(:,:)); + end if + + !----------------------------------------------------------------- + ! 4D restart fields, written as layers of 3D + !----------------------------------------------------------------- + + ! Ice + + do k = 1,nilyr + write(trname,'(A6,i1)') 'sicen_', k + write(longname,'(A21,i1)') 'sea ice salinity lyr:', k + units='psu' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_sice+k-1,:)); + write(trname,'(A6,i1)') 'qicen_', k + write(longname,'(A21,i1)') 'sea ice enthalpy lyr:', k + units='J/m3' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qice+k-1,:)); + end do + + ! Snow + + do k = 1,nslyr + write(trname,'(A6,i1)') 'qsnon_', k + write(longname,'(A18,i1)') 'snow enthalpy lyr:', k + units='J/m3' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:)); + end do + + ! + ! All the other 4D tracers (linked to aerosols and biogeochemistry) are at the + ! moment not supported for restart. This might change if someone is interested + ! in using the biogeochemistry modules. At this stage, I do not know the model + ! enough to use these options. Lorenzo Zampieri - 16/10/2019. + ! + + end subroutine init_restart_icepack + + end submodule icedrv_io diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 1ec0eac5d..66a5869f9 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -25,7 +25,7 @@ module icedrv_main ! Subroutines set_icepack, alloc_icepack, init_icepack, step_icepack, & icepack_to_fesom, rdg_conv_elem, rdg_shear_elem, & - init_flux_atm_ocn, init_io_icepack + init_flux_atm_ocn, init_io_icepack, init_restart_icepack !======================================================================= !--------- Everything else is private @@ -858,6 +858,13 @@ module subroutine init_io_icepack(mesh) type(t_mesh), intent(in), target :: mesh end subroutine init_io_icepack + ! Initialize restart + module subroutine init_restart_icepack(year, mesh) + implicit none + type(t_mesh), intent(in), target :: mesh + integer(kind=int_kind), intent(in) :: year + end subroutine init_restart_icepack + end interface end module icedrv_main diff --git a/src/io_restart.F90 b/src/io_restart.F90 index dd4e0554b..3a456820e 100644 --- a/src/io_restart.F90 +++ b/src/io_restart.F90 @@ -55,10 +55,16 @@ MODULE io_RESTART ! id will keep the IDs of all required dimentions and variables type(nc_file), save :: oid, iid integer, save :: globalstep=0 +#if defined (__icepack) + type(nc_file), save :: ip_id +#endif real(kind=WP) :: ctime !current time in seconds from the beginning of the year PRIVATE - PUBLIC :: restart, oid, iid + PUBLIC :: restart, oid, iid +#if defined (__icepack) + PUBLIC :: ip_id, def_dim, def_variable_1d, def_variable_2d +#endif ! !-------------------------------------------------------------------------------------------- ! generic interface was required to associate variables of unknown rank with the pointers of the same rank @@ -187,6 +193,11 @@ end subroutine ini_ice_io !-------------------------------------------------------------------------------------------- ! subroutine restart(istep, l_write, l_read, mesh) + +#if defined(__icepack) + use icedrv_main, only: init_restart_icepack +#endif + implicit none ! this is the main restart subroutine ! if l_write is TRUE writing restart file will be forced @@ -202,9 +213,15 @@ subroutine restart(istep, l_write, l_read, mesh) if (.not. l_read) then call ini_ocean_io(yearnew, mesh) if (use_ice) call ini_ice_io (yearnew, mesh) +#if defined(__icepack) + if (use_ice) call init_restart_icepack(yearnew, mesh) +#endif else call ini_ocean_io(yearold, mesh) if (use_ice) call ini_ice_io (yearold, mesh) +#if defined(__icepack) + if (use_ice) call init_restart_icepack(yearold, mesh) +#endif end if if (l_read) then @@ -213,7 +230,11 @@ subroutine restart(istep, l_write, l_read, mesh) if (use_ice) then call assoc_ids(iid); call was_error(iid) call read_restart(iid, mesh); call was_error(iid) - end if +#if defined(__icepack) + call assoc_ids(ip_id); call was_error(ip_id) + call read_restart(ip_id, mesh); call was_error(ip_id) +#endif + end if end if if (istep==0) return @@ -249,6 +270,10 @@ subroutine restart(istep, l_write, l_read, mesh) if (use_ice) then call assoc_ids(iid); call was_error(iid) call write_restart(iid, istep, mesh); call was_error(iid) +#if defined(__icepack) + call assoc_ids(ip_id); call was_error(ip_id) + call write_restart(ip_id, istep, mesh); call was_error(ip_id) +#endif end if ! actualize clock file to latest restart point @@ -426,8 +451,8 @@ subroutine write_restart(id, istep, mesh) integer, intent(in) :: istep type(t_mesh), intent(in) , target :: mesh real(kind=WP), allocatable :: aux(:), laux(:) - integer :: i, lev, size1, size2, shape - integer :: c + integer :: i, lev, size1, size2, size_gen, size_lev, shape + integer :: c, order #include "associate_mesh.h" @@ -459,17 +484,32 @@ subroutine write_restart(id, istep, mesh) elseif (shape==2) then size1=id%var(i)%dims(1) size2=id%var(i)%dims(2) - if (mype==0) allocate(aux (size2)) - if (size2==nod2D) allocate(laux(myDim_nod2D +eDim_nod2D )) - if (size2==elem2D) allocate(laux(myDim_elem2D+eDim_elem2D)) - do lev=1, size1 - laux=id%var(i)%pt2(lev,:) -! if (size1==nod2D .or. size2==nod2D) call gather_nod (id%var(i)%pt2(lev,:), aux) -! if (size1==elem2D .or. size2==elem2D) call gather_elem(id%var(i)%pt2(lev,:), aux) - if (size1==nod2D .or. size2==nod2D) call gather_nod (laux, aux) - if (size1==elem2D .or. size2==elem2D) call gather_elem(laux, aux) + ! I assume that the model has always more surface nodes or elements than + ! vertical layers => more flexibility in terms of array dimensions + if (size1==nod2D .or. size1==elem2D) then + size_gen=size1 + size_lev=size2 + order=1 + else if (size2==nod2D .or. size2==elem2D) then + size_gen=size2 + size_lev=size1 + order=2 + else + if (mype==0) write(*,*) 'the shape of the array in the restart file and the grid size are different' + call par_ex + stop + end if + if (mype==0) allocate(aux (size_gen)) + if (size_gen==nod2D) allocate(laux(myDim_nod2D +eDim_nod2D )) + if (size_gen==elem2D) allocate(laux(myDim_elem2D+eDim_elem2D)) + do lev=1, size_lev + if (order==1) laux=id%var(i)%pt2(:,lev) + if (order==2) laux=id%var(i)%pt2(lev,:) + if (size_gen==nod2D) call gather_nod (laux, aux) + if (size_gen==elem2D) call gather_elem(laux, aux) if (mype==0) then - id%error_status(c)=nf_put_vara_double(id%ncid, id%var(i)%code, (/lev, 1, id%rec_count/), (/1, size2, 1/), aux, 1); c=c+1 + if (order==1) id%error_status(c)=nf_put_vara_double(id%ncid, id%var(i)%code, (/1, lev, id%rec_count/), (/size_gen, 1, 1/), aux, 1); c=c+1 + if (order==2) id%error_status(c)=nf_put_vara_double(id%ncid, id%var(i)%code, (/lev, 1, id%rec_count/), (/1, size_gen, 1/), aux, 1); c=c+1 end if end do deallocate(laux) @@ -480,6 +520,7 @@ subroutine write_restart(id, istep, mesh) stop end if call was_error(id); c=1 + if (mype == 0) write(*,*) id%var(id%nvar)%name, 'went well' end do if (mype==0) id%error_count=c-1 @@ -496,8 +537,8 @@ subroutine read_restart(id, mesh, arg) type(nc_file), intent(inout) :: id integer, optional, intent(in) :: arg real(kind=WP), allocatable :: aux(:), laux(:) - integer :: i, lev, size1, size2, shape - integer :: rec2read, c + integer :: i, lev, size1, size2, size_gen, size_lev, shape + integer :: rec2read, c, order real(kind=WP) :: rtime !timestamp of the record logical :: file_exist=.False. type(t_mesh), intent(in) , target :: mesh @@ -561,24 +602,39 @@ subroutine read_restart(id, mesh, arg) elseif (shape==2) then size1=id%var(i)%dims(1) size2=id%var(i)%dims(2) - if (mype==0) allocate(aux (size2)) - if (size2==nod2D) allocate(laux(myDim_nod2D +eDim_nod2D )) - if (size2==elem2D) allocate(laux(myDim_elem2D+eDim_elem2D)) - do lev=1, size1 + ! I assume that the model has always more surface nodes or elements than + ! vertical layers => more flexibility in terms of array dimensions + if (size1==nod2D .or. size1==elem2D) then + size_gen=size1 + size_lev=size2 + order=1 + else if (size2==nod2D .or. size2==elem2D) then + size_gen=size2 + size_lev=size1 + order=2 + else + if (mype==0) write(*,*) 'the shape of the array in the restart file and the grid size are different' + call par_ex + stop + end if + if (mype==0) allocate(aux (size_gen)) + if (size_gen==nod2D) allocate(laux(myDim_nod2D +eDim_nod2D )) + if (size_gen==elem2D) allocate(laux(myDim_elem2D+eDim_elem2D)) + do lev=1, size_lev if (mype==0) then - id%error_status(c)=nf_get_vara_double(id%ncid, id%var(i)%code, (/lev, 1, id%rec_count/), (/1, size2, 1/), aux, 1); c=c+1 -! write(*,*) 'min/max 3D ', lev,'=', minval(aux), maxval(aux) + if (order==1) id%error_status(c)=nf_get_vara_double(id%ncid, id%var(i)%code, (/1, lev, id%rec_count/), (/size_gen, 1, 1/), aux, 1); c=c+1 + if (order==2) id%error_status(c)=nf_get_vara_double(id%ncid, id%var(i)%code, (/lev, 1, id%rec_count/), (/1, size_gen, 1/), aux, 1); c=c+1 end if id%var(i)%pt2(lev,:)=0. -! if (size1==nod2D .or. size2==nod2D) call broadcast_nod (id%var(i)%pt2(lev,:), aux) -! if (size1==elem2D .or. size2==elem2D) call broadcast_elem(id%var(i)%pt2(lev,:), aux) - if (size2==nod2D) then + if (size_gen==nod2D) then call broadcast_nod (laux, aux) - id%var(i)%pt2(lev,:)=laux(1:myDim_nod2D+eDim_nod2D) + if (order==1) id%var(i)%pt2(:,lev)=laux(1:myDim_nod2D+eDim_nod2D) + if (order==2) id%var(i)%pt2(lev,:)=laux(1:myDim_nod2D+eDim_nod2D) end if - if (size2==elem2D) then + if (size_gen==elem2D) then call broadcast_elem(laux, aux) - id%var(i)%pt2(lev,:)=laux(1:myDim_elem2D+eDim_elem2D) + if (order==1) id%var(i)%pt2(:,lev)=laux(1:myDim_elem2D+eDim_elem2D) + if (order==2) id%var(i)%pt2(lev,:)=laux(1:myDim_elem2D+eDim_elem2D) end if end do deallocate(laux) From 1738b5ab01fed79f51bf2ff2897ea92b27ceedb9 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 5 Jun 2020 13:59:19 +0200 Subject: [PATCH 27/54] Restart working - suboptimal code --- src/fvom_main.F90 | 22 ++-- src/icepack_drivers/icedrv_io.F90 | 170 ------------------------ src/icepack_drivers/icedrv_main.F90 | 12 +- src/io_restart.F90 | 196 +++++++++++++++++++++++++++- 4 files changed, 206 insertions(+), 194 deletions(-) diff --git a/src/fvom_main.F90 b/src/fvom_main.F90 index 76a3e3573..4352345ce 100755 --- a/src/fvom_main.F90 +++ b/src/fvom_main.F90 @@ -101,6 +101,17 @@ program main call cpl_oasis3mct_define_unstr(mesh) if(mype==0) write(*,*) 'FESOM ----> cpl_oasis3mct_define_unstr nsend, nrecv:',nsend, nrecv #endif + +#if defined (__icepack) + !===================== + ! Setup icepack + !===================== + if (mype==0) write(*,*) 'Icepack: reading namelists from namelist.icepack' + call set_icepack + call alloc_icepack + call init_icepack(mesh) + if (mype==0) write(*,*) 'Icepack: setup complete' +#endif call clock_newyear ! check if it is a new year if (mype==0) t6=MPI_Wtime() @@ -172,17 +183,6 @@ program main call foreph_ini(yearnew, month) end if -#if defined (__icepack) - !===================== - ! Setup icepack - !===================== - if (mype==0) write(*,*) 'Icepack: reading namelists from namelist.icepack' - call set_icepack - call alloc_icepack - call init_icepack(mesh) - if (mype==0) write(*,*) 'Icepack: setup complete' -#endif - do n=1, nsteps if (use_global_tides) then call foreph(mesh) diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index a7f5df23f..92d105d66 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -194,174 +194,4 @@ module subroutine init_io_icepack(mesh) end subroutine init_io_icepack - ! - !-------------------------------------------------------------------------------------------- - ! - - module subroutine init_restart_icepack(year, mesh) - - use mod_mesh - use g_parsup - use g_config, only: runid, ResultPath - use io_restart, only: ip_id, def_variable_2d, def_dim - - implicit none - - type(t_mesh), target, intent(in) :: mesh - - integer, intent(in) :: year - integer (kind=int_kind) :: ncid - integer (kind=int_kind) :: i, j, k, iblk, & ! counting indices - nt_Tsfc, nt_sice, nt_qice, nt_qsno, & - nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, & - nt_vlvl, nt_iage, nt_FY, nt_aero, & - ktherm, nt_fbri - integer (kind=int_kind) :: varid - character(500) :: longname - character(500) :: filename - character(500) :: trname, units - character(4) :: cyear - - logical (kind=log_kind) :: & - solve_zsal, skl_bgc, z_tracers, & - tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine, & - tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & - tr_bgc_Sil, tr_bgc_DMS, & - tr_bgc_chl, tr_bgc_Am, & - tr_bgc_PON, tr_bgc_DON, & - tr_zaero, tr_bgc_Fe, & - tr_bgc_hum - -#include "../associate_mesh.h" - - ! Get the tracers information from icepack - 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_indices( & - nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & - nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & - nt_iage_out=nt_iage, nt_FY_out=nt_FY, & - nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & - nt_aero_out=nt_aero, nt_qsno_out=nt_qsno) - call icepack_query_parameters(solve_zsal_out=solve_zsal, & - skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, ktherm_out=ktherm) - call icepack_query_tracer_flags( & - tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & - tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & - tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, & - tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Sil_out=tr_bgc_Sil, & - tr_bgc_DMS_out=tr_bgc_DMS, & - tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & - tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & - tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & - tr_bgc_hum_out=tr_bgc_hum) - call icepack_warnings_flush(nu_diag) - ! The following error message needs to be fixed - !if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - ! file=__FILE__, line=__LINE__) - - write(cyear,'(i4)') year - ! Create an icepack restart file - ! Only serial output implemented so far - ip_id%filename=trim(ResultPath)//trim(runid)//'.'//cyear//'.icepack.restart.nc' - if (ip_id%is_in_use) return - ip_id%is_in_use=.true. - - ! Define the dimensions of the netCDF file - ! - ! Note that at the moment FESOM2 supports only 3D output and restart (very - ! suboptimal). The different ice layers are thus splitted in different arrays - ! and - ! reconstructed after the restart. Multidimensional variables would solve - ! this. - - call def_dim(ip_id, 'node', nod2D) ! Number of nodes - call def_dim(ip_id, 'ncat', ncat) ! Number of thickness classes - - ! Define the netCDF variables for surface - ! and vertically constant fields - - !----------------------------------------------------------------- - ! 3D restart fields (ncat) - !----------------------------------------------------------------- - - call def_variable_2d(ip_id, 'aicen', (/nod2D, ncat/), 'sea ice concentration', 'none', aicen(:,:)); - call def_variable_2d(ip_id, 'vicen', (/nod2D, ncat/), 'volum per unit area of ice', 'm', vicen(:,:)); - call def_variable_2d(ip_id, 'vsnon', (/nod2D, ncat/), 'volum per unit area of snow', 'm', vsnon(:,:)); - call def_variable_2d(ip_id, 'Tsfc', (/nod2D, ncat/), 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:)); - - if (tr_iage) then - call def_variable_2d(ip_id, 'iage', (/nod2D, ncat/), 'sea ice age', 's', trcrn(:,nt_iage,:)); - end if - - if (tr_FY) then - call def_variable_2d(ip_id, 'FY', (/nod2D, ncat/), 'first year ice', 'none', trcrn(:,nt_FY,:)); - end if - - if (tr_lvl) then - call def_variable_2d(ip_id, 'alvl', (/nod2D, ncat/), 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:)); - call def_variable_2d(ip_id, 'vlvl', (/nod2D, ncat/), 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:)); - end if - - if (tr_pond_cesm) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); - end if - - if (tr_pond_topo) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); - call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); - end if - - if (tr_pond_lvl) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); - call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); - call def_variable_2d(ip_id, 'ffracn', (/nod2D, ncat/), 'fraction of fsurfn over pond used to melt ipond', 'none', ffracn); - call def_variable_2d(ip_id, 'dhsn', (/nod2D, ncat/), 'depth difference for snow on sea ice and pond ice', 'm', dhsn); - end if - - if (tr_brine) then - call def_variable_2d(ip_id, 'fbri', (/nod2D, ncat/), 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:)); - call def_variable_2d(ip_id, 'first_ice', (/nod2D, ncat/), 'distinguishes ice that disappears', 'logical', first_ice_real(:,:)); - end if - - !----------------------------------------------------------------- - ! 4D restart fields, written as layers of 3D - !----------------------------------------------------------------- - - ! Ice - - do k = 1,nilyr - write(trname,'(A6,i1)') 'sicen_', k - write(longname,'(A21,i1)') 'sea ice salinity lyr:', k - units='psu' - call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_sice+k-1,:)); - write(trname,'(A6,i1)') 'qicen_', k - write(longname,'(A21,i1)') 'sea ice enthalpy lyr:', k - units='J/m3' - call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qice+k-1,:)); - end do - - ! Snow - - do k = 1,nslyr - write(trname,'(A6,i1)') 'qsnon_', k - write(longname,'(A18,i1)') 'snow enthalpy lyr:', k - units='J/m3' - call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:)); - end do - - ! - ! All the other 4D tracers (linked to aerosols and biogeochemistry) are at the - ! moment not supported for restart. This might change if someone is interested - ! in using the biogeochemistry modules. At this stage, I do not know the model - ! enough to use these options. Lorenzo Zampieri - 16/10/2019. - ! - - end subroutine init_restart_icepack - end submodule icedrv_io diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 66a5869f9..54ccf5550 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -21,11 +21,12 @@ module icedrv_main public :: & ! Variables - ncat, & + ncat, aicen, vicen, vsnon, trcrn, ffracn, dhsn, & + first_ice_real, nilyr, nslyr, & ! Subroutines set_icepack, alloc_icepack, init_icepack, step_icepack, & icepack_to_fesom, rdg_conv_elem, rdg_shear_elem, & - init_flux_atm_ocn, init_io_icepack, init_restart_icepack + init_flux_atm_ocn, init_io_icepack !======================================================================= !--------- Everything else is private @@ -858,13 +859,6 @@ module subroutine init_io_icepack(mesh) type(t_mesh), intent(in), target :: mesh end subroutine init_io_icepack - ! Initialize restart - module subroutine init_restart_icepack(year, mesh) - implicit none - type(t_mesh), intent(in), target :: mesh - integer(kind=int_kind), intent(in) :: year - end subroutine init_restart_icepack - end interface end module icedrv_main diff --git a/src/io_restart.F90 b/src/io_restart.F90 index 3a456820e..f4e7cff58 100644 --- a/src/io_restart.F90 +++ b/src/io_restart.F90 @@ -194,10 +194,6 @@ end subroutine ini_ice_io ! subroutine restart(istep, l_write, l_read, mesh) -#if defined(__icepack) - use icedrv_main, only: init_restart_icepack -#endif - implicit none ! this is the main restart subroutine ! if l_write is TRUE writing restart file will be forced @@ -735,4 +731,196 @@ subroutine was_error(id) end if end do end subroutine was_error + +! +!-------------------------------------------------------------------------------------------- +! + +#if defined (__icepack) + + subroutine init_restart_icepack(year, mesh) + + use mod_mesh + use g_parsup + use icedrv_kinds + use icedrv_constants, only: nu_diag + use icedrv_main, only: aicen, vicen, vsnon, & + trcrn, ffracn, dhsn, & + first_ice_real, & + ncat, nilyr, nslyr + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_tracer_indices + use icepack_intfc, only: icepack_warnings_flush + use icepack_intfc, only: icepack_warnings_aborted + + implicit none + + type(t_mesh), target, intent(in) :: mesh + + integer, intent(in) :: year + integer (kind=int_kind) :: ncid + integer (kind=int_kind) :: i, j, k, iblk, & ! counting indices + nt_Tsfc, nt_sice, nt_qice, nt_qsno, & + nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, & + nt_vlvl, nt_iage, nt_FY, nt_aero, & + ktherm, nt_fbri + integer (kind=int_kind) :: varid + character(500) :: longname + character(500) :: filename + character(500) :: trname, units + character(4) :: cyear + + logical (kind=log_kind) :: & + solve_zsal, skl_bgc, z_tracers, & + tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_pond_topo, tr_pond_lvl, tr_brine, & + tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & + tr_bgc_Sil, tr_bgc_DMS, & + tr_bgc_chl, tr_bgc_Am, & + tr_bgc_PON, tr_bgc_DON, & + tr_zaero, tr_bgc_Fe, & + tr_bgc_hum + +#include "associate_mesh.h" + + ! Get the tracers information from icepack + 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_indices( & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & + nt_aero_out=nt_aero, nt_qsno_out=nt_qsno) + call icepack_query_parameters(solve_zsal_out=solve_zsal, & + skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, ktherm_out=ktherm) + call icepack_query_tracer_flags( & + tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & + tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, & + tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Sil_out=tr_bgc_Sil, & + tr_bgc_DMS_out=tr_bgc_DMS, & + tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & + tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & + tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & + tr_bgc_hum_out=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + ! The following error message needs to be fixed + !if (icepack_warnings_aborted()) call abort_ice(error_message=subname, + !& + ! file=__FILE__, line=__LINE__) + + write(cyear,'(i4)') year + ! Create an icepack restart file + ! Only serial output implemented so far + ip_id%filename=trim(ResultPath)//trim(runid)//'.'//cyear//'.icepack.restart.nc' + if (ip_id%is_in_use) return + ip_id%is_in_use=.true. + + ! Define the dimensions of the netCDF file + ! + ! Note that at the moment FESOM2 supports only 3D output and restart + ! (very + ! suboptimal). The different ice layers are thus splitted in different + ! arrays + ! and + ! reconstructed after the restart. Multidimensional variables would + ! solve + ! this. + + call def_dim(ip_id, 'node', nod2D) ! Number of nodes + call def_dim(ip_id, 'ncat', ncat) ! Number of thickness classes + + ! Define the netCDF variables for surface + ! and vertically constant fields + + !----------------------------------------------------------------- + ! 3D restart fields (ncat) + !----------------------------------------------------------------- + + call def_variable_2d(ip_id, 'aicen', (/nod2D, ncat/), 'sea ice concentration', 'none', aicen(:,:)); + call def_variable_2d(ip_id, 'vicen', (/nod2D, ncat/), 'volum per unit area of ice', 'm', vicen(:,:)); + call def_variable_2d(ip_id, 'vsnon', (/nod2D, ncat/), 'volum per unit area of snow', 'm', vsnon(:,:)); + call def_variable_2d(ip_id, 'Tsfc', (/nod2D, ncat/), 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:)); + + if (tr_iage) then + call def_variable_2d(ip_id, 'iage', (/nod2D, ncat/), 'sea ice age', 's', trcrn(:,nt_iage,:)); + end if + + if (tr_FY) then + call def_variable_2d(ip_id, 'FY', (/nod2D, ncat/), 'first year ice', 'none', trcrn(:,nt_FY,:)); + end if + + if (tr_lvl) then + call def_variable_2d(ip_id, 'alvl', (/nod2D, ncat/), 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:)); + call def_variable_2d(ip_id, 'vlvl', (/nod2D, ncat/), 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:)); + end if + + if (tr_pond_cesm) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + end if + + if (tr_pond_topo) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); + end if + + if (tr_pond_lvl) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); + call def_variable_2d(ip_id, 'ffracn', (/nod2D, ncat/), 'fraction of fsurfn over pond used to melt ipond', 'none', ffracn); + call def_variable_2d(ip_id, 'dhsn', (/nod2D, ncat/), 'depth difference for snow on sea ice and pond ice', 'm', dhsn); + end if + + if (tr_brine) then + call def_variable_2d(ip_id, 'fbri', (/nod2D, ncat/), 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:)); + call def_variable_2d(ip_id, 'first_ice', (/nod2D, ncat/), 'distinguishes ice that disappears', 'logical', first_ice_real(:,:)); + end if + + !----------------------------------------------------------------- + ! 4D restart fields, written as layers of 3D + !----------------------------------------------------------------- + + ! Ice + + do k = 1,nilyr + write(trname,'(A6,i1)') 'sicen_', k + write(longname,'(A21,i1)') 'sea ice salinity lyr:', k + units='psu' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_sice+k-1,:)); + write(trname,'(A6,i1)') 'qicen_', k + write(longname,'(A21,i1)') 'sea ice enthalpy lyr:', k + units='J/m3' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qice+k-1,:)); + end do + + ! Snow + + do k = 1,nslyr + write(trname,'(A6,i1)') 'qsnon_', k + write(longname,'(A18,i1)') 'snow enthalpy lyr:', k + units='J/m3' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:)); + end do + + ! + ! All the other 4D tracers (linked to aerosols and biogeochemistry) are + ! at the + ! moment not supported for restart. This might change if someone is + ! interested + ! in using the biogeochemistry modules. At this stage, I do not know the + ! model + ! enough to use these options. Lorenzo Zampieri - 16/10/2019. + ! + + end subroutine init_restart_icepack + +#endif + END MODULE io_RESTART From 1bd2b212dfe14908910a218178d60888935aaf19 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 5 Jun 2020 14:15:36 +0200 Subject: [PATCH 28/54] Restart working properly for icepack --- src/icepack_drivers/icedrv_io.F90 | 170 ++++++++++++++++++++++++ src/icepack_drivers/icedrv_main.F90 | 12 +- src/io_restart.F90 | 197 +--------------------------- 3 files changed, 183 insertions(+), 196 deletions(-) diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index 92d105d66..a7f5df23f 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -194,4 +194,174 @@ module subroutine init_io_icepack(mesh) end subroutine init_io_icepack + ! + !-------------------------------------------------------------------------------------------- + ! + + module subroutine init_restart_icepack(year, mesh) + + use mod_mesh + use g_parsup + use g_config, only: runid, ResultPath + use io_restart, only: ip_id, def_variable_2d, def_dim + + implicit none + + type(t_mesh), target, intent(in) :: mesh + + integer, intent(in) :: year + integer (kind=int_kind) :: ncid + integer (kind=int_kind) :: i, j, k, iblk, & ! counting indices + nt_Tsfc, nt_sice, nt_qice, nt_qsno, & + nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, & + nt_vlvl, nt_iage, nt_FY, nt_aero, & + ktherm, nt_fbri + integer (kind=int_kind) :: varid + character(500) :: longname + character(500) :: filename + character(500) :: trname, units + character(4) :: cyear + + logical (kind=log_kind) :: & + solve_zsal, skl_bgc, z_tracers, & + tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_pond_topo, tr_pond_lvl, tr_brine, & + tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & + tr_bgc_Sil, tr_bgc_DMS, & + tr_bgc_chl, tr_bgc_Am, & + tr_bgc_PON, tr_bgc_DON, & + tr_zaero, tr_bgc_Fe, & + tr_bgc_hum + +#include "../associate_mesh.h" + + ! Get the tracers information from icepack + 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_indices( & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & + nt_aero_out=nt_aero, nt_qsno_out=nt_qsno) + call icepack_query_parameters(solve_zsal_out=solve_zsal, & + skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, ktherm_out=ktherm) + call icepack_query_tracer_flags( & + tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & + tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, & + tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Sil_out=tr_bgc_Sil, & + tr_bgc_DMS_out=tr_bgc_DMS, & + tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & + tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & + tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & + tr_bgc_hum_out=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + ! The following error message needs to be fixed + !if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + ! file=__FILE__, line=__LINE__) + + write(cyear,'(i4)') year + ! Create an icepack restart file + ! Only serial output implemented so far + ip_id%filename=trim(ResultPath)//trim(runid)//'.'//cyear//'.icepack.restart.nc' + if (ip_id%is_in_use) return + ip_id%is_in_use=.true. + + ! Define the dimensions of the netCDF file + ! + ! Note that at the moment FESOM2 supports only 3D output and restart (very + ! suboptimal). The different ice layers are thus splitted in different arrays + ! and + ! reconstructed after the restart. Multidimensional variables would solve + ! this. + + call def_dim(ip_id, 'node', nod2D) ! Number of nodes + call def_dim(ip_id, 'ncat', ncat) ! Number of thickness classes + + ! Define the netCDF variables for surface + ! and vertically constant fields + + !----------------------------------------------------------------- + ! 3D restart fields (ncat) + !----------------------------------------------------------------- + + call def_variable_2d(ip_id, 'aicen', (/nod2D, ncat/), 'sea ice concentration', 'none', aicen(:,:)); + call def_variable_2d(ip_id, 'vicen', (/nod2D, ncat/), 'volum per unit area of ice', 'm', vicen(:,:)); + call def_variable_2d(ip_id, 'vsnon', (/nod2D, ncat/), 'volum per unit area of snow', 'm', vsnon(:,:)); + call def_variable_2d(ip_id, 'Tsfc', (/nod2D, ncat/), 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:)); + + if (tr_iage) then + call def_variable_2d(ip_id, 'iage', (/nod2D, ncat/), 'sea ice age', 's', trcrn(:,nt_iage,:)); + end if + + if (tr_FY) then + call def_variable_2d(ip_id, 'FY', (/nod2D, ncat/), 'first year ice', 'none', trcrn(:,nt_FY,:)); + end if + + if (tr_lvl) then + call def_variable_2d(ip_id, 'alvl', (/nod2D, ncat/), 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:)); + call def_variable_2d(ip_id, 'vlvl', (/nod2D, ncat/), 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:)); + end if + + if (tr_pond_cesm) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + end if + + if (tr_pond_topo) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); + end if + + if (tr_pond_lvl) then + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); + call def_variable_2d(ip_id, 'ffracn', (/nod2D, ncat/), 'fraction of fsurfn over pond used to melt ipond', 'none', ffracn); + call def_variable_2d(ip_id, 'dhsn', (/nod2D, ncat/), 'depth difference for snow on sea ice and pond ice', 'm', dhsn); + end if + + if (tr_brine) then + call def_variable_2d(ip_id, 'fbri', (/nod2D, ncat/), 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:)); + call def_variable_2d(ip_id, 'first_ice', (/nod2D, ncat/), 'distinguishes ice that disappears', 'logical', first_ice_real(:,:)); + end if + + !----------------------------------------------------------------- + ! 4D restart fields, written as layers of 3D + !----------------------------------------------------------------- + + ! Ice + + do k = 1,nilyr + write(trname,'(A6,i1)') 'sicen_', k + write(longname,'(A21,i1)') 'sea ice salinity lyr:', k + units='psu' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_sice+k-1,:)); + write(trname,'(A6,i1)') 'qicen_', k + write(longname,'(A21,i1)') 'sea ice enthalpy lyr:', k + units='J/m3' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qice+k-1,:)); + end do + + ! Snow + + do k = 1,nslyr + write(trname,'(A6,i1)') 'qsnon_', k + write(longname,'(A18,i1)') 'snow enthalpy lyr:', k + units='J/m3' + call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:)); + end do + + ! + ! All the other 4D tracers (linked to aerosols and biogeochemistry) are at the + ! moment not supported for restart. This might change if someone is interested + ! in using the biogeochemistry modules. At this stage, I do not know the model + ! enough to use these options. Lorenzo Zampieri - 16/10/2019. + ! + + end subroutine init_restart_icepack + end submodule icedrv_io diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 54ccf5550..66a5869f9 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -21,12 +21,11 @@ module icedrv_main public :: & ! Variables - ncat, aicen, vicen, vsnon, trcrn, ffracn, dhsn, & - first_ice_real, nilyr, nslyr, & + ncat, & ! Subroutines set_icepack, alloc_icepack, init_icepack, step_icepack, & icepack_to_fesom, rdg_conv_elem, rdg_shear_elem, & - init_flux_atm_ocn, init_io_icepack + init_flux_atm_ocn, init_io_icepack, init_restart_icepack !======================================================================= !--------- Everything else is private @@ -859,6 +858,13 @@ module subroutine init_io_icepack(mesh) type(t_mesh), intent(in), target :: mesh end subroutine init_io_icepack + ! Initialize restart + module subroutine init_restart_icepack(year, mesh) + implicit none + type(t_mesh), intent(in), target :: mesh + integer(kind=int_kind), intent(in) :: year + end subroutine init_restart_icepack + end interface end module icedrv_main diff --git a/src/io_restart.F90 b/src/io_restart.F90 index f4e7cff58..2e5e44551 100644 --- a/src/io_restart.F90 +++ b/src/io_restart.F90 @@ -194,6 +194,10 @@ end subroutine ini_ice_io ! subroutine restart(istep, l_write, l_read, mesh) +#if defined(__icepack) + use icedrv_main, only: init_restart_icepack +#endif + implicit none ! this is the main restart subroutine ! if l_write is TRUE writing restart file will be forced @@ -516,7 +520,6 @@ subroutine write_restart(id, istep, mesh) stop end if call was_error(id); c=1 - if (mype == 0) write(*,*) id%var(id%nvar)%name, 'went well' end do if (mype==0) id%error_count=c-1 @@ -731,196 +734,4 @@ subroutine was_error(id) end if end do end subroutine was_error - -! -!-------------------------------------------------------------------------------------------- -! - -#if defined (__icepack) - - subroutine init_restart_icepack(year, mesh) - - use mod_mesh - use g_parsup - use icedrv_kinds - use icedrv_constants, only: nu_diag - use icedrv_main, only: aicen, vicen, vsnon, & - trcrn, ffracn, dhsn, & - first_ice_real, & - ncat, nilyr, nslyr - use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_query_tracer_flags - use icepack_intfc, only: icepack_query_tracer_sizes - use icepack_intfc, only: icepack_query_tracer_indices - use icepack_intfc, only: icepack_warnings_flush - use icepack_intfc, only: icepack_warnings_aborted - - implicit none - - type(t_mesh), target, intent(in) :: mesh - - integer, intent(in) :: year - integer (kind=int_kind) :: ncid - integer (kind=int_kind) :: i, j, k, iblk, & ! counting indices - nt_Tsfc, nt_sice, nt_qice, nt_qsno, & - nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, & - nt_vlvl, nt_iage, nt_FY, nt_aero, & - ktherm, nt_fbri - integer (kind=int_kind) :: varid - character(500) :: longname - character(500) :: filename - character(500) :: trname, units - character(4) :: cyear - - logical (kind=log_kind) :: & - solve_zsal, skl_bgc, z_tracers, & - tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine, & - tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & - tr_bgc_Sil, tr_bgc_DMS, & - tr_bgc_chl, tr_bgc_Am, & - tr_bgc_PON, tr_bgc_DON, & - tr_zaero, tr_bgc_Fe, & - tr_bgc_hum - -#include "associate_mesh.h" - - ! Get the tracers information from icepack - 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_indices( & - nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & - nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & - nt_iage_out=nt_iage, nt_FY_out=nt_FY, & - nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & - nt_aero_out=nt_aero, nt_qsno_out=nt_qsno) - call icepack_query_parameters(solve_zsal_out=solve_zsal, & - skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, ktherm_out=ktherm) - call icepack_query_tracer_flags( & - tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & - tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & - tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, & - tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Sil_out=tr_bgc_Sil, & - tr_bgc_DMS_out=tr_bgc_DMS, & - tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & - tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & - tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & - tr_bgc_hum_out=tr_bgc_hum) - call icepack_warnings_flush(nu_diag) - ! The following error message needs to be fixed - !if (icepack_warnings_aborted()) call abort_ice(error_message=subname, - !& - ! file=__FILE__, line=__LINE__) - - write(cyear,'(i4)') year - ! Create an icepack restart file - ! Only serial output implemented so far - ip_id%filename=trim(ResultPath)//trim(runid)//'.'//cyear//'.icepack.restart.nc' - if (ip_id%is_in_use) return - ip_id%is_in_use=.true. - - ! Define the dimensions of the netCDF file - ! - ! Note that at the moment FESOM2 supports only 3D output and restart - ! (very - ! suboptimal). The different ice layers are thus splitted in different - ! arrays - ! and - ! reconstructed after the restart. Multidimensional variables would - ! solve - ! this. - - call def_dim(ip_id, 'node', nod2D) ! Number of nodes - call def_dim(ip_id, 'ncat', ncat) ! Number of thickness classes - - ! Define the netCDF variables for surface - ! and vertically constant fields - - !----------------------------------------------------------------- - ! 3D restart fields (ncat) - !----------------------------------------------------------------- - - call def_variable_2d(ip_id, 'aicen', (/nod2D, ncat/), 'sea ice concentration', 'none', aicen(:,:)); - call def_variable_2d(ip_id, 'vicen', (/nod2D, ncat/), 'volum per unit area of ice', 'm', vicen(:,:)); - call def_variable_2d(ip_id, 'vsnon', (/nod2D, ncat/), 'volum per unit area of snow', 'm', vsnon(:,:)); - call def_variable_2d(ip_id, 'Tsfc', (/nod2D, ncat/), 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:)); - - if (tr_iage) then - call def_variable_2d(ip_id, 'iage', (/nod2D, ncat/), 'sea ice age', 's', trcrn(:,nt_iage,:)); - end if - - if (tr_FY) then - call def_variable_2d(ip_id, 'FY', (/nod2D, ncat/), 'first year ice', 'none', trcrn(:,nt_FY,:)); - end if - - if (tr_lvl) then - call def_variable_2d(ip_id, 'alvl', (/nod2D, ncat/), 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:)); - call def_variable_2d(ip_id, 'vlvl', (/nod2D, ncat/), 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:)); - end if - - if (tr_pond_cesm) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); - end if - - if (tr_pond_topo) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); - call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); - end if - - if (tr_pond_lvl) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); - call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); - call def_variable_2d(ip_id, 'ffracn', (/nod2D, ncat/), 'fraction of fsurfn over pond used to melt ipond', 'none', ffracn); - call def_variable_2d(ip_id, 'dhsn', (/nod2D, ncat/), 'depth difference for snow on sea ice and pond ice', 'm', dhsn); - end if - - if (tr_brine) then - call def_variable_2d(ip_id, 'fbri', (/nod2D, ncat/), 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:)); - call def_variable_2d(ip_id, 'first_ice', (/nod2D, ncat/), 'distinguishes ice that disappears', 'logical', first_ice_real(:,:)); - end if - - !----------------------------------------------------------------- - ! 4D restart fields, written as layers of 3D - !----------------------------------------------------------------- - - ! Ice - - do k = 1,nilyr - write(trname,'(A6,i1)') 'sicen_', k - write(longname,'(A21,i1)') 'sea ice salinity lyr:', k - units='psu' - call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_sice+k-1,:)); - write(trname,'(A6,i1)') 'qicen_', k - write(longname,'(A21,i1)') 'sea ice enthalpy lyr:', k - units='J/m3' - call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qice+k-1,:)); - end do - - ! Snow - - do k = 1,nslyr - write(trname,'(A6,i1)') 'qsnon_', k - write(longname,'(A18,i1)') 'snow enthalpy lyr:', k - units='J/m3' - call def_variable_2d(ip_id, trim(trname), (/nod2D, ncat/), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:)); - end do - - ! - ! All the other 4D tracers (linked to aerosols and biogeochemistry) are - ! at the - ! moment not supported for restart. This might change if someone is - ! interested - ! in using the biogeochemistry modules. At this stage, I do not know the - ! model - ! enough to use these options. Lorenzo Zampieri - 16/10/2019. - ! - - end subroutine init_restart_icepack - -#endif - END MODULE io_RESTART From dedf81cad7f83790d95ea5b167067515198ed74a Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 5 Jun 2020 18:30:18 +0200 Subject: [PATCH 29/54] Advection seems to work properly - check better tomorrow --- src/icepack_drivers/icedrv_advection.F90 | 120 +++++++++++------------ src/icepack_drivers/icedrv_step.F90 | 4 +- 2 files changed, 62 insertions(+), 62 deletions(-) diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index 9e1172be3..77225b38a 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -47,8 +47,8 @@ subroutine tg_rhs_icepack(mesh, trc) ! Input - output - type(t_mesh), target, intent(in) :: mesh - real(kind=dbl_kind), dimension(:), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(nx), intent(inout) :: trc ! Local variables @@ -223,8 +223,8 @@ subroutine solve_low_order_icepack(mesh, trc) integer(kind=int_kind) :: row, clo, clo2, cn, location(100) real (kind=dbl_kind) :: gamma - type(t_mesh), target, intent(in) :: mesh - real(kind=dbl_kind), dimension(:), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(nx), intent(inout) :: trc #include "../associate_mesh.h" @@ -262,8 +262,8 @@ subroutine solve_high_order_icepack(mesh, trc) integer(kind=int_kind) :: n,i,clo,clo2,cn,location(100),row real (kind=dbl_kind) :: rhs_new integer(kind=int_kind), parameter :: num_iter_solve = 3 - type(t_mesh), target, intent(in) :: mesh - real(kind=dbl_kind), dimension(:), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(nx), intent(inout) :: trc #include "../associate_mesh.h" @@ -317,8 +317,8 @@ subroutine fem_fct_icepack(mesh, trc) integer(kind=int_kind) :: icoef(3,3), n, q, elem, elnodes(3), row real (kind=dbl_kind), allocatable, dimension(:) :: tmax, tmin real (kind=dbl_kind) :: vol, flux, ae, gamma - type(t_mesh), target, intent(in) :: mesh - real(kind=dbl_kind), dimension(:), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(nx), intent(inout) :: trc #include "../associate_mesh.h" @@ -470,8 +470,8 @@ subroutine tg_rhs_div_icepack(mesh, trc) real (kind=dbl_kind) :: diff, entries(3), um, vm, vol, dx(3), dy(3) integer(kind=int_kind) :: n, q, row, elem, elnodes(3) real (kind=dbl_kind) :: c_1, c_2, c_3, c_4, c_x, entries2(3) - type(t_mesh), target, intent(in) :: mesh - real(kind=dbl_kind), dimension(:), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(nx), intent(inout) :: trc #include "../associate_mesh.h" @@ -540,8 +540,8 @@ subroutine update_for_div_icepack(mesh, trc) location(100), row real (kind=dbl_kind) :: rhs_new integer(kind=int_kind), parameter :: num_iter_solve=3 - type(t_mesh), target, intent(in) :: mesh - real(kind=dbl_kind), dimension(:), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + real(kind=dbl_kind), dimension(nx), intent(inout) :: trc #include "../associate_mesh.h" @@ -587,13 +587,13 @@ subroutine fct_solve_icepack(mesh, trc) type(t_mesh), target, intent(in) :: mesh ! Driving sequence - call ice_TG_rhs_div(mesh, trc) + call tg_rhs_div_icepack(mesh, trc) call solve_high_order_icepack(mesh, trc) ! uses arrays of low-order solutions as temp ! storage. It should preceed the call of low ! order solution. call solve_low_order_icepack(mesh, trc) call fem_fct_icepack(mesh, trc) - call ice_update_for_div(mesh, trc) + call update_for_div_icepack(mesh, trc) end subroutine fct_solve_icepack @@ -655,13 +655,15 @@ module subroutine tracer_advection_icepack(mesh) if (allocated(works)) deallocate(works) allocate ( works(nx,narr) ) + + works(:,:) = c0 - call state_to_work (nx, & - ntrcr, & - narr, trcr_depend, & - aicen, trcrn, & - vicen, vsnon, & - aice0, works) + call state_to_work (nx, & + ntrcr, & + narr, trcr_depend(1:ntrcr), & + aicen(:,:), trcrn(:,1:ntrcr,:), & + vicen(:,:), vsnon(:,:), & + aice0(:), works(:,:) ) ! Advect each tracer @@ -669,25 +671,25 @@ module subroutine tracer_advection_icepack(mesh) call fct_solve_icepack ( mesh, works(:,nt) ) end do - call work_to_state (nx, & - ntrcr, & - narr, trcr_depend, & - aicen, trcrn, & - vicen, vsnon, & - aice0, works) + call work_to_state (nx, & + ntrcr, & + narr, trcr_depend(1:ntrcr), & + aicen(:,:), trcrn(:,1:ntrcr,:), & + vicen(:,:), vsnon(:,:), & + aice0(:), works(:,:) ) ! cut off icepack -! call cut_off_icepack (nx, & -! ntrcr, narr, & -! trcr_depend(:), trcr_base(:,:), & -! n_trcr_strata(:), nt_strata(:,:), & -! aicen(:,:), trcrn (:,:,:), & -! vicen(:,:), vsnon (:,:), & -! aice0(:)) + call cut_off_icepack (nx, & + ntrcr, narr, & + trcr_depend(1:ntrcr), trcr_base(1:ntrcr,:), & + n_trcr_strata(1:ntrcr), nt_strata(1:ntrcr,:), & + aicen(:,:), trcrn(:,1:ntrcr,:), & + vicen(:,:), vsnon(:,:), & + aice0(:)) do i=1,nx - if (ncat > 1) then ! Do we really need this? + if (ncat < 1) then ! Do we really need this? call cleanup_itd (dt, ntrcr, & nilyr, nslyr, & @@ -726,6 +728,8 @@ module subroutine tracer_advection_icepack(mesh) end if end do + deallocate(works) + end subroutine tracer_advection_icepack !======================================================================= @@ -802,13 +806,14 @@ subroutine work_to_state (nx, & call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) - - ! Open water fraction - + trcrn(:,:,:) = c0 aicen(:,:) = c0 vicen(:,:) = c0 vsnon(:,:) = c0 + aice0(:) = c0 + + ! Open water fraction do i = 1, nx if (works(i,1) <= puny) then @@ -840,8 +845,7 @@ subroutine work_to_state (nx, & vicen(i,n) = works(i,narrays+2) vsnon(i,n) = works(i,narrays+3) end do - - narrays = narrays + 3 + ntrcr + narrays = narrays + 3 + ntrcr end do do i = 1, nx ! For each grid cell @@ -933,17 +937,20 @@ subroutine work_to_state (nx, & narrays = narrays + ntrcr - enddo ! number of categories + enddo ! number of categories - do i = 1, nx ! For each grid cell - if (ktherm == 1) then ! For bl99 themodynamics - ! always ridefine salinity - ! after advection +! if (mype == 0) write(*,*) 'Tracer salinity: ', nt_sice, ' - ', (nt_sice + nilyr - 1) +! if (mype == 0) write(*,*) 'ktherm: ', ktherm + + if (ktherm == 1) then ! For bl99 themodynamics + ! always ridefine salinity + ! after advection + do i = 1, nx ! For each grid cell do k = 1, nilyr trcrn(i,nt_sice+k-1,:) = salinz(i,k) - end do ! nilyr - end if ! ktherm==1 - end do + end do ! nilyr + end do + end if ! ktherm==1 end subroutine work_to_state @@ -1006,13 +1013,6 @@ subroutine state_to_work (nx, & if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) - !----------------------------------------------------------------- - ! This array is used for performance (balance memory/cache vs - ! number of bound calls); a different number of arrays may perform - ! better depending on the machine used, number of processors, etc. - ! --tested on SGI R2000, using 4 pes for the ice model under MPI - !----------------------------------------------------------------- - do i = 1, nx works(i,1) = aice0(i) enddo @@ -1039,7 +1039,7 @@ subroutine state_to_work (nx, & elseif (trcr_depend(it) == 2) then do i = 1, nx if (it >= nt_qsno .and. it < nt_qsno+nslyr) then - works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) - rhos*Lfresh + works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) + rhos*Lfresh else works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) end if @@ -1197,15 +1197,15 @@ subroutine cut_off_icepack (nx, & do n = 1, ncat ! For each thickness cathegory do i = 1, nx ! For each grid point - ! Forcing quantities at current time step - T_air_C = T_air(i) + 273.15_dbl_kind ! Convert from C to K - - call icepack_init_trcr(T_air_C, Tf(i), & + call icepack_init_trcr(T_air(i), Tf(i), & salinz(i,:), Tmltz(i,:), & Tsfc, & nilyr, nslyr, & qin (:), qsn (:)) - + call icepack_warnings_flush(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + ! Correct qin profile for melting temperatures if (vicen(i,n) > small .and. aicen(i,n) > small) then diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index e6f4b4cb1..987e26c7c 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -169,7 +169,7 @@ subroutine step_therm1 (dt) enddo enddo ! i - + do i = 1, nx if (tr_aero) then ! trcrn(nt_aero) has units kg/m^3 @@ -1167,7 +1167,7 @@ module subroutine step_icepack(mesh, time_advec, time_therm) ! advect tracers !----------------------------------------------------------------- - !call tracer_advection_icepack(mesh) + call tracer_advection_icepack(mesh) !t2 = MPI_Wtime() From 60c951ebf676733d180d16bf9fc8b0a4f8922fdc Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Sun, 7 Jun 2020 00:57:15 +0200 Subject: [PATCH 30/54] Add small modification in the cut_off subroutine part of the advection submodule --- src/icepack_drivers/icedrv_advection.F90 | 29 +++++++++++++++--------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index 77225b38a..8c81b018b 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -1132,6 +1132,7 @@ subroutine cut_off_icepack (nx, & real (kind=dbl_kind), dimension(nilyr) :: & qin , & ! ice enthalpy (J/m3) + qin_max , & ! maximum ice enthalpy (J/m3) zTin ! initial ice temperature real (kind=dbl_kind), dimension(nslyr) :: & @@ -1148,12 +1149,13 @@ subroutine cut_off_icepack (nx, & real (kind=dbl_kind) :: & rhos, Lfresh, & - cp_ice, small, & + cp_ice, cp_ocn, & qrd_snow, qrd_ice, & Tsfc, exc, & depressT, Tmin, & T_air_C, hice, & - puny, Tsmelt + puny, Tsmelt, & + small, rhoi @@ -1165,15 +1167,16 @@ subroutine cut_off_icepack (nx, & character(len=*), parameter :: subname = '(cut_off_icepack)' call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl) - call icepack_query_tracer_indices( nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & - nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, & + call icepack_query_tracer_indices( nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & + nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, & nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) - call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, cp_ice_out=cp_ice) + call icepack_query_parameters(rhos_out=rhos, rhoi_out=rhoi, Lfresh_out=Lfresh, & + cp_ice_out=cp_ice, cp_ocn_out=cp_ocn) call icepack_query_parameters(depressT_out=depressT, puny_out=puny, & Tsmelt_out=Tsmelt, ktherm_out=ktherm, heat_capacity_out=heat_capacity) call icepack_warnings_flush(ice_stderr) - small = puny + small = puny Tmin = -100.0_dbl_kind if (.not. heat_capacity) then ! for 0 layer thermodynamics @@ -1207,7 +1210,11 @@ subroutine cut_off_icepack (nx, & file=__FILE__, line=__LINE__) ! Correct qin profile for melting temperatures - + + ! Maximum ice enthalpy + + qin_max(:) = rhoi * cp_ocn * (Tmltz(i,:) - puny) + if (vicen(i,n) > small .and. aicen(i,n) > small) then ! Condition on surface temperature @@ -1239,7 +1246,7 @@ subroutine cut_off_icepack (nx, & trcrn(i,nt_Tsfc,n) = Tsfc do k = 1, nilyr - trcrn(i,nt_qice+k-1,n) = min(c0, qin(k)) + trcrn(i,nt_qice+k-1,n) = min(qin_max(k), qin(k)) end do ! nilyr if (vsnon(i,n) > small) then ! Only if there is snow @@ -1278,9 +1285,9 @@ subroutine cut_off_icepack (nx, & do k = 1, nslyr trcrn(i,nt_qsno+k-1,n) = qsn(k) end do ! nslyr - do k = 1, nilyr - trcrn(i,nt_qice+k-1,n) = min(c0, qin(k)) - end do ! nilyr + !do k = 1, nilyr + ! trcrn(i,nt_qice+k-1,n) = min(qin_max(k), qin(k)) + !end do ! nilyr end if ! flag snow end if ! vsnon(i,n) > c0 From 01e91bb076ca1b39477ff08ce37b14a10b49346f Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 9 Jun 2020 15:42:43 +0200 Subject: [PATCH 31/54] model does not compile --- src/ice_EVP.F90 | 38 +++- src/ice_oce_coupling.F90 | 3 - src/ice_setup_step.F90 | 13 +- src/icepack_drivers/icedrv_advection.F90 | 269 +++++++++++++++-------- src/icepack_drivers/icedrv_io.F90 | 24 +- src/icepack_drivers/icedrv_main.F90 | 55 ++++- src/icepack_drivers/icedrv_step.F90 | 59 +++-- src/icepack_drivers/icedrv_transfer.F90 | 10 +- 8 files changed, 329 insertions(+), 142 deletions(-) diff --git a/src/ice_EVP.F90 b/src/ice_EVP.F90 index 20f9c0bb5..8b5dcea2d 100755 --- a/src/ice_EVP.F90 +++ b/src/ice_EVP.F90 @@ -119,9 +119,9 @@ subroutine stress_tensor(ice_strength, mesh) sigma11(el) = 0.5_WP*(si1+si2) sigma22(el) = 0.5_WP*(si1-si2) -#if defined (__iceapck) - rdg_conv_elem(el) = -min((eps11+eps22),0.0_WP) - rdg_shear_elem(el) = 0.5_WP*(delta - abs(eps11+eps22)) +#if defined (__icepack) + rdg_conv_elem(el) = -min((eps11(el)+eps22(el)),0.0_WP) + rdg_shear_elem(el) = 0.5_WP*(delta - abs(eps11(el)+eps22(el))) #endif endif @@ -372,7 +372,8 @@ subroutine EVPdynamics(mesh) use ice_EVP_interfaces #if defined (__icepack) -use icedrv_main, only: rdg_conv_elem, rdg_shear_elem + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem + use icedrv_main, only: icepack_to_fesom #endif IMPLICIT NONE @@ -399,6 +400,19 @@ subroutine EVPdynamics(mesh) #include "associate_mesh.h" +! If Icepack is used, always update the tracers + +#if defined (__icepack) + a_ice_old(:) = a_ice(:) + m_ice_old(:) = a_ice(:) + m_snow_old(:) = m_snow(:) + + call icepack_to_fesom (nx_in=(myDim_nod2D+eDim_nod2D), & + aice_out=a_ice, & + vice_out=m_ice, & + vsno_out=m_snow) +#endif + rdt=ice_dt/(1.0*evp_rheol_steps) ax=cos(theta_io) ay=sin(theta_io) @@ -511,13 +525,13 @@ subroutine EVPdynamics(mesh) !============================================================== ! And the ice stepping starts +#if defined (__icepack) + rdg_conv_elem(:) = 0.0_WP + rdg_shear_elem(:) = 0.0_WP +#endif + do shortstep=1, evp_rheol_steps -#if defined (__iceapck) - rdg_conv_elem = 0.0_WP |rdg_shear_elem = 0.0_WP - rdg_shear_elem = 0.0_WP -#endif - call stress_tensor(ice_strength, mesh) call stress2rhs(inv_areamass,ice_strength, mesh) @@ -563,8 +577,8 @@ subroutine EVPdynamics(mesh) call exchange_nod(U_ice,V_ice) END DO -#if defined (__icepack) -call exchange_nod(rdg_conv_elem,rdg_shear_elem) -#endif +!#if defined (__icepack) +!call exchange_elem(rdg_conv_elem,rdg_shear_elem) +!#endif end subroutine EVPdynamics diff --git a/src/ice_oce_coupling.F90 b/src/ice_oce_coupling.F90 index fd68e2190..678f096dd 100755 --- a/src/ice_oce_coupling.F90 +++ b/src/ice_oce_coupling.F90 @@ -156,9 +156,6 @@ subroutine oce_fluxes(mesh) ! #if defined (__icepack) - a_ice_old(:) = a_ice(:) - m_ice_old(:) = a_ice(:) - m_snow_old(:) = m_snow(:) call icepack_to_fesom (nx_in=(myDim_nod2D+eDim_nod2D), & aice_out=a_ice, & diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index b09ca12f6..01fcda00e 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -166,10 +166,15 @@ subroutine ice_timestep(step, mesh) REAL(kind=WP) :: t0,t1, t2, t3 #if defined (__icepack) -real(kind=WP) :: time_advec, time_therm +real(kind=WP) :: time_evp, time_advec, time_therm #endif t0=MPI_Wtime() + +#if defined (__icepack) + call step_icepack(mesh, time_evp, time_advec, time_therm) ! EVP, advection and thermodynamic parts +#else + ! ===== Dynamics if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call EVPdynamics...'//achar(27)//'[0m' SELECT CASE (whichEVP) @@ -186,9 +191,6 @@ subroutine ice_timestep(step, mesh) END SELECT t1=MPI_Wtime() -#if defined (__icepack) - call step_icepack(mesh, time_advec, time_therm) ! Advection and Thermodynamic Parts -#else ! ===== Advection part ! old FCT routines @@ -214,11 +216,12 @@ subroutine ice_timestep(step, mesh) rtime_tot = rtime_tot + (t3-t0) if(mod(step,logfile_outfreq)==0 .and. mype==0) then write(*,*) '___ICE STEP EXECUTION TIMES____________________________' - write(*,"(A, ES10.3)") ' Ice Dyn. :', t1-t0 #if defined (__icepack) + write(*,"(A, ES10.3)") ' Ice Dyn. :', time_evp write(*,"(A, ES10.3)") ' Ice Advect. :', time_advec write(*,"(A, ES10.3)") ' Ice Thermodyn. :', time_therm #else + write(*,"(A, ES10.3)") ' Ice Dyn. :', t1-t0 write(*,"(A, ES10.3)") ' Ice Advect. :', t2-t1 write(*,"(A, ES10.3)") ' Ice Thermodyn. :', t3-t2 #endif diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index 8c81b018b..5691b5703 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -741,6 +741,8 @@ subroutine work_to_state (nx, & vicen, vsnon, & aice0, works) + use icepack_intfc, only: icepack_compute_tracers + integer (kind=int_kind), intent(in) :: & nx , & ! block dimensions ntrcr , & ! number of tracers in use @@ -769,7 +771,7 @@ subroutine work_to_state (nx, & nt_alvl, nt_apnd, nt_fbri, nt_Tsfc, ktherm logical (kind=log_kind) :: & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, heat_capacity + tr_lvl, tr_pond_cesm, tr_pond_lvl, tr_pond_topo, heat_capacity integer (kind=int_kind) :: & k, i, n, it , & ! counting indices @@ -795,7 +797,8 @@ subroutine work_to_state (nx, & character(len=*), parameter :: subname = '(state_to_work)' call icepack_query_tracer_flags(tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, & + tr_lvl_out=tr_lvl) call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & nt_fbri_out=nt_fbri, nt_qsno_out=nt_qsno, & nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_Tsfc_out=nt_Tsfc) @@ -867,77 +870,103 @@ subroutine work_to_state (nx, & end do narrays = 1 - + do n=1, ncat - + narrays = narrays + 3 - - do it = 1, ntrcr - - if (trcr_depend(it) == 0) then - do i = 1, nx - if (aicen(i,n) > c0) then - if (it == nt_Tsfc) then - trcrn(i,it,n) = min(c0,works(i,narrays+it)/aicen(i,n)) - else - trcrn(i,it,n) = works(i,narrays+it) / aicen(i,n) - end if - end if - enddo - elseif (trcr_depend(it) == 1) then - do i = 1, nx - if (vicen(i,n) > c0) then - if (it >= nt_qice .and. it < nt_qice+nilyr) then - trcrn(i,it,n) = min(c0,works(i,narrays+it)/vicen(i,n)) - if (.not. heat_capacity) trcrn(i,it,n) = -rhoi * Lfresh - else if (it >= nt_sice .and. it < nt_sice+nilyr) then - trcrn(i,it,n) = max(c0,works(i,narrays+it)/vicen(i,n)) - end if - end if - enddo - elseif (trcr_depend(it) == 2) then - do i = 1, nx - if (vsnon(i,n) > c0) then - if (it >= nt_qsno .and. it < nt_qsno+nslyr) then - trcrn(i,it,n) = min(c0,works(i,narrays+it)/vsnon(i,n)) - rhos*Lfresh - if (.not. heat_capacity) trcrn(i,it,n) = -rhos * Lfresh - end if - end if - enddo - ! Tracers not yet checked or implemented - !elseif (trcr_depend(it) == 2+nt_alvl) then - ! do i = 1, nx - ! works(i,narrays+it) = aicen(i,n) & - ! * trcrn(i,nt_alvl,n) & - ! * trcrn(i,it,n) - ! enddo - !elseif (trcr_depend(it) == 2+nt_apnd .and. & - ! tr_pond_cesm .or. tr_pond_topo) then - ! do i = 1, nx - ! works(i,narrays+it) = aicen(i,n) & - ! * trcrn(i,nt_apnd,n) & - ! * trcrn(i,it,n) - ! enddo - !elseif (trcr_depend(it) == 2+nt_apnd .and. & - ! tr_pond_lvl) then - ! do i = 1, nx - ! works(i,narrays+it) = aicen(i,n) & - ! * trcrn(i,nt_alvl,n) & - ! * trcrn(i,nt_apnd,n) & - ! * trcrn(i,it,n) - ! enddo - !elseif (trcr_depend(it) == 2+nt_fbri) then - ! do i = 1, nx - ! works(i,narrays+it) = vicen(i,n) & - ! * trcrn(i,nt_fbri,n) & - ! * trcrn(i,it,n) - ! enddo - endif + + do i = 1, nx + call icepack_compute_tracers(ntrcr=ntrcr,trcr_depend=trcr_depend(:), & + atrcrn = works(i,narrays+1:narrays+ntrcr), & + aicen = aicen(i,n), & + vicen = vicen(i,n), & + vsnon = vsnon(i,n), & + trcr_base = trcr_base(:,:), & + n_trcr_strata = n_trcr_strata(:), & + nt_strata = nt_strata(:,:), & + trcrn = trcrn(i,:,n)) enddo - + narrays = narrays + ntrcr - - enddo ! number of categories + enddo + +! do n=1, ncat +! +! narrays = narrays + 3 +! +! do it = 1, ntrcr +! +! if (trcr_depend(it) == 0) then +! do i = 1, nx +! if (aicen(i,n) > c0) then +! if (it == nt_Tsfc) then +! trcrn(i,it,n) = min(c0,works(i,narrays+it)/aicen(i,n)) +! else if (it == nt_alvl .or. it == nt_apnd) then +! trcrn(i,it,n) = max(c0,min(c1,works(i,narrays+it) / aicen(i,n))) +! endif +! end if +! enddo +! elseif (trcr_depend(it) == 1) then +! do i = 1, nx +! if (vicen(i,n) > c0) then +! if (it >= nt_qice .and. it < nt_qice+nilyr) then +! trcrn(i,it,n) = min(c0,works(i,narrays+it)/vicen(i,n)) +! if (.not. heat_capacity) trcrn(i,it,n) = -rhoi * Lfresh +! else if (it >= nt_sice .and. it < nt_sice+nilyr) then +! trcrn(i,it,n) = max(c0,works(i,narrays+it)/vicen(i,n)) +! else +! trcrn(i,it,n) = max(c0,works(i,narrays+it)/vicen(i,n)) +! end if +! end if +! enddo +! elseif (trcr_depend(it) == 2) then +! do i = 1, nx +! if (vsnon(i,n) > c0) then +! if (it >= nt_qsno .and. it < nt_qsno+nslyr) then +! trcrn(i,it,n) = min(c0,works(i,narrays+it)/vsnon(i,n)) - rhos*Lfresh +! if (.not. heat_capacity) trcrn(i,it,n) = -rhos * Lfresh +! else +! trcrn(i,it,n) = min(c0,works(i,narrays+it)/vsnon(i,n)) - rhos*Lfresh +! end if +! end if +! enddo +! elseif (trcr_depend(it) == 2+nt_alvl) then +! do i = 1, nx +! if (trcrn(i,nt_alvl,n) > small) then +! trcrn(i,it,n) = max( c0, works(i,narrays+it) & +! / trcrn(i,nt_alvl,n) ) +! endif +! enddo +! elseif (trcr_depend(it) == 2+nt_apnd .and. & +! tr_pond_cesm .or. tr_pond_topo) then +! do i = 1, nx +! if (trcrn(i,nt_apnd,n) > small) then +! trcrn(i,it,n) = max( c0, works(i,narrays+it) & +! / trcrn(i,nt_apnd,n) ) +! endif +! enddo +! elseif (trcr_depend(it) == 2+nt_apnd .and. & +! tr_pond_lvl) then +! do i = 1, nx +! if (trcrn(i,nt_apnd,n) > small .and. trcrn(i,nt_alvl,n) > small) then +! trcrn(i,it,n) = max( c0, works(i,narrays+it) & +! / trcrn(i,nt_apnd,n) & +! / trcrn(i,nt_alvl,n) & +! / aicen(i,n) ) +! endif +! enddo +! elseif (trcr_depend(it) == 2+nt_fbri) then +! do i = 1, nx +! works(i,narrays+it) = vicen(i,n) & +! / trcrn(i,nt_fbri,n) & +! / trcrn(i,it,n) +! enddo +! endif +! enddo +! +! narrays = narrays + ntrcr +! +! enddo ! number of categories ! if (mype == 0) write(*,*) 'Tracer salinity: ', nt_sice, ' - ', (nt_sice + nilyr - 1) ! if (mype == 0) write(*,*) 'ktherm: ', ktherm @@ -1039,7 +1068,7 @@ subroutine state_to_work (nx, & elseif (trcr_depend(it) == 2) then do i = 1, nx if (it >= nt_qsno .and. it < nt_qsno+nslyr) then - works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) + rhos*Lfresh + works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) ! + rhos*Lfresh else works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) end if @@ -1084,7 +1113,7 @@ end subroutine state_to_work !======================================================================= - subroutine cut_off_icepack (nx, & + module subroutine cut_off_icepack (nx, & ntrcr, narr, & trcr_depend, & trcr_base, & @@ -1160,16 +1189,21 @@ subroutine cut_off_icepack (nx, & logical (kind=log_kind) :: tr_brine, tr_lvl, flag_snow, flag_cold_ice, flag_warm_ice, & + tr_pond_cesm, tr_pond_topo, tr_pond_lvl, tr_FY, tr_iage, & heat_capacity integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, nt_sice - integer (kind=int_kind) :: nt_fbri, nt_alvl, nt_vlvl + integer (kind=int_kind) :: nt_fbri, nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, nt_FY, nt_iage character(len=*), parameter :: subname = '(cut_off_icepack)' - call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl) + call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl, & + tr_pond_cesm_out=tr_pond_cesm, tr_pond_topo_out=tr_pond_topo, & + tr_pond_lvl_out=tr_pond_lvl, tr_FY_out=tr_FY, tr_iage_out=tr_iage ) call icepack_query_tracer_indices( nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & - nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, & - nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) + nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_FY_out=nt_FY, & + nt_fbri_out=nt_fbri, 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 ) call icepack_query_parameters(rhos_out=rhos, rhoi_out=rhoi, Lfresh_out=Lfresh, & cp_ice_out=cp_ice, cp_ocn_out=cp_ocn) call icepack_query_parameters(depressT_out=depressT, puny_out=puny, & @@ -1184,10 +1218,10 @@ subroutine cut_off_icepack (nx, & do i = 1, nx if (trcrn(i,nt_Tsfc,n) > Tf(i) .or. trcrn(i,nt_Tsfc,n)< Tmin) then trcrn(i,nt_Tsfc,n) = min(Tf(i), (T_air(i) + 273.15_dbl_kind)) - end if - end do - end do - end if + endif + enddo + enddo + endif if (heat_capacity) then ! only for bl99 and mushy thermodynamics @@ -1195,8 +1229,6 @@ subroutine cut_off_icepack (nx, & ! when ice is present, particularly enthalpy, surface temperature ! and salinity. - ! Test advection - do n = 1, ncat ! For each thickness cathegory do i = 1, nx ! For each grid point @@ -1213,14 +1245,14 @@ subroutine cut_off_icepack (nx, & ! Maximum ice enthalpy - qin_max(:) = rhoi * cp_ocn * (Tmltz(i,:) - puny) + qin_max(:) = rhoi * cp_ocn * (Tmltz(i,:) - 0.1_dbl_kind) if (vicen(i,n) > small .and. aicen(i,n) > small) then ! Condition on surface temperature if (trcrn(i,nt_Tsfc,n) > Tsmelt .or. trcrn(i,nt_Tsfc,n) < Tmin) then trcrn(i,nt_Tsfc,n) = Tsfc - end if + endif ! Condition on ice enthalpy @@ -1239,7 +1271,7 @@ subroutine cut_off_icepack (nx, & if (zTin(k) < Tmin ) flag_cold_ice = .true. if (zTin(k) >= Tmltz(i,k)) flag_warm_ice = .true. - end do !nilyr + enddo !nilyr if (flag_cold_ice) then @@ -1247,16 +1279,16 @@ subroutine cut_off_icepack (nx, & do k = 1, nilyr trcrn(i,nt_qice+k-1,n) = min(qin_max(k), qin(k)) - end do ! nilyr + enddo ! nilyr if (vsnon(i,n) > small) then ! Only if there is snow ! on top of the sea ice do k = 1, nslyr trcrn(i,nt_qsno+k-1,n) = qsn(k) - end do + enddo else ! No snow trcrn(i,nt_qsno:nt_qsno+nslyr-1,n) = c0 - end if + endif end if ! flag cold ice @@ -1284,12 +1316,12 @@ subroutine cut_off_icepack (nx, & trcrn(i,nt_Tsfc,n) = Tsfc do k = 1, nslyr trcrn(i,nt_qsno+k-1,n) = qsn(k) - end do ! nslyr + enddo ! nslyr !do k = 1, nilyr ! trcrn(i,nt_qice+k-1,n) = min(qin_max(k), qin(k)) !end do ! nilyr - end if ! flag snow - end if ! vsnon(i,n) > c0 + endif ! flag snow + endif ! vsnon(i,n) > c0 else @@ -1299,11 +1331,60 @@ subroutine cut_off_icepack (nx, & trcrn(i,:,n) = c0 trcrn(i,nt_Tsfc,n) = Tf(i) - end if - - end do ! nx - end do ! ncat + endif + enddo ! nx + enddo ! ncat + + ! Melt ponds and level ice cutoff + + do n = 1, ncat + do i = 1, nx + if (aicen(i,n) > c0) then + ! Sea ice age + if (tr_iage) then + if (trcrn(i,nt_iage,n) < 0.000001_dbl_kind) trcrn(i,nt_iage,n) = c0 + end if + ! First year ice fraction + if (tr_FY) then + if (trcrn(i,nt_FY,n) < 0.000001_dbl_kind) trcrn(i,nt_FY,n) = c0 + end if + ! Level ice + if (tr_lvl) then + if (trcrn(i,nt_alvl,n) > c1) then + trcrn(i,nt_alvl,n) = c1 + elseif (trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) then + trcrn(i,nt_alvl,n) = c0 + endif + if (trcrn(i,nt_vlvl,n) < puny) trcrn(i,nt_vlvl,n) = c0 + end if + ! CESM melt pond parameterization + if (tr_pond_cesm) then + if (trcrn(i,nt_alvl,n) > c1) then + trcrn(i,nt_alvl,n) = c1 + elseif (trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) then + trcrn(i,nt_alvl,n) = c0 + endif + if (trcrn(i,nt_hpnd,n) < 0.000001_dbl_kind) trcrn(i,nt_hpnd,n) = c0 + end if + ! Topo and level melt pond parameterization + if (tr_pond_topo .or. tr_pond_lvl) then + if (trcrn(i,nt_alvl,n) > c1) then + trcrn(i,nt_alvl,n) = c1 + elseif (trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) then + trcrn(i,nt_alvl,n) = c0 + endif + if (trcrn(i,nt_hpnd,n) < 0.000001_dbl_kind) trcrn(i,nt_hpnd,n) = c0 + if (trcrn(i,nt_ipnd,n) < 0.000001_dbl_kind) trcrn(i,nt_ipnd,n) = c0 + end if + ! Dynamic salt + if (tr_brine) then + if (trcrn(i,nt_fbri,n) < 0.000001_dbl_kind) trcrn(i,nt_fbri,n) = c0 + endif + endif + enddo + enddo + do i = 1, nx aice(i) = c0 vice(i) = c0 diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index a7f5df23f..2aa8b8998 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -22,7 +22,7 @@ module subroutine init_io_icepack(mesh) use mod_mesh use g_parsup - use io_meandata, only: def_stream3D + use io_meandata, only: def_stream3D, def_stream2D implicit none @@ -123,14 +123,30 @@ module subroutine init_io_icepack(mesh) do i=1, io_listsize select case (trim(io_list_icepack(i)%id)) + case ('aice0 ') + call def_stream2D(nod2D, nx_nh, 'aice0', 'open water fraction', 'none', aice0(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('aicen ') call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'aicen', 'sea ice concentration', 'none', aicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('vicen ') call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vicen', 'volume per unit area of ice', 'm', vicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('vsnon ') call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vsnon', 'volume per unit area of snow', 'm', vsnon(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('aice ') + call def_stream2D(nod2D, nx_nh, 'aice', 'sea ice concentration', 'none', aice(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('vice ') + call def_stream2D(nod2D, nx_nh, 'vice', 'volume per unit area of ice', 'm', vice(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('vsno ') + call def_stream2D(nod2D, nx_nh, 'vsno', 'volume per unit area of snow', 'm', vsno(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + ! Sea ice velocity components + case ('uvel ') + call def_stream2D(nod2D, nx_nh, 'uvel', 'x-component of ice velocity', 'm/s', uvel(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('vvel ') + call def_stream2D(nod2D, nx_nh, 'vvel', 'y-component of ice velocity', 'm/s', vvel(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + ! Sea ice or snow surface temperature case ('Tsfc ') - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'Tsfc', 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream2D(nod2D, nx_nh, 'Tsfc', 'sea ice surf. temperature', 'degC', trcr(:,nt_Tsfc), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('Tsfcn ') + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'Tsfcn', 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) ! If the following tracers are not defined they will not be outputed case ('iage ') if (tr_iage) then @@ -187,6 +203,10 @@ module subroutine init_io_icepack(mesh) units='J/m3' call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), trim(trname), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end do + case ('rdg_conv ') + call def_stream2D(nod2D, nx_nh, 'rdg_conv', 'Convergence term for ridging', '1/s', rdg_conv(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('rdg_shear ') + call def_stream2D(nod2D, nx_nh, 'rdg_shear', 'Shear term for ridging', '1/s', rdg_shear(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case default if (mype==0) write(*,*) 'stream ', io_list_icepack(i)%id, ' is not defined !' end select diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 66a5869f9..50973d5f2 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -21,10 +21,10 @@ module icedrv_main public :: & ! Variables - ncat, & + ncat, rdg_conv_elem, rdg_shear_elem, & ! Subroutines set_icepack, alloc_icepack, init_icepack, step_icepack, & - icepack_to_fesom, rdg_conv_elem, rdg_shear_elem, & + icepack_to_fesom, & init_flux_atm_ocn, init_io_icepack, init_restart_icepack !======================================================================= @@ -843,12 +843,13 @@ module subroutine init_advection_icepack(mesh) end subroutine init_advection_icepack ! Driving subroutine for column physics - module subroutine step_icepack(mesh, time_advec, time_therm) + module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) use mod_mesh implicit none real (kind=dbl_kind), intent(out) :: & time_therm, & - time_advec + time_advec, & + time_evp type(t_mesh), intent(in), target :: mesh end subroutine step_icepack @@ -865,6 +866,52 @@ module subroutine init_restart_icepack(year, mesh) integer(kind=int_kind), intent(in) :: year end subroutine init_restart_icepack + ! Cut off Icepack + module subroutine cut_off_icepack (nx, & + ntrcr, narr, & + trcr_depend, & + trcr_base, & + n_trcr_strata, & + nt_strata, & + aicen, trcrn, & + vicen, vsnon, & + aice0) + + use icepack_intfc, only: icepack_compute_tracers + use icepack_intfc, only: icepack_aggregate + use icepack_intfc, only: icepack_init_trcr + use icepack_intfc, only: icepack_sea_freezing_temperature + use icepack_therm_shared, only: calculate_Tin_from_qin + use icepack_mushy_physics, only: icepack_mushy_temperature_mush + + integer (kind=int_kind), intent (in) :: & + nx , & ! block dimensions + ntrcr , & ! number of tracers in use + narr ! number of 2D state variable arrays in works array + + integer (kind=int_kind), dimension (ntrcr), intent(in) :: & + trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon + n_trcr_strata ! number of underlying tracer layers + + real (kind=dbl_kind), dimension (ntrcr,3), intent(in) :: & + trcr_base ! = 0 or 1 depending on tracer dependency + ! argument 2: (1) aice, (2) vice, (3) vsno + + integer (kind=int_kind), dimension (ntrcr,2), intent(in) :: & + nt_strata ! indices of underlying tracer layers + + real (kind=dbl_kind), dimension (nx,ncat), intent(inout) :: & + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) + + real (kind=dbl_kind), dimension (nx,ntrcr,ncat),intent(inout) :: & + trcrn ! ice tracers + + real (kind=dbl_kind), dimension (nx), intent(out) :: & + aice0 ! concentration of open watera + end subroutine cut_off_icepack + end interface end module icedrv_main diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 987e26c7c..86ac81e50 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -552,7 +552,8 @@ subroutine step_dyn_ridge (dt, ndtd) integer (kind=int_kind) :: & i, & ! horizontal indices ntrcr, & ! - nbtrcr ! + nbtrcr, & ! + narr character(len=*), parameter :: subname='(step_dyn_ridge)' @@ -568,7 +569,8 @@ subroutine step_dyn_ridge (dt, ndtd) !----------------------------------------------------------------- ! Ridging !----------------------------------------------------------------- - + + narr = 1 + ncat * (3 + ntrcr) ! max number of state variable arrays do i = 1, nx @@ -599,8 +601,16 @@ subroutine step_dyn_ridge (dt, ndtd) aice=aice(i), fsalt=fsalt(i), & first_ice=first_ice(i,:), fzsal=fzsal(i), & flux_bio=flux_bio(i,1:nbtrcr)) - + enddo + + call cut_off_icepack (nx, & + ntrcr, narr, & + trcr_depend(1:ntrcr), trcr_base(1:ntrcr,:), & + n_trcr_strata(1:ntrcr), nt_strata(1:ntrcr,:), & + aicen(:,:), trcrn(:,1:ntrcr,:), & + vicen(:,:), vsnon(:,:), & + aice0(:)) call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & @@ -1112,7 +1122,7 @@ end subroutine coupling_prep !======================================================================= - module subroutine step_icepack(mesh, time_advec, time_therm) + module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) use g_config, only: dt use mod_mesh @@ -1132,7 +1142,8 @@ module subroutine step_icepack(mesh, time_advec, time_therm) real (kind=dbl_kind), intent(out) :: & time_therm, & - time_advec + time_advec, & + time_evp type(t_mesh), target, intent(in) :: mesh @@ -1151,26 +1162,18 @@ module subroutine step_icepack(mesh, time_advec, time_therm) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) + ! TODO: Add appropriate timing + t1 = c0 t2 = c0 t3 = c0 - !t1 = MPI_Wtime() - !----------------------------------------------------------------- ! copy variables from fesom2 (also ice velocities) !----------------------------------------------------------------- call fesom_to_icepack(mesh) - !----------------------------------------------------------------- - ! advect tracers - !----------------------------------------------------------------- - - call tracer_advection_icepack(mesh) - - !t2 = MPI_Wtime() - !----------------------------------------------------------------- ! tendencies needed by fesom !----------------------------------------------------------------- @@ -1215,7 +1218,28 @@ module subroutine step_icepack(mesh, time_advec, time_therm) do k = 1, ndtd + !----------------------------------------------------------------- + ! EVP + !----------------------------------------------------------------- + + call EVPdynamics(mesh) + + !----------------------------------------------------------------- + ! update ice velocities + !----------------------------------------------------------------- + + call fesom_to_icepack(mesh) + + !----------------------------------------------------------------- + ! advect tracers + !----------------------------------------------------------------- + + call tracer_advection_icepack(mesh) + + !----------------------------------------------------------------- ! ridging + !----------------------------------------------------------------- + call step_dyn_ridge (dt_dyn, ndtd) ! clean up, update tendency diagnostics @@ -1249,8 +1273,9 @@ module subroutine step_icepack(mesh, time_advec, time_therm) ! icepack timing !----------------------------------------------------------------- - time_advec = t2 - t1 - time_therm = t3 - t2 + time_advec = c0 + time_therm = c0 + time_evp = c0 end subroutine step_icepack diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 index 28537172c..c0fc69742 100644 --- a/src/icepack_drivers/icedrv_transfer.F90 +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -131,18 +131,18 @@ module subroutine fesom_to_icepack(mesh) ! Compute convergence and shear on the nodes - do n = 1, nx_nh + do i = 1, nx_nh tvol = c0 tx = c0 ty = c0 - do k = 1, nod_in_elem2D_num(n) - elem = nod_in_elem2D(k,n) + do k = 1, nod_in_elem2D_num(i) + elem = nod_in_elem2D(k,i) tvol = tvol + elem_area(elem) tx = tx + rdg_conv_elem(elem) * elem_area(elem) ty = ty + rdg_shear_elem(elem) * elem_area(elem) enddo - rdg_conv(n) = tx / tvol - rdg_shear(n) = ty / tvol + rdg_conv(i) = tx / tvol + rdg_shear(i) = ty / tvol enddo call exchange_nod(rdg_conv, rdg_shear) From d3020e9a7810d66f8b26d53799a83d89cf93e4e1 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 9 Jun 2020 17:34:52 +0200 Subject: [PATCH 32/54] CESM melt pond parameterization & dEdd radiation scheme work properly --- config/namelist.icepack | 34 +++-- src/icepack_drivers/icedrv_advection.F90 | 158 +++++------------------ src/icepack_drivers/icedrv_io.F90 | 104 +++++++++++---- src/icepack_drivers/icedrv_main.F90 | 41 +----- src/icepack_drivers/icedrv_step.F90 | 8 +- 5 files changed, 140 insertions(+), 205 deletions(-) diff --git a/config/namelist.icepack b/config/namelist.icepack index 468f2ef3d..76f1bb334 100755 --- a/config/namelist.icepack +++ b/config/namelist.icepack @@ -107,10 +107,25 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! &nml_list_icepack -io_list_icepack = 'aicen ',1, 'd', 4, ! Sea ice concentration - 'vicen ',1, 'd', 4, ! Volume per unit area of ice - 'vsnon ',1, 'd', 4, ! Volume per unit area of snow - 'Tsfc ',1, 'd', 4, ! Sea ice surf. temperature +io_list_icepack = 'aicen ',1, 'm', 4, ! Sea ice concentration + 'vicen ',1, 'm', 4, ! Volume per unit area of ice + 'vsnon ',1, 'm', 4, ! Volume per unit area of snow + !'Tsfcn ',1, 'm', 4, ! Sea ice surf. temperature + !'iagen ',1, 'm', 4, ! Sea ice age + !'FYn ',1, 'm', 4, ! First year ice + !'lvln ',1, 'm', 4, ! Ridged sea ice area and volume + !'pond_cesmn',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'pond_topon',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'pond_lvln ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'brinen ',1, 'm', 4, ! Volume fraction of ice with dynamic salt + !'qicen ',1, 'm', 4, ! Sea ice enthalpy + !'sicen ',1, 'm', 4, ! Sea ice salinity + !'qsnon ',1, 'm', 4, ! Snow enthalpy + ! Average over thicknes classes + !'aice ',1, 'm', 4, ! Sea ice concentration + !'vice ',1, 'm', 4, ! Volume per unit area of ice + !'vsno ',1, 'm', 4, ! Volume per unit area of snow + !'Tsfc ',1, 'm', 4, ! Sea ice surf. temperature !'iage ',1, 'm', 4, ! Sea ice age !'FY ',1, 'm', 4, ! First year ice !'lvl ',1, 'm', 4, ! Ridged sea ice area and volume @@ -118,9 +133,10 @@ io_list_icepack = 'aicen ',1, 'd', 4, ! Sea ice concentration !'pond_topo ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness !'pond_lvl ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness !'brine ',1, 'm', 4, ! Volume fraction of ice with dynamic salt - !'qicen ',1, 'm', 4, ! Sea ice enthalpy - !'sicen ',1, 'm', 4, ! Sea ice salinity - !'qsnon ',1, 'm', 4, ! Snow enthalpy - !'test_a_b ',1, 'm', 4, ! Test advection - !'test_a_a ',1, 'm', 4, ! Test advection + !'qice ',1, 'm', 4, ! Sea ice enthalpy + !'sice ',1, 'm', 4, ! Sea ice salinity + !'qsno ',1, 'm', 4, ! Snow enthalpy + ! Other variables + !'uvel ',1, 'm', 4, ! x-component of sea ice velocity + !'vvel ',1, 'm', 4, ! y-component of sea ice velocity / diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index 5691b5703..b0ca493cc 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -607,10 +607,7 @@ module subroutine tracer_advection_icepack(mesh) use g_config, only: dt implicit none - - ! NOTE: For remapping, hice and hsno are considered tracers. - ! ntrace is not equal to ntrcr! - + integer (kind=int_kind) :: ntrcr, ntrace, narr, nbtrcr, i, & nt, nt1, k integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, & @@ -658,12 +655,7 @@ module subroutine tracer_advection_icepack(mesh) works(:,:) = c0 - call state_to_work (nx, & - ntrcr, & - narr, trcr_depend(1:ntrcr), & - aicen(:,:), trcrn(:,1:ntrcr,:), & - vicen(:,:), vsnon(:,:), & - aice0(:), works(:,:) ) + call state_to_work (ntrcr, narr, works(:,:)) ! Advect each tracer @@ -671,25 +663,14 @@ module subroutine tracer_advection_icepack(mesh) call fct_solve_icepack ( mesh, works(:,nt) ) end do - call work_to_state (nx, & - ntrcr, & - narr, trcr_depend(1:ntrcr), & - aicen(:,:), trcrn(:,1:ntrcr,:), & - vicen(:,:), vsnon(:,:), & - aice0(:), works(:,:) ) + call work_to_state (ntrcr, narr, works(:,:)) ! cut off icepack - call cut_off_icepack (nx, & - ntrcr, narr, & - trcr_depend(1:ntrcr), trcr_base(1:ntrcr,:), & - n_trcr_strata(1:ntrcr), nt_strata(1:ntrcr,:), & - aicen(:,:), trcrn(:,1:ntrcr,:), & - vicen(:,:), vsnon(:,:), & - aice0(:)) + call cut_off_icepack do i=1,nx - if (ncat < 1) then ! Do we really need this? + if (ncat < 0) then ! Do we really need this? call cleanup_itd (dt, ntrcr, & nilyr, nslyr, & @@ -734,34 +715,12 @@ end subroutine tracer_advection_icepack !======================================================================= - subroutine work_to_state (nx, & - ntrcr, & - narr, trcr_depend, & - aicen, trcrn, & - vicen, vsnon, & - aice0, works) + subroutine work_to_state (ntrcr, narr, works) use icepack_intfc, only: icepack_compute_tracers - integer (kind=int_kind), intent(in) :: & - nx , & ! block dimensions - ntrcr , & ! number of tracers in use - narr ! number of 2D state variable arrays in works array - - integer (kind=int_kind), dimension (ntrcr), intent(in) :: & - trcr_depend ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - - real (kind=dbl_kind), dimension (nx,ncat), intent(out) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (nx,ntrcr,ncat), intent(out) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), dimension (nx), intent(out) :: & - aice0 ! concentration of open water - + integer (kind=int_kind), intent(in) :: ntrcr, narr + real (kind=dbl_kind), dimension(nx,narr), intent (inout) :: & works ! work array @@ -985,31 +944,9 @@ end subroutine work_to_state !======================================================================= - subroutine state_to_work (nx, & - ntrcr, & - narr, trcr_depend, & - aicen, trcrn, & - vicen, vsnon, & - aice0, works) + subroutine state_to_work (ntrcr, narr, works) - integer (kind=int_kind), intent(in) :: & - nx , & ! block dimensions - ntrcr , & ! number of tracers in use - narr ! number of 2D state variable arrays in works array - - integer (kind=int_kind), dimension (ntrcr), intent(in) :: & - trcr_depend ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - - real (kind=dbl_kind), dimension (nx,ncat), intent(in) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (nx,ntrcr,ncat), intent(in) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), dimension (nx), intent(in) :: & - aice0 ! concentration of open water + integer (kind=int_kind), intent(in) :: ntrcr, narr real (kind=dbl_kind), dimension(nx,narr), intent (out) :: & works ! work array @@ -1068,7 +1005,7 @@ subroutine state_to_work (nx, & elseif (trcr_depend(it) == 2) then do i = 1, nx if (it >= nt_qsno .and. it < nt_qsno+nslyr) then - works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) ! + rhos*Lfresh + works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) else works(i,narrays+it) = vsnon(i,n)*trcrn(i,it,n) end if @@ -1113,15 +1050,7 @@ end subroutine state_to_work !======================================================================= - module subroutine cut_off_icepack (nx, & - ntrcr, narr, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, & - aicen, trcrn, & - vicen, vsnon, & - aice0) + module subroutine cut_off_icepack use icepack_intfc, only: icepack_compute_tracers use icepack_intfc, only: icepack_aggregate @@ -1130,33 +1059,6 @@ module subroutine cut_off_icepack (nx, & use icepack_therm_shared, only: calculate_Tin_from_qin use icepack_mushy_physics, only: icepack_mushy_temperature_mush - integer (kind=int_kind), intent (in) :: & - nx , & ! block dimensions - ntrcr , & ! number of tracers in use - narr ! number of 2D state variable arrays in works array - - integer (kind=int_kind), dimension (ntrcr), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (ntrcr,3), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (ntrcr,2), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension (nx,ncat), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (nx,ntrcr,ncat),intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), dimension (nx), intent(out) :: & - aice0 ! concentration of open watera - ! local variables real (kind=dbl_kind), dimension(nilyr) :: & @@ -1171,7 +1073,8 @@ module subroutine cut_off_icepack (nx, & i, n, k, it , & ! counting indices narrays , & ! counter for number of state variable arrays icells , & ! number of ocean/ice cells - ktherm + ktherm , & + ntrcr real (kind=dbl_kind), dimension(ncat) :: & aicecat @@ -1184,7 +1087,8 @@ module subroutine cut_off_icepack (nx, & depressT, Tmin, & T_air_C, hice, & puny, Tsmelt, & - small, rhoi + small, rhoi, & + hpnd_max @@ -1196,6 +1100,7 @@ module subroutine cut_off_icepack (nx, & character(len=*), parameter :: subname = '(cut_off_icepack)' + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl, & tr_pond_cesm_out=tr_pond_cesm, tr_pond_topo_out=tr_pond_topo, & tr_pond_lvl_out=tr_pond_lvl, tr_FY_out=tr_FY, tr_iage_out=tr_iage ) @@ -1317,9 +1222,6 @@ module subroutine cut_off_icepack (nx, & do k = 1, nslyr trcrn(i,nt_qsno+k-1,n) = qsn(k) enddo ! nslyr - !do k = 1, nilyr - ! trcrn(i,nt_qice+k-1,n) = min(qin_max(k), qin(k)) - !end do ! nilyr endif ! flag snow endif ! vsnon(i,n) > c0 @@ -1341,6 +1243,7 @@ module subroutine cut_off_icepack (nx, & do n = 1, ncat do i = 1, nx if (aicen(i,n) > c0) then + hpnd_max = 0.9_dbl_kind * vicen(i,n) / aicen(i,n) ! Sea ice age if (tr_iage) then if (trcrn(i,nt_iage,n) < 0.000001_dbl_kind) trcrn(i,nt_iage,n) = c0 @@ -1356,26 +1259,27 @@ module subroutine cut_off_icepack (nx, & elseif (trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) then trcrn(i,nt_alvl,n) = c0 endif - if (trcrn(i,nt_vlvl,n) < puny) trcrn(i,nt_vlvl,n) = c0 + if (trcrn(i,nt_vlvl,n) < 0.000001_dbl_kind .or. trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) trcrn(i,nt_vlvl,n) = c0 end if ! CESM melt pond parameterization if (tr_pond_cesm) then - if (trcrn(i,nt_alvl,n) > c1) then - trcrn(i,nt_alvl,n) = c1 - elseif (trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) then - trcrn(i,nt_alvl,n) = c0 + if (trcrn(i,nt_apnd,n) > c1) then + trcrn(i,nt_apnd,n) = c1 + elseif (trcrn(i,nt_apnd,n) < 0.000001_dbl_kind) then + trcrn(i,nt_apnd,n) = c0 endif - if (trcrn(i,nt_hpnd,n) < 0.000001_dbl_kind) trcrn(i,nt_hpnd,n) = c0 + if (trcrn(i,nt_hpnd,n) < 0.000001_dbl_kind .or. trcrn(i,nt_apnd,n) < 0.000001_dbl_kind) trcrn(i,nt_hpnd,n) = c0 + if (trcrn(i,nt_hpnd,n) > hpnd_max) trcrn(i,nt_hpnd,n) = hpnd_max end if ! Topo and level melt pond parameterization if (tr_pond_topo .or. tr_pond_lvl) then - if (trcrn(i,nt_alvl,n) > c1) then - trcrn(i,nt_alvl,n) = c1 - elseif (trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) then - trcrn(i,nt_alvl,n) = c0 + if (trcrn(i,nt_apnd,n) > c1) then + trcrn(i,nt_apnd,n) = c1 + elseif (trcrn(i,nt_apnd,n) < 0.000001_dbl_kind) then + trcrn(i,nt_apnd,n) = c0 endif - if (trcrn(i,nt_hpnd,n) < 0.000001_dbl_kind) trcrn(i,nt_hpnd,n) = c0 - if (trcrn(i,nt_ipnd,n) < 0.000001_dbl_kind) trcrn(i,nt_ipnd,n) = c0 + if (trcrn(i,nt_hpnd,n) < 0.000001_dbl_kind .or. trcrn(i,nt_apnd,n) < 0.000001_dbl_kind) trcrn(i,nt_hpnd,n) = c0 + if (trcrn(i,nt_ipnd,n) < 0.000001_dbl_kind .or. trcrn(i,nt_apnd,n) < 0.000001_dbl_kind) trcrn(i,nt_ipnd,n) = c0 end if ! Dynamic salt if (tr_brine) then diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index 2aa8b8998..e3bd83183 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -145,40 +145,40 @@ module subroutine init_io_icepack(mesh) ! Sea ice or snow surface temperature case ('Tsfc ') call def_stream2D(nod2D, nx_nh, 'Tsfc', 'sea ice surf. temperature', 'degC', trcr(:,nt_Tsfc), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - case ('Tsfcn ') + case ('Tsfcn ') call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'Tsfcn', 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) ! If the following tracers are not defined they will not be outputed - case ('iage ') + case ('iagen ') if (tr_iage) then call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'iage', 'sea ice age', 's', trcrn(:,nt_iage,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end if - case ('FY ') + case ('FYn ') if (tr_FY) then call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'FY', 'first year ice', 'none', trcrn(:,nt_FY,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end if - case ('lvl ') + case ('lvln ') if (tr_lvl) then call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'alvl', 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vlvl', 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end if - case ('pond_cesm ') + case ('pond_cesmn') if (tr_pond_cesm) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt ponds area', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vpnd', 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end if - case ('pond_topo ') + case ('pond_topon') if (tr_pond_topo) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt ponds area', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vpnd', 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'ipnd', 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'ipnd', 'melt pond refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end if - case ('pond_lvl ') + case ('pond_lvln ') if (tr_pond_lvl) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt ponds area', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vpnd', 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'ipnd', 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'ipnd', 'melt pond refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end if - case ('brine ') + case ('brinen ') if (tr_brine) then call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'fbri', 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end if @@ -203,6 +203,62 @@ module subroutine init_io_icepack(mesh) units='J/m3' call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), trim(trname), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end do + ! Average over categories + case ('iage ') + if (tr_iage) then + call def_stream2D(nod2D, nx_nh, 'iage', 'sea ice age', 's', trcr(:,nt_iage), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('FY ') + if (tr_FY) then + call def_stream2D(nod2D, nx_nh, 'FY', 'first year ice', 'none', trcr(:,nt_FY), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('lvl ') + if (tr_lvl) then + call def_stream2D(nod2D, nx_nh, 'alvl', 'ridged sea ice area', 'none', trcr(:,nt_alvl), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream2D(nod2D, nx_nh, 'vlvl', 'ridged sea ice volume', 'm', trcr(:,nt_vlvl), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('pond_cesm ') + if (tr_pond_cesm) then + call def_stream2D(nod2D, nx_nh, 'apnd', 'melt pond area fraction', 'none', trcr(:,nt_apnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream2D(nod2D, nx_nh, 'hpnd', 'melt pond depth', 'm', trcr(:,nt_hpnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('pond_topo ') + if (tr_pond_topo) then + call def_stream2D(nod2D, nx_nh, 'apnd', 'melt pond area fraction', 'none', trcr(:,nt_apnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream2D(nod2D, nx_nh, 'hpnd', 'melt pond depth', 'm', trcr(:,nt_hpnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream2D(nod2D, nx_nh, 'ipnd', 'melt pond refrozen lid thickness', 'm', trcr(:,nt_ipnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('pond_lvl ') + if (tr_pond_lvl) then + call def_stream2D(nod2D, nx_nh, 'apnd', 'melt pond area fraction', 'none', trcr(:,nt_apnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream2D(nod2D, nx_nh, 'hpnd', 'melt pond depth', 'm', trcr(:,nt_hpnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream2D(nod2D, nx_nh, 'ipnd', 'melt pond refrozen lid thickness', 'm', trcr(:,nt_ipnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('brine ') + if (tr_brine) then + call def_stream2D(nod2D, nx_nh, 'fbri', 'volume fraction of ice with dynamic salt', 'none', trcr(:,nt_fbri), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end if + case ('qice ') + do k = 1,nilyr ! Separate variable for each sea ice layer + write(trname,'(A6,i1)') 'qicen_', k + write(longname,'(A22,i1)') 'sea ice enthalpy lyr: ', k + units='J/m3' + call def_stream2D(nod2D, nx_nh, trim(trname), trim(longname), trim(units), trcr(:,nt_qice+k-1), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end do + case ('sice ') + do k = 1,nilyr ! Separate variable for each sea ice layer + write(trname,'(A6,i1)') 'sicen_', k + write(longname,'(A22,i1)') 'sea ice salinity lyr: ', k + units='psu' + call def_stream2D(nod2D, nx_nh, trim(trname), trim(longname), trim(units), trcr(:,nt_sice+k-1), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end do + case ('qsno ') + do k = 1,nslyr ! Separate variable for each snow layer + write(trname,'(A6,i1)') 'qsnon_', k + write(longname,'(A19,i1)') 'snow enthalpy lyr: ', k + units='J/m3' + call def_stream2D(nod2D, nx_nh, trim(trname), trim(longname), trim(units), trcr(:,nt_qsno+k-1), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + end do case ('rdg_conv ') call def_stream2D(nod2D, nx_nh, 'rdg_conv', 'Convergence term for ridging', '1/s', rdg_conv(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('rdg_shear ') @@ -326,20 +382,20 @@ module subroutine init_restart_icepack(year, mesh) end if if (tr_pond_cesm) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'hpnd', (/nod2D, ncat/), 'melt pond depth', 'm', trcrn(:,nt_hpnd,:)); end if if (tr_pond_topo) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); - call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'hpnd', (/nod2D, ncat/), 'melt pond depth', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt pond refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); end if if (tr_pond_lvl) then - call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt ponds area', 'none', trcrn(:,nt_apnd,:)); - call def_variable_2d(ip_id, 'vpnd', (/nod2D, ncat/), 'melt ponds volume', 'm', trcrn(:,nt_hpnd,:)); - call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt ponds refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); + call def_variable_2d(ip_id, 'apnd', (/nod2D, ncat/), 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:)); + call def_variable_2d(ip_id, 'hpnd', (/nod2D, ncat/), 'melt pond depth', 'm', trcrn(:,nt_hpnd,:)); + call def_variable_2d(ip_id, 'ipnd', (/nod2D, ncat/), 'melt pond refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:)); call def_variable_2d(ip_id, 'ffracn', (/nod2D, ncat/), 'fraction of fsurfn over pond used to melt ipond', 'none', ffracn); call def_variable_2d(ip_id, 'dhsn', (/nod2D, ncat/), 'depth difference for snow on sea ice and pond ice', 'm', dhsn); end if diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 50973d5f2..76edafb4f 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -867,50 +867,15 @@ module subroutine init_restart_icepack(year, mesh) end subroutine init_restart_icepack ! Cut off Icepack - module subroutine cut_off_icepack (nx, & - ntrcr, narr, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, & - aicen, trcrn, & - vicen, vsnon, & - aice0) - + module subroutine cut_off_icepack use icepack_intfc, only: icepack_compute_tracers use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_trcr use icepack_intfc, only: icepack_sea_freezing_temperature use icepack_therm_shared, only: calculate_Tin_from_qin use icepack_mushy_physics, only: icepack_mushy_temperature_mush - - integer (kind=int_kind), intent (in) :: & - nx , & ! block dimensions - ntrcr , & ! number of tracers in use - narr ! number of 2D state variable arrays in works array - - integer (kind=int_kind), dimension (ntrcr), intent(in) :: & - trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon - n_trcr_strata ! number of underlying tracer layers - - real (kind=dbl_kind), dimension (ntrcr,3), intent(in) :: & - trcr_base ! = 0 or 1 depending on tracer dependency - ! argument 2: (1) aice, (2) vice, (3) vsno - - integer (kind=int_kind), dimension (ntrcr,2), intent(in) :: & - nt_strata ! indices of underlying tracer layers - - real (kind=dbl_kind), dimension (nx,ncat), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (nx,ntrcr,ncat),intent(inout) :: & - trcrn ! ice tracers - - real (kind=dbl_kind), dimension (nx), intent(out) :: & - aice0 ! concentration of open watera - end subroutine cut_off_icepack + implicit none + end subroutine cut_off_icepack end interface diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 86ac81e50..423eff9f4 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -604,13 +604,7 @@ subroutine step_dyn_ridge (dt, ndtd) enddo - call cut_off_icepack (nx, & - ntrcr, narr, & - trcr_depend(1:ntrcr), trcr_base(1:ntrcr,:), & - n_trcr_strata(1:ntrcr), nt_strata(1:ntrcr,:), & - aicen(:,:), trcrn(:,1:ntrcr,:), & - vicen(:,:), vsnon(:,:), & - aice0(:)) + call cut_off_icepack call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & From 685a7c759b05f875035adf1da945f6dc315175fc Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 11 Jun 2020 16:30:38 +0200 Subject: [PATCH 33/54] Some cleanup --- .gitignore | 1 + config/namelist.forcing | 0 config/namelist.forcing.era5 | 58 ++++++++++++ config/namelist.icepack.cesm.ponds | 142 +++++++++++++++++++++++++++++ config/namelist.oce.core2 | 0 config/namelist.oce.toy_soufflet | 0 result_tmp/fvom.clock | 2 - work/job_mistral | 1 + work/job_ollie | 3 +- 9 files changed, 204 insertions(+), 3 deletions(-) mode change 100644 => 100755 config/namelist.forcing create mode 100755 config/namelist.forcing.era5 create mode 100755 config/namelist.icepack.cesm.ponds mode change 100644 => 100755 config/namelist.oce.core2 mode change 100644 => 100755 config/namelist.oce.toy_soufflet delete mode 100644 result_tmp/fvom.clock diff --git a/.gitignore b/.gitignore index 550e7a2dd..ec8a81e0f 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,4 @@ *~ *.swp /Icepack +/work_* diff --git a/config/namelist.forcing b/config/namelist.forcing old mode 100644 new mode 100755 diff --git a/config/namelist.forcing.era5 b/config/namelist.forcing.era5 new file mode 100755 index 000000000..c01ed1981 --- /dev/null +++ b/config/namelist.forcing.era5 @@ -0,0 +1,58 @@ +! This is the namelist file for forcing + +&forcing_exchange_coeff +Ce_atm_oce=1.75e-3 ! exchange coeff. of latent heat over open water +Ch_atm_oce=1.75e-3 ! exchange coeff. of sensible heat over open water +Cd_atm_oce=1.0e-3 ! drag coefficient between atmosphere and water +Ce_atm_ice=1.75e-3 ! exchange coeff. of latent heat over ice +Ch_atm_ice=1.75e-3 ! exchange coeff. of sensible heat over ice +Cd_atm_ice=1.2e-3 ! drag coefficient between atmosphere and ice +Swind =0.0 ! parameterization for coupled current feedback +/ + +&forcing_bulk +AOMIP_drag_coeff=.false. +ncar_bulk_formulae=.true. +ncar_bulk_z_wind=10.0 ! height at which wind forcing is located (CORE:10m, JRA:2m) +ncar_bulk_z_tair=2.0 ! height at which temp forcing is located (CORE:10m, JRA:2m) +ncar_bulk_z_shum=2.0 ! height at which humi forcing is located (CORE:10m, JRA:2m) + +/ + +&land_ice +use_landice_water=.false. +landice_start_mon=5 +landice_end_mon=10 +/ + +&nam_sbc + nm_xwind_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/u.' ! name of file with winds, if nm_sbc=2 + nm_ywind_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/v.' ! name of file with winds, if nm_sbc=2 + nm_humi_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/q.' ! name of file with humidity + nm_qsr_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/ssrd.' ! name of file with solar heat + nm_qlw_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/strd.' ! name of file with Long wave + nm_tair_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/t2m.' ! name of file with 2m air temperature + nm_prec_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/rf.' ! name of file with total precipitation + nm_snow_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/sf.' ! name of file with snow precipitation + nm_mslp_file = '/mnt/lustre01/work/ba1138/a270099/era5/forcing/inverted/sp.' ! air_pressure_at_sea_level + nm_xwind_var = 'u' ! name of variable in file with wind + nm_ywind_var = 'v' ! name of variable in file with wind + nm_humi_var = 'q' ! name of variable in file with humidity + nm_qsr_var = 'ssrd' ! name of variable in file with solar heat + nm_qlw_var = 'strd' ! name of variable in file with Long wave + nm_tair_var = 't2m' ! name of variable in file with 2m air temperature + nm_prec_var = 'rf' ! name of variable in file with total precipitation + nm_snow_var = 'sf' ! name of variable in file with total precipitation + nm_mslp_var = 'sp' ! name of variable in file with air_pressure_at_sea_level + nm_nc_iyear = 1900 + nm_nc_imm = 1 ! initial month of time axis in netCDF + nm_nc_idd = 1 ! initial day of time axis in netCDF + nm_nc_freq = 1 ! data points per day (i.e. 86400 if the time axis is in seconds) + nm_nc_tmid = 0 ! 1 if the time stamps are given at the mid points of the netcdf file, 0 otherwise (i.e. 1 in CORE1, CORE2; 0 in JRA55) + l_xwind=.true., l_ywind=.true., l_humi=.true., l_qsr=.true., l_qlw=.true., l_tair=.true., l_prec=.true., l_mslp=.false., l_cloud=.false., l_snow=.true. + nm_runoff_file ='/pool/data/AWICM/FESOM2/FORCING/CORE2/runoff.nc' + runoff_data_source ='CORE2' !Dai09, CORE2, JRA55 + !runoff_climatology =.true. ???? + nm_sss_data_file ='/pool/data/AWICM/FESOM2/FORCING/CORE2/PHC2_salx.nc' + sss_data_source ='CORE2' +/ diff --git a/config/namelist.icepack.cesm.ponds b/config/namelist.icepack.cesm.ponds new file mode 100755 index 000000000..c5c69774d --- /dev/null +++ b/config/namelist.icepack.cesm.ponds @@ -0,0 +1,142 @@ +&env_nml ! In the original release these variables are defined in the icepack.settings + nicecat = 5 ! number of ice thickness categories + nfsdcat = 1 ! number of floe size categories + nicelyr = 4 ! number of vertical layers in the ice + nsnwlyr = 4 ! number of vertical layers in the snow + ntraero = 0 ! number of aerosol tracers (up to max_aero in ice_domain_size.F90) + trzaero = 0 ! number of z aerosol tracers (up to max_aero = 6) + tralg = 0 ! number of algal tracers (up to max_algae = 3) + trdoc = 0 ! number of dissolve organic carbon (up to max_doc = 3) + trdic = 0 ! number of dissolve inorganic carbon (up to max_dic = 1) + trdon = 0 ! number of dissolve organic nitrogen (up to max_don = 1) + trfed = 0 ! number of dissolved iron tracers (up to max_fe = 2) + trfep = 0 ! number of particulate iron tracers (up to max_fe = 2) + nbgclyr = 0 ! number of zbgc layers + trbgcz = 0 ! set to 1 for zbgc tracers (needs TRBGCS = 0 and TRBRI = 1) + trzs = 0 ! set to 1 for zsalinity tracer (needs TRBRI = 1) + trbri = 0 ! set to 1 for brine height tracer + trage = 0 ! set to 1 for ice age tracer + trfy = 0 ! set to 1 for first-year ice area tracer + trlvl = 0 ! set to 1 for level and deformed ice tracers + trpnd = 1 ! set to 1 for melt pond tracers + trbgcs = 0 ! set to 1 for skeletal layer tracers (needs TRBGCZ = 0) + ndtd = 1 ! dynamic time steps per thermodynamic time step +/ + +&grid_nml + kcatbound = 1 +/ + +&tracer_nml + tr_iage = .false. + tr_FY = .false. + tr_lvl = .false. + tr_pond_cesm = .true. + tr_pond_topo = .false. + tr_pond_lvl = .false. + tr_aero = .false. + tr_fsd = .false. +/ + +&thermo_nml + kitd = 1 + ktherm = 1 + conduct = 'bubbly' + a_rapid_mode = 0.5e-3 + Rac_rapid_mode = 10.0 + aspect_rapid_mode = 1.0 + dSdt_slow_mode = -5.0e-8 + phi_c_slow_mode = 0.05 + phi_i_mushy = 0.85 +/ + +&shortwave_nml + shortwave = 'dEdd' + albedo_type = 'ccsm3' + albicev = 0.78 + albicei = 0.36 + albsnowv = 0.98 + albsnowi = 0.70 + ahmax = 0.3 + R_ice = 0. + R_pnd = 0. + R_snw = 1.5 + dT_mlt = 1.5 + rsnw_mlt = 1500. + kalg = 0.6 +/ + +&ponds_nml + hp1 = 0.01 + hs0 = 0. + hs1 = 0.03 + dpscale = 1.e-3 + frzpnd = 'hlid' + rfracmin = 0.15 + rfracmax = 1. + pndaspect = 0.8 +/ + +&forcing_nml + formdrag = .false. + atmbndy = 'default' + calc_strair = .true. + calc_Tsfc = .true. + highfreq = .false. + natmiter = 5 + ustar_min = 0.0005 + emissivity = 0.95 + fbot_xfer_type = 'constant' + update_ocn_f = .false. + l_mpond_fresh = .false. + tfrz_option = 'linear_salt' + oceanmixed_ice = .true. + wave_spec_type = 'none' +/ + +&dynamics_nml + kstrength = 1 + krdg_partic = 1 + krdg_redist = 1 + mu_rdg = 3 + Cf = 17. +/ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!! Icepack output namelist !!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +&nml_list_icepack +io_list_icepack = 'aicen ',1, 'm', 4, ! Sea ice concentration + 'vicen ',1, 'm', 4, ! Volume per unit area of ice + 'vsnon ',1, 'm', 4, ! Volume per unit area of snow + !'Tsfcn ',1, 'm', 4, ! Sea ice surf. temperature + !'iagen ',1, 'm', 4, ! Sea ice age + !'FYn ',1, 'm', 4, ! First year ice + !'lvln ',1, 'm', 4, ! Ridged sea ice area and volume + !'pond_cesmn',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'pond_topon',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'pond_lvln ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'brinen ',1, 'm', 4, ! Volume fraction of ice with dynamic salt + !'qicen ',1, 'm', 4, ! Sea ice enthalpy + !'sicen ',1, 'm', 4, ! Sea ice salinity + !'qsnon ',1, 'm', 4, ! Snow enthalpy + ! Average over thicknes classes + !'aice ',1, 'm', 4, ! Sea ice concentration + !'vice ',1, 'm', 4, ! Volume per unit area of ice + !'vsno ',1, 'm', 4, ! Volume per unit area of snow + !'Tsfc ',1, 'm', 4, ! Sea ice surf. temperature + !'iage ',1, 'm', 4, ! Sea ice age + !'FY ',1, 'm', 4, ! First year ice + !'lvl ',1, 'm', 4, ! Ridged sea ice area and volume + !'pond_cesm ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'pond_topo ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'pond_lvl ',1, 'm', 4, ! Melt ponds area, volume and refrozen lid thickness + !'brine ',1, 'm', 4, ! Volume fraction of ice with dynamic salt + !'qice ',1, 'm', 4, ! Sea ice enthalpy + !'sice ',1, 'm', 4, ! Sea ice salinity + !'qsno ',1, 'm', 4, ! Snow enthalpy + ! Other variables + !'uvel ',1, 'm', 4, ! x-component of sea ice velocity + !'vvel ',1, 'm', 4, ! y-component of sea ice velocity +/ diff --git a/config/namelist.oce.core2 b/config/namelist.oce.core2 old mode 100644 new mode 100755 diff --git a/config/namelist.oce.toy_soufflet b/config/namelist.oce.toy_soufflet old mode 100644 new mode 100755 diff --git a/result_tmp/fvom.clock b/result_tmp/fvom.clock deleted file mode 100644 index c5ecf9124..000000000 --- a/result_tmp/fvom.clock +++ /dev/null @@ -1,2 +0,0 @@ -0 1 1948 -0 1 1948 diff --git a/work/job_mistral b/work/job_mistral index b3cfb7a06..9d2403b09 100755 --- a/work/job_mistral +++ b/work/job_mistral @@ -65,6 +65,7 @@ cp -n ../config/namelist.config . cp -n ../config/namelist.forcing . cp -n ../config/namelist.oce . cp -n ../config/namelist.ice . +cp -n ../config/namelist.icepack . date srun --mpi=pmi2 fesom.x > "fesom2.0.out" diff --git a/work/job_ollie b/work/job_ollie index a7cd062ee..ac2516115 100755 --- a/work/job_ollie +++ b/work/job_ollie @@ -20,7 +20,8 @@ cp -n ../config/namelist.config . cp -n ../config/namelist.forcing . cp -n ../config/namelist.oce . cp -n ../config/namelist.ice . -cp -n ../config/namelist.io . +cp -n ../config/namelist.io . +cp -n ../config/namelist.icepack . date srun --mpi=pmi2 ./fesom.x > "fesom2.0.out" From dfc56331fc78af0bec0cbd6aeac4c8b465ee6e44 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 12 Jun 2020 13:19:16 +0200 Subject: [PATCH 34/54] namelist.ice updated --- config/namelist.ice | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config/namelist.ice b/config/namelist.ice index 4f5d512e5..6f2bdc0b1 100755 --- a/config/namelist.ice +++ b/config/namelist.ice @@ -1,10 +1,10 @@ ! Ice namelist &ice_dyn whichEVP=0 -Pstar=30000.0 +Pstar=25000.0 delta_min=1.0e-11 evp_rheol_steps=150 -Cd_oce_ice=0.0055 +Cd_oce_ice=0.0085 ice_gamma_fct=0.5 ice_diff=0.0 theta_io=0.0 !0.436 From 8364c35ef390fd4a4077cab6d31c3bbafe9e0090 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 12 Jun 2020 14:45:49 +0200 Subject: [PATCH 35/54] Run standard icepack version --- CMakeLists.txt | 2 +- src/io_restart.F90 | 4 ---- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 122359626..95b7e7b78 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,7 +11,7 @@ set(TOPLEVEL_DIR ${CMAKE_CURRENT_LIST_DIR}) set(FESOM_COUPLED OFF CACHE BOOL "compile fesom standalone or with oasis support (i.e. coupled)") set(OIFS_COUPLED OFF CACHE BOOL "compile fesom coupled to OpenIFS. (Also needs FESOM_COUPLED to work)") set(CRAY OFF CACHE BOOL "compile with cray ftn") -set(USE_ICEPACK ON CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") +set(USE_ICEPACK OFF CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") #set(VERBOSE OFF CACHE BOOL "toggle debug output") #add_subdirectory(oasis3-mct/lib/psmile) add_subdirectory(src) diff --git a/src/io_restart.F90 b/src/io_restart.F90 index 2e5e44551..bc0e89779 100644 --- a/src/io_restart.F90 +++ b/src/io_restart.F90 @@ -55,16 +55,12 @@ MODULE io_RESTART ! id will keep the IDs of all required dimentions and variables type(nc_file), save :: oid, iid integer, save :: globalstep=0 -#if defined (__icepack) type(nc_file), save :: ip_id -#endif real(kind=WP) :: ctime !current time in seconds from the beginning of the year PRIVATE PUBLIC :: restart, oid, iid -#if defined (__icepack) PUBLIC :: ip_id, def_dim, def_variable_1d, def_variable_2d -#endif ! !-------------------------------------------------------------------------------------------- ! generic interface was required to associate variables of unknown rank with the pointers of the same rank From 5926b195be3678457f80d20dc0c0acb5799f75c6 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 12 Jun 2020 15:51:54 +0200 Subject: [PATCH 36/54] Icepack compilation --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 95b7e7b78..122359626 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,7 +11,7 @@ set(TOPLEVEL_DIR ${CMAKE_CURRENT_LIST_DIR}) set(FESOM_COUPLED OFF CACHE BOOL "compile fesom standalone or with oasis support (i.e. coupled)") set(OIFS_COUPLED OFF CACHE BOOL "compile fesom coupled to OpenIFS. (Also needs FESOM_COUPLED to work)") set(CRAY OFF CACHE BOOL "compile with cray ftn") -set(USE_ICEPACK OFF CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") +set(USE_ICEPACK ON CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") #set(VERBOSE OFF CACHE BOOL "toggle debug output") #add_subdirectory(oasis3-mct/lib/psmile) add_subdirectory(src) From 3e6c58ced337c15b5b90dd4b4ff9213c288be328 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 17 Jun 2020 10:44:10 +0200 Subject: [PATCH 37/54] Deleted 0-lyr warning --- config/namelist.forcing.ncep | 55 +++++++++++++++++++++++++++++ src/icepack_drivers/icedrv_init.F90 | 2 +- 2 files changed, 56 insertions(+), 1 deletion(-) create mode 100755 config/namelist.forcing.ncep diff --git a/config/namelist.forcing.ncep b/config/namelist.forcing.ncep new file mode 100755 index 000000000..7e7ee68ac --- /dev/null +++ b/config/namelist.forcing.ncep @@ -0,0 +1,55 @@ +/bin/bash: This: cng_exchange_coeff +Ce_atm_oce=1.75e-3 ! exchange coeff. of latent heat over open water +Ch_atm_oce=1.75e-3 ! exchange coeff. of sensible heat over open water +Cd_atm_oce=1.0e-3 ! drag coefficient between atmosphere and water +Ce_atm_ice=1.75e-3 ! exchange coeff. of latent heat over ice +Ch_atm_ice=1.75e-3 ! exchange coeff. of sensible heat over ice +Cd_atm_ice=1.2e-3 ! drag coefficient between atmosphere and ice +Swind =0.0 ! parameterization for coupled current feedback +/ + +&forcing_bulk +AOMIP_drag_coeff=.false. +ncar_bulk_formulae=.true. +ncar_bulk_z_wind=2.0 ! height at which wind forcing is located (CORE, JRA-do: 10m, JRA, NCEP:2m) +ncar_bulk_z_tair=2.0 ! height at which temp forcing is located (CORE, JRA-do: 10m, JRA, NCEP:2m) +ncar_bulk_z_shum=2.0 ! height at which humi forcing is located (CORE, JRA-do: 10m, JRA, NCEP:2m) + +/ + +&land_ice +use_landice_water=.false. +landice_start_mon=5 +landice_end_mon=10 +/ + +&nam_sbc + nm_xwind_file = '/mnt/lustre01/work/ba1138/a270099/ncep/forcing/UGRD_10maboveground.flxf06.gdas.' ! name of file with winds, if nm_sbc=2 + nm_ywind_file = '/mnt/lustre01/work/ba1138/a270099/ncep/forcing/VGRD_10maboveground.flxf06.gdas.' ! name of file with winds, if nm_sbc=2 + nm_humi_file = '/mnt/lustre01/work/ba1138/a270099/ncep/forcing/SPFH_2maboveground.flxf06.gdas.' ! name of file with 2m specific humidity + nm_qsr_file = '/mnt/lustre01/work/ba1138/a270099/ncep/forcing/DSWRF_surface.flxf06.gdas.' ! name of file with solar heat + nm_qlw_file = '/mnt/lustre01/work/ba1138/a270099/ncep/forcing/DLWRF_surface.flxf06.gdas.' ! name of file with Long wave + nm_tair_file = '/mnt/lustre01/work/ba1138/a270099/ncep/forcing/TMP_2maboveground.flxf06.gdas.' ! name of file with 2m air temperature + nm_prec_file = '/mnt/lustre01/work/ba1138/a270099/ncep/forcing/RRATE_surface.flxf06.gdas.' ! name of file with rain fall + nm_snow_file = '/mnt/lustre01/work/ba1138/a270099/ncep/forcing/SRATE_surface.flxf06.gdas.' ! name of file with snow fall + nm_mslp_file = '/work/ollie/fkauker/fesom2/cfsr/' ! air_pressure_at_sea_level + nm_xwind_var = 'UGRD_10maboveground' ! name of variable in file with wind + nm_ywind_var = 'VGRD_10maboveground' ! name of variable in file with wind + nm_humi_var = 'SPFH_2maboveground' ! name of variable in file with humidity + nm_qsr_var = 'DSWRF_surface' ! name of variable in file with solar heat + nm_qlw_var = 'DLWRF_surface' ! name of variable in file with Long wave + nm_tair_var = 'TMP_2maboveground' ! name of variable in file with 2m air temperature + nm_prec_var = 'RRATE_surface' ! name of variable in file with total precipitation + nm_snow_var = 'SRATE_surface' ! name of variable in file with total precipitation + nm_mslp_var = '' ! name of variable in file with air_pressure_at_sea_level + nm_nc_iyear = 1970 + nm_nc_imm = 1 ! initial month of time axis in netCDF + nm_nc_idd = 1 ! initial day of time axis in netCDF + nm_nc_freq = 86400 ! data points per day (i.e. 86400 if the time axis is in seconds) + nm_nc_tmid = 0 ! 1 if the time stamps are given at the mid points of the netcdf file, 0 otherwise (i.e. 1 in CORE1, CORE2; 0 in JRA55) + l_xwind=.true., l_ywind=.true., l_humi=.true., l_qsr=.true., l_qlw=.true., l_tair=.true., l_prec=.true., l_mslp=.false., l_cloud=.false., l_snow=.true. + nm_runoff_file ='/pool/data/AWICM/FESOM2/FORCING/CORE2/runoff.nc' + runoff_data_source ='CORE2' !Dai09, CORE2, JRA55 + nm_sss_data_file ='/pool/data/AWICM/FESOM2/FORCING/CORE2/PHC2_salx.nc' + sss_data_source ='CORE2' +/ diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 2a6b25dcf..2a35af7ac 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -91,7 +91,7 @@ subroutine init_state() if (.not.heat_capacity) then - write (nu_diag,*) 'WARNING - Zero-layer thermodynamics' + !write (nu_diag,*) 'WARNING - Zero-layer thermodynamics' if (nilyr > 1) then write (nu_diag,*) 'nilyr =', nilyr From 0a95e34c7fd50a7357da91c0bc45b44bcf919566 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 17 Jun 2020 13:37:46 +0200 Subject: [PATCH 38/54] Initialize model without sea ice --- src/ice_setup_step.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index 01fcda00e..9fca3ff5d 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -261,14 +261,14 @@ subroutine ice_initial_state(mesh) do i=1,myDim_nod2D+eDim_nod2D if (tr_arr(1,i,1)< 0.0_WP) then if (geo_coord_nod2D(2,i)>0._WP) then - m_ice(i) = 1.0_WP - m_snow(i)= 0.1_WP + m_ice(i) = 0.0_WP + m_snow(i)= 0.0_WP else - m_ice(i) = 2.0_WP - m_snow(i)= 0.5_WP + m_ice(i) = 0.0_WP + m_snow(i)= 0.0_WP end if - a_ice(i) = 0.9_WP + a_ice(i) = 0.0_WP u_ice(i) = 0.0_WP v_ice(i) = 0.0_WP endif From 38572f38340026d03a1913024350b5b685f5b5e0 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 17 Jun 2020 18:25:58 +0200 Subject: [PATCH 39/54] changes for level ice --- src/icepack_drivers/icedrv_advection.F90 | 7 +++++-- src/icepack_drivers/icedrv_io.F90 | 2 +- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index b0ca493cc..750ca1ae4 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -1251,15 +1251,17 @@ module subroutine cut_off_icepack ! First year ice fraction if (tr_FY) then if (trcrn(i,nt_FY,n) < 0.000001_dbl_kind) trcrn(i,nt_FY,n) = c0 + if (trcrn(i,nt_FY,n) > c1) trcrn(i,nt_FY,n) = c1 end if ! Level ice if (tr_lvl) then - if (trcrn(i,nt_alvl,n) > c1) then - trcrn(i,nt_alvl,n) = c1 + if (trcrn(i,nt_alvl,n) > aicen(i,n)) then + trcrn(i,nt_alvl,n) = aicen(i,n) elseif (trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) then trcrn(i,nt_alvl,n) = c0 endif if (trcrn(i,nt_vlvl,n) < 0.000001_dbl_kind .or. trcrn(i,nt_alvl,n) < 0.000001_dbl_kind) trcrn(i,nt_vlvl,n) = c0 + if (trcrn(i,nt_vlvl,n) > vicen(i,n)) trcrn(i,nt_vlvl,n) = vicen(i,n) end if ! CESM melt pond parameterization if (tr_pond_cesm) then @@ -1279,6 +1281,7 @@ module subroutine cut_off_icepack trcrn(i,nt_apnd,n) = c0 endif if (trcrn(i,nt_hpnd,n) < 0.000001_dbl_kind .or. trcrn(i,nt_apnd,n) < 0.000001_dbl_kind) trcrn(i,nt_hpnd,n) = c0 + if (trcrn(i,nt_hpnd,n) > hpnd_max) trcrn(i,nt_hpnd,n) = hpnd_max if (trcrn(i,nt_ipnd,n) < 0.000001_dbl_kind .or. trcrn(i,nt_apnd,n) < 0.000001_dbl_kind) trcrn(i,nt_ipnd,n) = c0 end if ! Dynamic salt diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index e3bd83183..cdb815c7c 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -232,7 +232,7 @@ module subroutine init_io_icepack(mesh) if (tr_pond_lvl) then call def_stream2D(nod2D, nx_nh, 'apnd', 'melt pond area fraction', 'none', trcr(:,nt_apnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) call def_stream2D(nod2D, nx_nh, 'hpnd', 'melt pond depth', 'm', trcr(:,nt_hpnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream2D(nod2D, nx_nh, 'ipnd', 'melt pond refrozen lid thickness', 'm', trcr(:,nt_ipnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + !call def_stream2D(nod2D, nx_nh, 'ipnd', 'melt pond refrozen lid thickness', 'm', trcr(:,nt_ipnd), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) end if case ('brine ') if (tr_brine) then From 239b99c8064e62c865d28709f840a55afb06dfde Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 9 Jul 2020 14:46:16 +0200 Subject: [PATCH 40/54] Changes before moving to ollie --- config/namelist.ice | 2 ++ config/namelist.icepack | 2 ++ src/ice_modules.F90 | 6 +++--- src/icepack_drivers/icedrv_set.F90 | 23 ++++++++++++++++++----- 4 files changed, 25 insertions(+), 8 deletions(-) diff --git a/config/namelist.ice b/config/namelist.ice index 6f2bdc0b1..350584036 100755 --- a/config/namelist.ice +++ b/config/namelist.ice @@ -9,6 +9,7 @@ ice_gamma_fct=0.5 ice_diff=0.0 theta_io=0.0 !0.436 ice_ave_steps=1 !ice step=ice_ave_steps*oce_step +c_pressure=20 / &ice_therm @@ -21,4 +22,5 @@ albsnm=0.77 albi=0.7 albim=0.68 albw=0.1 +consn=0.3 / diff --git a/config/namelist.icepack b/config/namelist.icepack index 76f1bb334..09a50e703 100755 --- a/config/namelist.icepack +++ b/config/namelist.icepack @@ -48,6 +48,7 @@ dSdt_slow_mode = -5.0e-8 phi_c_slow_mode = 0.05 phi_i_mushy = 0.85 + ksno = 0.3 / &shortwave_nml @@ -57,6 +58,7 @@ albicei = 0.36 albsnowv = 0.98 albsnowi = 0.70 + albocn = 0.1 ahmax = 0.3 R_ice = 0. R_pnd = 0. diff --git a/src/ice_modules.F90 b/src/ice_modules.F90 index a268e65a1..6e7e6b4d9 100755 --- a/src/ice_modules.F90 +++ b/src/ice_modules.F90 @@ -42,7 +42,7 @@ MODULE i_PARAM integer :: whichEVP=0 !0=standart; 1=mEVP; 2=aEVP real(kind=WP) :: ice_dt !ice step=ice_ave_steps*oce_step NAMELIST /ice_dyn/ whichEVP, Pstar, delta_min, evp_rheol_steps, Cd_oce_ice, & -ice_gamma_fct, ice_diff, theta_io,ice_ave_steps +ice_gamma_fct, ice_diff, theta_io,ice_ave_steps, c_pressure END MODULE i_PARAM ! !============================================================================= @@ -119,7 +119,7 @@ module i_therm_param REAL(kind=WP), parameter :: boltzmann=5.67E-8 ! S. Boltzmann const.*longw. emissivity REAL(kind=WP), parameter :: con = 2.1656 ! Thermal conductivities: ice; W/m/K -REAL(kind=WP), parameter :: consn = 0.31 ! snow +REAL(kind=WP) :: consn = 0.31 ! snow REAL(kind=WP) :: Sice = 4.0 ! Ice salinity 3.2--5.0 ppt. @@ -139,7 +139,7 @@ module i_therm_param REAL(kind=WP) :: albw= 0.066 ! open water, LY2004 NAMELIST /ice_therm/ Sice, h0, emiss_ice, & - emiss_wat, albsn, albsnm, albi, albim, albw + emiss_wat, albsn, albsnm, albi, albim, albw, consn end module i_therm_param diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 430276cc8..2850adb7a 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -28,6 +28,8 @@ module subroutine set_icepack() myDim_elem2D, eDim_elem2D, & mpi_comm_fesom use i_param, only: whichEVP + use i_param, only: cd_oce_ice + use i_therm_param, only: albw implicit none @@ -111,6 +113,7 @@ module subroutine set_icepack() real (kind=dbl_kind) :: albicei real (kind=dbl_kind) :: albsnowv real (kind=dbl_kind) :: albsnowi + real (kind=dbl_kind) :: albocn real (kind=dbl_kind) :: ahmax real (kind=dbl_kind) :: R_ice real (kind=dbl_kind) :: R_pnd @@ -118,6 +121,7 @@ module subroutine set_icepack() real (kind=dbl_kind) :: dT_mlt real (kind=dbl_kind) :: rsnw_mlt real (kind=dbl_kind) :: kalg + real (kind=dbl_kind) :: ksno ! ponds namelist @@ -140,6 +144,7 @@ module subroutine set_icepack() integer (kind=int_kind) :: natmiter real (kind=dbl_kind) :: ustar_min real (kind=dbl_kind) :: emissivity + real (kind=dbl_kind) :: dragio character (len=char_len) :: fbot_xfer_type logical (kind=log_kind) :: update_ocn_f logical (kind=log_kind) :: l_mpond_fresh @@ -166,14 +171,14 @@ module subroutine set_icepack() namelist / thermo_nml / & kitd, ktherm, conduct, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, & - dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy + dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy, ksno namelist / dynamics_nml / & kstrength, krdg_partic, krdg_redist, mu_rdg, & Cf namelist / shortwave_nml / & - shortwave, albedo_type, & + shortwave, albedo_type, albocn, & albicev, albicei, albsnowv, albsnowi, & ahmax, R_ice, R_pnd, R_snw, & dT_mlt, rsnw_mlt, kalg @@ -191,7 +196,7 @@ module subroutine set_icepack() update_ocn_f, l_mpond_fresh, ustar_min, & fbot_xfer_type, oceanmixed_ice, emissivity, & formdrag, highfreq, natmiter, & - tfrz_option, wave_spec_type + tfrz_option, wave_spec_type, dragio !----------------------------------------------------------------- ! env namelist - STANDARD VALUES @@ -326,7 +331,8 @@ module subroutine set_icepack() phi_i_mushy_out=phi_i_mushy, & tfrz_option_out=tfrz_option, kalg_out=kalg, & fbot_xfer_type_out=fbot_xfer_type, puny_out=puny, & - wave_spec_type_out=wave_spec_type) + wave_spec_type_out=wave_spec_type, dragio_out=dragio, & + ksno_out=ksno, albocn_out=albocn ) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -599,6 +605,7 @@ module subroutine set_icepack() write(nu_diag,1000) ' albicei = ', albicei write(nu_diag,1000) ' albsnowv = ', albsnowv write(nu_diag,1000) ' albsnowi = ', albsnowi + write(nu_diag,1000) ' albocn = ', albocn write(nu_diag,1000) ' ahmax = ', ahmax endif @@ -622,6 +629,7 @@ module subroutine set_icepack() end if write(nu_diag,1005) ' emissivity = ', emissivity + write(nu_diag,1005) ' ksno = ', ksno if (ktherm == 2) then write(nu_diag,1005) ' a_rapid_mode = ', a_rapid_mode @@ -640,6 +648,7 @@ module subroutine set_icepack() write(nu_diag,1010) ' calc_Tsfc = ', calc_Tsfc write(nu_diag,1010) ' update_ocn_f = ', update_ocn_f write(nu_diag,1010) ' wave_spec = ', wave_spec + write(nu_diag,1030) ' dragio = ', dragio if (wave_spec) then write(nu_diag,*) ' wave_spec_type = ', wave_spec_type @@ -791,6 +800,9 @@ module subroutine set_icepack() !----------------------------------------------------------------- ! set Icepack values !----------------------------------------------------------------- + + cd_oce_ice = dragio + albw = albocn call icepack_init_parameters(ustar_min_in=ustar_min, Cf_in=Cf, & albicev_in=albicev, albicei_in=albicei, & @@ -816,7 +828,8 @@ module subroutine set_icepack() phi_i_mushy_in=phi_i_mushy, & tfrz_option_in=tfrz_option, kalg_in=kalg, & fbot_xfer_type_in=fbot_xfer_type, & - wave_spec_type_in=wave_spec_type, wave_spec_in=wave_spec) + wave_spec_type_in=wave_spec_type, wave_spec_in=wave_spec, & + ksno_in=ksno, dragio_in=dragio, albocn_in=albocn) call icepack_init_tracer_sizes(ntrcr_in=ntrcr, & ncat_in=ncat, nilyr_in=nilyr, nslyr_in=nslyr, nblyr_in=nblyr, & nfsd_in=nfsd, n_aero_in=n_aero) From 383c07d7a21216a5d260f9b59ac1d07313c1e06d Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 5 Nov 2020 15:41:36 +0100 Subject: [PATCH 41/54] Commit before migration to github --- src/ice_setup_step.F90 | 2 +- src/icepack_drivers/icedrv_step.F90 | 37 ++++++++++++++++++++--------- 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index 9fca3ff5d..1417d63a6 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -172,7 +172,7 @@ subroutine ice_timestep(step, mesh) t0=MPI_Wtime() #if defined (__icepack) - call step_icepack(mesh, time_evp, time_advec, time_therm) ! EVP, advection and thermodynamic parts + call step_icepack(mesh, time_evp, time_advec, time_therm) ! EVP, advection and thermodynamic parts #else ! ===== Dynamics diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 423eff9f4..0ff1f112b 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -1119,6 +1119,7 @@ end subroutine coupling_prep module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) use g_config, only: dt + use g_parsup use mod_mesh implicit none @@ -1132,7 +1133,7 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) real (kind=dbl_kind) :: & offset, & ! d(age)/dt time offset - t1, t2, t3 + t1, t2, t3, t4 real (kind=dbl_kind), intent(out) :: & time_therm, & @@ -1142,8 +1143,15 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) type(t_mesh), target, intent(in) :: mesh character(len=*), parameter :: subname='(ice_step)' + + + t1 = c0 + t2 = c0 + t3 = c0 + t4 = c0 - + t1 = MPI_Wtime() + !----------------------------------------------------------------- ! query Icepack values !----------------------------------------------------------------- @@ -1158,10 +1166,6 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) ! TODO: Add appropriate timing - t1 = c0 - t2 = c0 - t3 = c0 - !----------------------------------------------------------------- ! copy variables from fesom2 (also ice velocities) !----------------------------------------------------------------- @@ -1216,8 +1220,13 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) ! EVP !----------------------------------------------------------------- + t2 = MPI_Wtime() + call EVPdynamics(mesh) + t3 = MPI_Wtime() + time_evp = t3 - t2 + !----------------------------------------------------------------- ! update ice velocities !----------------------------------------------------------------- @@ -1228,8 +1237,13 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) ! advect tracers !----------------------------------------------------------------- + t2 = MPI_Wtime() + call tracer_advection_icepack(mesh) + t3 = MPI_Wtime() + time_advec = t3 - t2 + !----------------------------------------------------------------- ! ridging !----------------------------------------------------------------- @@ -1260,16 +1274,17 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) dhi_dt(:) = ( vice(:) - dhi_dt(:) ) / dt dhs_dt(:) = ( vsno(:) - dhi_dt(:) ) / dt - - !t3 = MPI_Wtime() !----------------------------------------------------------------- ! icepack timing !----------------------------------------------------------------- - time_advec = c0 - time_therm = c0 - time_evp = c0 + t4 = MPI_Wtime() + time_therm = t4 - t1 - time_advec - time_evp + + !time_advec = c0 + !time_therm = c0 + !time_evp = c0 end subroutine step_icepack From 22cb8bb27f7acce9996a5917ea6458c3612558ed Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 5 Nov 2020 16:49:50 +0100 Subject: [PATCH 42/54] Now Icepack can run with m_EVP and a_EVP --- src/ice_maEVP.F90 | 47 ++++++++++++++++++++++++++++- src/icepack_drivers/icedrv_step.F90 | 14 ++++++++- 2 files changed, 59 insertions(+), 2 deletions(-) diff --git a/src/ice_maEVP.F90 b/src/ice_maEVP.F90 index 369d6637c..2fa3176de 100644 --- a/src/ice_maEVP.F90 +++ b/src/ice_maEVP.F90 @@ -42,6 +42,11 @@ subroutine stress_tensor_m(mesh) use g_config use i_arrays use g_parsup + +#if defined (__icepack) +use icedrv_main, only: rdg_conv_elem, rdg_shear_elem +#endif + implicit none integer :: elem, elnodes(3) @@ -99,6 +104,12 @@ subroutine stress_tensor_m(mesh) sigma12(elem)=det1*sigma12(elem)+det2*r3 sigma11(elem)=0.5_WP*(si1+si2) sigma22(elem)=0.5_WP*(si1-si2) + +#if defined (__icepack) + rdg_conv_elem(elem) = -min((eps11(elem)+eps22(elem)),0.0_WP) + rdg_shear_elem(elem) = 0.5_WP*(delta - abs(eps11(elem)+eps22(elem))) +#endif + end do ! Equations solved in terms of si1, si2, eps1, eps2 are (43)-(45) of ! Boullion et al Ocean Modelling 2013, but in an implicit mode: @@ -252,6 +263,10 @@ subroutine EVPdynamics_m(mesh) use g_parsup use g_comm_auto +#if defined (__icepack) + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem +#endif + implicit none integer :: steps, shortstep, i, ed,n real(kind=WP) :: rdt, drag, det @@ -379,6 +394,11 @@ subroutine EVPdynamics_m(mesh) ! Ice EVPdynamics Iteration main loop: !======================================= +#if defined (__icepack) + rdg_conv_elem(:) = 0.0_WP + rdg_shear_elem(:) = 0.0_WP +#endif + do shortstep=1, steps !NR inlining, to make it easier to have local arrays and fuse loops @@ -422,6 +442,11 @@ subroutine EVPdynamics_m(mesh) sigma11(el) = det1*sigma11(el) + 0.5_WP*pressure*(eps1 - delta + eps2*vale) sigma22(el) = det1*sigma22(el) + 0.5_WP*pressure*(eps1 - delta - eps2*vale) +#if defined (__icepack) + rdg_conv_elem(el) = -min((eps11(el)+eps22(el)),0.0_WP) + rdg_shear_elem(el) = 0.5_WP*(delta - abs(eps11(el)+eps22(el))) +#endif + ! end do ! fuse loops ! Equations solved in terms of si1, si2, eps1, eps2 are (43)-(45) of ! Boullion et al Ocean Modelling 2013, but in an implicit mode: @@ -577,6 +602,11 @@ subroutine stress_tensor_a(mesh) use g_config use i_arrays use g_parsup + +#if defined (__icepack) + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem +#endif + implicit none integer :: elem, elnodes(3) @@ -635,6 +665,12 @@ subroutine stress_tensor_a(mesh) sigma12(elem)=det1*sigma12(elem)+det2*r3 sigma11(elem)=0.5_WP*(si1+si2) sigma22(elem)=0.5_WP*(si1-si2) + +#if defined (__icepack) + rdg_conv_elem(elem) = -min((eps11(elem)+eps22(elem)),0.0_WP) + rdg_shear_elem(elem) = 0.5_WP*(delta - abs(eps11(elem)+eps22(elem))) +#endif + end do ! Equations solved in terms of si1, si2, eps1, eps2 are (43)-(45) of ! Boullion et al Ocean Modelling 2013, but in an implicit mode: @@ -660,7 +696,11 @@ subroutine EVPdynamics_a(mesh) use i_therm_param use g_parsup use g_comm_auto - use ice_maEVP_interfaces +use ice_maEVP_interfaces + +#if defined (__icepack) + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem +#endif implicit none integer :: steps, shortstep, i, ed @@ -676,6 +716,11 @@ subroutine EVPdynamics_a(mesh) u_ice_aux=u_ice ! Initialize solver variables v_ice_aux=v_ice call ssh2rhs(mesh) + +#if defined (__icepack) + rdg_conv_elem(:) = 0.0_WP + rdg_shear_elem(:) = 0.0_WP +#endif do shortstep=1, steps call stress_tensor_a(mesh) diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 0ff1f112b..d0b965f16 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -1119,6 +1119,7 @@ end subroutine coupling_prep module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) use g_config, only: dt + use i_PARAM, only: whichEVP use g_parsup use mod_mesh @@ -1222,7 +1223,18 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) t2 = MPI_Wtime() - call EVPdynamics(mesh) + select case (whichEVP) + case (0) + call EVPdynamics(mesh) + case (1) + call EVPdynamics_m(mesh) + case (2) + call EVPdynamics_a(mesh) + case default + if (mype==0) write(*,*) 'A non existing EVP scheme specified!' + call par_ex + stop + end select t3 = MPI_Wtime() time_evp = t3 - t2 From 7b99a38058b4c1ed4d1dda6082a6b9fb63788a2d Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Mon, 16 Nov 2020 12:46:21 +0100 Subject: [PATCH 43/54] Modified environment for JUWELS login node compilation --- env.sh | 2 ++ 1 file changed, 2 insertions(+) diff --git a/env.sh b/env.sh index 1eb79a97a..f568651e3 100755 --- a/env.sh +++ b/env.sh @@ -43,6 +43,8 @@ elif [[ $LOGINHOST = bsc ]]; then STRATEGY="bsc" elif [[ $LOGINHOST =~ ^juwels[0-9][0-9].ib.juwels.fzj.de$ ]]; then STRATEGY="juwels" +elif [[ $LOGINHOST =~ ^jwlogin[0-9][0-9].juwels$ ]]; then + STRATEGY="juwels" elif [[ $LOGINHOST =~ ^cc[a-b]+-login[0-9]+\.ecmwf\.int$ ]]; then STRATEGY="ecaccess.ecmwf.int" else From c87736a6d69fc94be9d39cc09d5756f33a3d2a33 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 24 Nov 2020 17:58:21 +0100 Subject: [PATCH 44/54] Asyncronous output working for Icepack variables --- src/ice_oce_coupling.F90 | 2 +- src/icepack_drivers/icedrv_io.F90 | 2 +- src/io_meandata.F90 | 76 +++++++++++++++++-------------- 3 files changed, 43 insertions(+), 37 deletions(-) diff --git a/src/ice_oce_coupling.F90 b/src/ice_oce_coupling.F90 index 678f096dd..b4bd14ebd 100755 --- a/src/ice_oce_coupling.F90 +++ b/src/ice_oce_coupling.F90 @@ -230,7 +230,7 @@ subroutine oce_fluxes(mesh) flux = flux-thdgr*rhoice*inv_rhowat-thdgrsn*rhosno*inv_rhowat end if - !call integrate_nod(flux, net, mesh) + call integrate_nod(flux, net, mesh) ! here the + sign must be used because we switched up the sign of the ! water_flux with water_flux = -fresh_wa_flux, but evap, prec_... and runoff still ! have there original sign diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index cdb815c7c..9e0209533 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -126,7 +126,7 @@ module subroutine init_io_icepack(mesh) case ('aice0 ') call def_stream2D(nod2D, nx_nh, 'aice0', 'open water fraction', 'none', aice0(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('aicen ') - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'aicen', 'sea ice concentration', 'none', aicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'aicen', 'sea ice concentration', 'none', aicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) case ('vicen ') call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vicen', 'volume per unit area of ice', 'm', vicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('vsnon ') diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 2b4bb3981..a596887bb 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -38,6 +38,7 @@ module io_MEANDATA character :: freq_unit='m' logical :: is_in_use=.false. logical :: is_elem_based = .false. + logical :: flip class(data_strategy_type), allocatable :: data_strategy integer :: comm type(thread_type) thread @@ -563,6 +564,8 @@ subroutine create_new_file(entry, mesh) call assert_nf( nf_put_att_text(entry%ncid, entry%dimvarID(1), 'long_name', len_trim('depth at layer interface'),'depth at layer interface'), __LINE__) elseif (entry%dimname(1)=='nz1') then call assert_nf( nf_put_att_text(entry%ncid, entry%dimvarID(1), 'long_name', len_trim('depth at layer midpoint'),'depth at layer midpoint'), __LINE__) + elseif (entry%dimname(1)=='ncat') then + call assert_nf( nf_put_att_text(entry%ncid, entry%dimvarID(1), 'long_name', len_trim('sea-ice thickness class'),'sea-ice thickness class'), __LINE__) else if (mype==0) write(*,*) 'WARNING: unknown first dimension in 2d mean I/O data' end if @@ -677,35 +680,23 @@ subroutine write_mean(entry, entry_index) ! !_______writing 2D and 3D fields________________________________________________ size1=entry%glsize(1) size2=entry%glsize(2) - if (size1 > size2) then - size_gen=size1 - size_lev=size2 - order=1 - else if (size1 < size2) then - size_gen=size2 - size_lev=size1 - order=2 - end if tag = 2 ! we can use a fixed tag here as we have an individual communicator for each output field !___________writing 8 byte real_________________________________________ if (entry%accuracy == i_real8) then if(mype==entry%root_rank) then - if(.not. allocated(entry%aux_r8)) allocate(entry%aux_r8(size_gen)) + if(.not. allocated(entry%aux_r8)) allocate(entry%aux_r8(size2)) end if - do lev=1, size_lev + do lev=1, size1 if(.not. entry%is_elem_based) then - if (order==2) call gather_nod2D (entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm) - if (order==1) call gather_nod2D (entry%local_values_r8_copy(1:size(entry%local_values_r8_copy,dim=1),lev), entry%aux_r8, entry%root_rank, tag, entry%comm) + call gather_nod2D (entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm) else - if (order==2) call gather_elem2D(entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm) - if (order==1) call gather_elem2D(entry%local_values_r8_copy(1:size(entry%local_values_r8_copy,dim=1),lev), entry%aux_r8, entry%root_rank, tag, entry%comm) + call gather_elem2D(entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm) end if if (mype==entry%root_rank) then if (entry%ndim==1) then call assert_nf( nf_put_vara_double(entry%ncid, entry%varID, (/1, entry%rec_count/), (/size2, 1/), entry%aux_r8, 1), __LINE__) elseif (entry%ndim==2) then - if (order==2) call assert_nf( nf_put_vara_double(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size_gen, 1/), entry%aux_r8, 1), __LINE__) - if (order==1) call assert_nf( nf_put_vara_double(entry%ncid, entry%varID, (/1, lev, entry%rec_count/), (/size_gen, 1, 1/), entry%aux_r8, 1), __LINE__) + call assert_nf( nf_put_vara_double(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size2, 1/), entry%aux_r8, 1), __LINE__) end if end if end do @@ -713,22 +704,19 @@ subroutine write_mean(entry, entry_index) !___________writing 4 byte real _________________________________________ else if (entry%accuracy == i_real4) then if(mype==entry%root_rank) then - if(.not. allocated(entry%aux_r4)) allocate(entry%aux_r4(size_gen)) + if(.not. allocated(entry%aux_r4)) allocate(entry%aux_r4(size2)) end if - do lev=1, size_lev + do lev=1, size1 if(.not. entry%is_elem_based) then - if (order==2) call gather_real4_nod2D(entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm) - if (order==1) call gather_real4_nod2D(entry%local_values_r4_copy(1:size(entry%local_values_r4_copy,dim=1),lev), entry%aux_r4, entry%root_rank, tag, entry%comm) + call gather_real4_nod2D (entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm) else - if (order==2) call gather_real4_elem2D(entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm) - if (order==1) call gather_real4_elem2D(entry%local_values_r4_copy(1:size(entry%local_values_r4_copy,dim=1),lev), entry%aux_r4, entry%root_rank, tag, entry%comm) + call gather_real4_elem2D(entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm) end if if (mype==entry%root_rank) then if (entry%ndim==1) then call assert_nf( nf_put_vara_real(entry%ncid, entry%varID, (/1, entry%rec_count/), (/size2, 1/), entry%aux_r4, 1), __LINE__) elseif (entry%ndim==2) then - if (order==2) call assert_nf( nf_put_vara_real(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size_gen, 1/), entry%aux_r4, 1), __LINE__) - if (order==1) call assert_nf( nf_put_vara_real(entry%ncid, entry%varID, (/1, lev, entry%rec_count/), (/size_gen, 1, 1/), entry%aux_r4, 1), __LINE__) + call assert_nf( nf_put_vara_real(entry%ncid, entry%varID, (/lev, 1, entry%rec_count/), (/1, size2, 1/), entry%aux_r4, 1), __LINE__) end if end if end do @@ -747,12 +735,19 @@ subroutine update_means entry=>io_stream(n) !_____________ compute in 8 byte accuracy _________________________ if (entry%accuracy == i_real8) then - entry%local_values_r8 = entry%local_values_r8 + entry%ptr3(1:size(entry%local_values_r8,dim=1),1:size(entry%local_values_r8,dim=2)) - + if (entry%flip) then + entry%local_values_r8 = entry%local_values_r8 + transpose(entry%ptr3(1:size(entry%local_values_r8,dim=2),1:size(entry%local_values_r8,dim=1))) + else + entry%local_values_r8 = entry%local_values_r8 + entry%ptr3(1:size(entry%local_values_r8,dim=1),1:size(entry%local_values_r8,dim=2)) + end if !_____________ compute in 4 byte accuracy _________________________ elseif (entry%accuracy == i_real4) then - entry%local_values_r4 = entry%local_values_r4 + real(entry%ptr3(1:size(entry%local_values_r4,dim=1),1:size(entry%local_values_r4,dim=2)),real32) - endif + if (entry%flip) then + entry%local_values_r4 = entry%local_values_r4 + transpose(real(entry%ptr3(1:size(entry%local_values_r4,dim=2),1:size(entry%local_values_r4,dim=1)),real32)) + else + entry%local_values_r4 = entry%local_values_r4 + real(entry%ptr3(1:size(entry%local_values_r4,dim=1),1:size(entry%local_values_r4,dim=2)),real32) + end if + endif entry%addcounter=entry%addcounter+1 end do @@ -900,7 +895,7 @@ subroutine finalize_output() ! !-------------------------------------------------------------------------------------------- ! -subroutine def_stream3D(glsize, lcsize, name, description, units, data, freq, freq_unit, accuracy, mesh) +subroutine def_stream3D(glsize, lcsize, name, description, units, data, freq, freq_unit, accuracy, mesh, flip_array) use mod_mesh use g_PARSUP implicit none @@ -913,6 +908,7 @@ subroutine def_stream3D(glsize, lcsize, name, description, units, data, freq, fr type(Meandata), allocatable :: tmparr(:) type(Meandata), pointer :: entry type(t_mesh), intent(in), target :: mesh + logical, optional, intent(in) :: flip_array integer i do i = 1, rank(data) @@ -937,17 +933,27 @@ subroutine def_stream3D(glsize, lcsize, name, description, units, data, freq, fr ! 3d specific entry%ptr3 => data !2D! entry%ptr3(1:1,1:size(data)) => data + if (present(flip_array)) then + if (flip_array) then + entry%flip = .true. + else + entry%flip = .false. + end if + else + entry%flip = .false. + end if + + entry%ndim=2 + entry%glsize=glsize !2D! entry%glsize=(/1, glsize/) + if (accuracy == i_real8) then - allocate(entry%local_values_r8(lcsize(1), lcsize(2))) !2D! allocate(entry%local_values_r8(1, lcsize)) + allocate(entry%local_values_r8(lcsize(1), lcsize(2))) entry%local_values_r8 = 0._real64 elseif (accuracy == i_real4) then - allocate(entry%local_values_r4(lcsize(1), lcsize(2))) !2D! allocate(entry%local_values_r4(1, lcsize)) + allocate(entry%local_values_r4(lcsize(1), lcsize(2))) entry%local_values_r4 = 0._real32 end if - entry%ndim=2 - entry%glsize=glsize !2D! entry%glsize=(/1, glsize/) - entry%dimname(1)=mesh_dimname_from_dimsize(glsize(1), mesh) !2D! mesh_dimname_from_dimsize(glsize, mesh) entry%dimname(2)=mesh_dimname_from_dimsize(glsize(2), mesh) !2D! entry%dimname(2)='unknown' From 49bb729becee7ffafc8859d7bc7e1768b4951e2e Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 27 Nov 2020 11:57:28 +0100 Subject: [PATCH 45/54] Facilitate the modularity concerning the sea-ice strength options --- config/namelist.icepack | 2 + config/namelist.icepack.cesm.ponds | 2 + src/ice_EVP.F90 | 16 +++- src/ice_maEVP.F90 | 49 +++++++++-- src/icepack_drivers/icedrv_init.F90 | 112 +++++++++++++----------- src/icepack_drivers/icedrv_main.F90 | 19 +++- src/icepack_drivers/icedrv_set.F90 | 25 +++++- src/icepack_drivers/icedrv_step.F90 | 8 +- src/icepack_drivers/icedrv_transfer.F90 | 20 +++++ 9 files changed, 181 insertions(+), 72 deletions(-) diff --git a/config/namelist.icepack b/config/namelist.icepack index 09a50e703..ed0dd4d4c 100755 --- a/config/namelist.icepack +++ b/config/namelist.icepack @@ -102,6 +102,8 @@ krdg_redist = 1 mu_rdg = 3 Cf = 17. + P_star = 27000. + C_star = 20. / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/config/namelist.icepack.cesm.ponds b/config/namelist.icepack.cesm.ponds index c5c69774d..51aa33191 100755 --- a/config/namelist.icepack.cesm.ponds +++ b/config/namelist.icepack.cesm.ponds @@ -100,6 +100,8 @@ krdg_redist = 1 mu_rdg = 3 Cf = 17. + P_star = 27000. + C_star = 20. / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src/ice_EVP.F90 b/src/ice_EVP.F90 index 8b5dcea2d..d458bde33 100755 --- a/src/ice_EVP.F90 +++ b/src/ice_EVP.F90 @@ -32,7 +32,7 @@ subroutine stress_tensor(ice_strength, mesh) USE g_CONFIG #if defined (__icepack) -use icedrv_main, only: rdg_conv_elem, rdg_shear_elem +use icedrv_main, only: rdg_conv_elem, rdg_shear_elem, strength #endif implicit none @@ -372,7 +372,7 @@ subroutine EVPdynamics(mesh) use ice_EVP_interfaces #if defined (__icepack) - use icedrv_main, only: rdg_conv_elem, rdg_shear_elem + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem, strength use icedrv_main, only: icepack_to_fesom #endif @@ -462,7 +462,11 @@ subroutine EVPdynamics(mesh) !___________________________________________________________________ ! Hunke and Dukowicz c*h*p* - ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +#if defined (__icepack) + ice_strength(el) = sum(strength(elnodes))/3.0_WP +#else + ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +#endif ice_strength(el) = 0.5_WP*ice_strength(el) !___________________________________________________________________ @@ -501,7 +505,11 @@ subroutine EVPdynamics(mesh) asum = sum(a_ice(elem2D_nodes(:,el)))/3.0_WP ! ===== Hunke and Dukowicz c*h*p* - ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +#if defined (__icepack) + ice_strength(el) = sum(strength(elnodes))/3.0_WP +#else + ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +#endif ice_strength(el) = 0.5_WP*ice_strength(el) ! use rhs_m and rhs_a for storing the contribution from elevation: diff --git a/src/ice_maEVP.F90 b/src/ice_maEVP.F90 index 2fa3176de..e3ba9bb4b 100644 --- a/src/ice_maEVP.F90 +++ b/src/ice_maEVP.F90 @@ -44,7 +44,7 @@ subroutine stress_tensor_m(mesh) use g_parsup #if defined (__icepack) -use icedrv_main, only: rdg_conv_elem, rdg_shear_elem +use icedrv_main, only: rdg_conv_elem, rdg_shear_elem, strength #endif implicit none @@ -91,7 +91,11 @@ subroutine stress_tensor_m(mesh) delta=eps1**2+vale*(eps2**2+4.0_WP*eps12(elem)**2) delta=sqrt(delta) +#if defined (__icepack) + pressure = sum(strength(elnodes))*val3/max(delta,delta_min) +#else pressure=pstar*msum*exp(-c_pressure*(1.0_WP-asum))/max(delta,delta_min) +#endif r1=pressure*(eps1-max(delta,delta_min)) r2=pressure*eps2*vale @@ -264,7 +268,8 @@ subroutine EVPdynamics_m(mesh) use g_comm_auto #if defined (__icepack) - use icedrv_main, only: rdg_conv_elem, rdg_shear_elem + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem, strength + use icedrv_main, only: icepack_to_fesom #endif implicit none @@ -299,6 +304,16 @@ subroutine EVPdynamics_m(mesh) u_ice_aux=u_ice ! Initialize solver variables v_ice_aux=v_ice +#if defined (__icepack) + a_ice_old(:) = a_ice(:) + m_ice_old(:) = a_ice(:) + m_snow_old(:) = m_snow(:) + + call icepack_to_fesom (nx_in=(myDim_nod2D+eDim_nod2D), & + aice_out=a_ice, & + vice_out=m_ice, & + vsno_out=m_snow) +#endif !NR inlined, to have all initialization in one place. ! call ssh2rhs @@ -379,9 +394,12 @@ subroutine EVPdynamics_m(mesh) msum=sum(m_ice(elnodes))*val3 if(msum > 0.01) then ice_el(el) = .true. - asum=sum(a_ice(elnodes))*val3 - - pressure_fac(el) = det2*pstar*msum*exp(-c_pressure*(1.0_WP-asum)) + asum=sum(a_ice(elnodes))*val3 +#if defined (__icepack) + pressure = det2*sum(strength(elnodes))*val3 +#else + pressure = det2*pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +#endif endif end do @@ -539,6 +557,11 @@ subroutine find_alpha_field_a(mesh) use g_config use i_arrays use g_parsup + +#if defined (__icepack) + use icedrv_main, only: strength +#endif + implicit none integer :: elem, elnodes(3) @@ -580,8 +603,12 @@ subroutine find_alpha_field_a(mesh) delta=eps1**2+vale*(eps2**2+4.0_WP*eps12(elem)**2) delta=sqrt(delta) - pressure=pstar*exp(-c_pressure*(1.0_WP-asum))/(delta+delta_min) ! no multiplication - ! with thickness (msum) +#if defined (__icepack) + pressure = sum(strength(elnodes))*val3/(delta+delta_min)/msum +#else + pressure = pstar*exp(-c_pressure*(1.0_WP-asum))/(delta+delta_min) ! no multiplication + ! with thickness (msum) +#endif !adjust c_aevp such, that alpha_evp_array and beta_evp_array become in acceptable range alpha_evp_array(elem)=max(50.0_WP,sqrt(ice_dt*c_aevp*pressure/rhoice/elem_area(elem))) ! /voltriangle(elem) for FESOM1.4 @@ -604,7 +631,7 @@ subroutine stress_tensor_a(mesh) use g_parsup #if defined (__icepack) - use icedrv_main, only: rdg_conv_elem, rdg_shear_elem + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem, strength #endif implicit none @@ -651,8 +678,12 @@ subroutine stress_tensor_a(mesh) ! ====== moduli: delta=eps1**2+vale*(eps2**2+4.0_WP*eps12(elem)**2) delta=sqrt(delta) - + +#if defined (__icepack) + pressure = sum(strength(elnodes))*val3/(delta+delta_min) +#else pressure=pstar*msum*exp(-c_pressure*(1.0_WP-asum))/(delta+delta_min) +#endif r1=pressure*(eps1-delta) r2=pressure*eps2*vale diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 2a35af7ac..2a49604fd 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -999,7 +999,7 @@ subroutine init_state_var () use icepack_intfc, only: icepack_init_fsd use icepack_intfc, only: icepack_aggregate - + use o_arrays, only: tr_arr implicit none ! local variables @@ -1080,55 +1080,67 @@ subroutine init_state_var () ! For the moment we start we no sea ice -! if (3 <= ncat) then -! n = 3 -! ainit(n) = c1 ! assumes we are using the default ITD boundaries -! hinit(n) = c2 -! else -! ainit(ncat) = c1 -! hinit(ncat) = c2 -! endif -! -! do i = 1, nx -! if (sst(i) <= Tf(i)) then ! -! do n = 1, ncat -! ! ice volume, snow volume -! aicen(i,n) = ainit(n) -! vicen(i,n) = hinit(n) * ainit(n) ! m -! vsnon(i,n) = c0 -! ! tracers -! call icepack_init_trcr(Tair = T_air(i), & -! Tf = Tf(i), & -! Sprofile = salinz(i,:), & -! Tprofile = Tmltz(i,:), & -! Tsfc = Tsfc, & -! nilyr=nilyr, nslyr=nslyr, & -! qin=qin(:), qsn=qsn(:)) -! -! ! floe size distribution -! if (tr_fsd) call icepack_init_fsd(nfsd=nfsd, ice_ic=ice_ic, & -! floe_rad_c=floe_rad_c, & -! floe_binwidth=floe_binwidth, & -! afsd=trcrn(i,nt_fsd:nt_fsd+nfsd-1,n)) -! ! surface temperature -! trcrn(i,nt_Tsfc,n) = Tsfc ! deg C -! ! ice enthalpy, salinity -! do k = 1, nilyr -! trcrn(i,nt_qice+k-1,n) = qin(k) -! trcrn(i,nt_sice+k-1,n) = salinz(i,k) -! enddo -! ! snow enthalpy -! do k = 1, nslyr -! trcrn(i,nt_qsno+k-1,n) = -rhos * Lfresh -! enddo ! nslyr -! ! brine fraction -! if (tr_brine) trcrn(i,nt_fbri,n) = c1 -! enddo ! ncat -! call icepack_warnings_flush(ice_stderr) -! if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & -! file=__FILE__, line=__LINE__) -! endif -! enddo + if (ncat > 7) then + hbar = c5 + else + hbar = c3 + end if + + sum = c0 + do n = 1, ncat + if (n < ncat) then + hinit(n) = p5*(hin_max(n-1) + hin_max(n)) ! m + else ! n=ncat + hinit(n) = (hin_max(n-1) + c1) ! m + endif + ! parabola, max at h=hbar, zero at h=0, 2*hbar + ainit(n) = max(c0, (c2*hbar*hinit(n) - hinit(n)**2)) + sum = sum + ainit(n) + enddo + do n = 1, ncat + ainit(n) = ainit(n) / (sum + puny/ncat) ! normalize + enddo + + do i = 1, nx + if (tr_arr(1,i,1) <= -1.7_dbl_kind) then ! + do n = 1, ncat + ! ice volume, snow volume + aicen(i,n) = ainit(n) + vicen(i,n) = hinit(n) * ainit(n) ! m + vsnon(i,n) = min(aicen(i,n)*hsno_init,p2*vicen(i,n)) + ! tracers + call icepack_init_trcr(Tair = T_air(i), & + Tf = Tf(i), & + Sprofile = salinz(i,:), & + Tprofile = Tmltz(i,:), & + Tsfc = Tsfc, & + nilyr=nilyr, nslyr=nslyr, & + qin=qin(:), qsn=qsn(:)) + + ! floe size distribution + if (tr_fsd) call icepack_init_fsd(nfsd=nfsd, ice_ic=ice_ic, & + floe_rad_c=floe_rad_c, & + floe_binwidth=floe_binwidth, & + afsd=trcrn(i,nt_fsd:nt_fsd+nfsd-1,n)) + ! surface temperature + trcrn(i,nt_Tsfc,n) = -10.0_dbl_kind ! deg C + ! ice enthalpy, salinity + do k = 1, nilyr + trcrn(i,nt_qice+k-1,n) = -30000000.0_dbl_kind + trcrn(i,nt_sice+k-1,n) = salinz(i,k) + enddo + ! snow enthalpy + do k = 1, nslyr + trcrn(i,nt_qsno+k-1,n) = -rhos * Lfresh + enddo ! nslyr + ! brine fraction + if (tr_brine) trcrn(i,nt_fbri,n) = c1 + enddo ! ncat + call icepack_warnings_flush(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + endif + enddo !----------------------------------------------------------------- ! compute aggregate ice state and open water area diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 76edafb4f..d36371fc6 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -21,10 +21,10 @@ module icedrv_main public :: & ! Variables - ncat, rdg_conv_elem, rdg_shear_elem, & + ncat, rdg_conv_elem, rdg_shear_elem, strength, & ! Subroutines set_icepack, alloc_icepack, init_icepack, step_icepack, & - icepack_to_fesom, & + icepack_to_fesom, icepack_to_fesom_single_point, & init_flux_atm_ocn, init_io_icepack, init_restart_icepack !======================================================================= @@ -801,7 +801,7 @@ module subroutine fesom_to_icepack(mesh) type(t_mesh), intent(in), target :: mesh end subroutine fesom_to_icepack - ! Copy variables from fesom to icepack + ! Copy variables from icepack to fesom module subroutine icepack_to_fesom( & nx_in, & aice_out, vice_out, vsno_out, & @@ -825,9 +825,20 @@ module subroutine icepack_to_fesom( & dhs_dt_out, & dhi_dt_out, & evap_ocn_out - end subroutine icepack_to_fesom + ! Copy variables from icepack to fesom (single node or element) + module subroutine icepack_to_fesom_single_point( & + nx_in, & + strength_out) + use mod_mesh + implicit none + integer (kind=int_kind), intent(in) :: & + nx_in ! block dimensions + real (kind=dbl_kind), intent(out), optional :: & + strength_out + end subroutine icepack_to_fesom_single_point + ! Trancers advection module subroutine tracer_advection_icepack(mesh) use mod_mesh diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 2850adb7a..2fbaaa947 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -28,7 +28,7 @@ module subroutine set_icepack() myDim_elem2D, eDim_elem2D, & mpi_comm_fesom use i_param, only: whichEVP - use i_param, only: cd_oce_ice + use i_param, only: cd_oce_ice, Pstar, c_pressure use i_therm_param, only: albw implicit none @@ -145,6 +145,8 @@ module subroutine set_icepack() real (kind=dbl_kind) :: ustar_min real (kind=dbl_kind) :: emissivity real (kind=dbl_kind) :: dragio + real (kind=dbl_kind) :: P_star + real (kind=dbl_kind) :: C_star character (len=char_len) :: fbot_xfer_type logical (kind=log_kind) :: update_ocn_f logical (kind=log_kind) :: l_mpond_fresh @@ -175,7 +177,7 @@ module subroutine set_icepack() namelist / dynamics_nml / & kstrength, krdg_partic, krdg_redist, mu_rdg, & - Cf + Cf, P_star, C_star namelist / shortwave_nml / & shortwave, albedo_type, albocn, & @@ -332,6 +334,7 @@ module subroutine set_icepack() tfrz_option_out=tfrz_option, kalg_out=kalg, & fbot_xfer_type_out=fbot_xfer_type, puny_out=puny, & wave_spec_type_out=wave_spec_type, dragio_out=dragio, & + Pstar_out=P_star, Cstar_out=C_star, & ksno_out=ksno, albocn_out=albocn ) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & @@ -648,7 +651,14 @@ module subroutine set_icepack() write(nu_diag,1010) ' calc_Tsfc = ', calc_Tsfc write(nu_diag,1010) ' update_ocn_f = ', update_ocn_f write(nu_diag,1010) ' wave_spec = ', wave_spec - write(nu_diag,1030) ' dragio = ', dragio + write(nu_diag,1005) ' dragio = ', dragio + write(nu_diag,1005) ' Pstar = ', P_star + write(nu_diag,1005) ' Cstar = ', C_star + + if (kstrength==1) then + write(nu_diag,*) '!! ATTENTION !! kstrength = 1 ' + write(nu_diag,*) ' ==> P_star and C_star not used!!' + end if if (wave_spec) then write(nu_diag,*) ' wave_spec_type = ', wave_spec_type @@ -801,8 +811,14 @@ module subroutine set_icepack() ! set Icepack values !----------------------------------------------------------------- + ! Make the namelists.ice and namelist.icepack consistent (icepack wins + ! over fesom) + cd_oce_ice = dragio albw = albocn + Pstar = P_star + c_pressure = C_star + call icepack_init_parameters(ustar_min_in=ustar_min, Cf_in=Cf, & albicev_in=albicev, albicei_in=albicei, & @@ -829,7 +845,8 @@ module subroutine set_icepack() tfrz_option_in=tfrz_option, kalg_in=kalg, & fbot_xfer_type_in=fbot_xfer_type, & wave_spec_type_in=wave_spec_type, wave_spec_in=wave_spec, & - ksno_in=ksno, dragio_in=dragio, albocn_in=albocn) + ksno_in=ksno, dragio_in=dragio, Cstar_in=C_star, & + Pstar_in=P_star, albocn_in=albocn) call icepack_init_tracer_sizes(ntrcr_in=ntrcr, & ncat_in=ncat, nilyr_in=nilyr, nslyr_in=nslyr, nblyr_in=nblyr, & nfsd_in=nfsd, n_aero_in=n_aero) diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index d0b965f16..6cbcbbba7 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -297,6 +297,7 @@ subroutine step_therm2 (dt) ! column package_includes use icepack_intfc, only: icepack_step_therm2 + use icepack_intfc, only: icepack_ice_strength implicit none @@ -375,7 +376,12 @@ subroutine step_therm2 (dt) d_afsd_weld=d_afsd_weld(i,:), & floe_rad_c=floe_rad_c(:), & floe_binwidth=floe_binwidth(:)) - + + ! Compute sea-ice internal stress (immediately before EVP) + call icepack_ice_strength(ncat, & + aice(i), vice(i), & + aice0(i), aicen(i,:), & + vicen(i,:), strength(i)) enddo ! i call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 index c0fc69742..6ba70afa6 100644 --- a/src/icepack_drivers/icedrv_transfer.F90 +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -215,6 +215,26 @@ module subroutine icepack_to_fesom( nx_in, & end subroutine icepack_to_fesom +!======================================================================= + + module subroutine icepack_to_fesom_single_point(nx_in, & + strength_out) + + implicit none + + integer (kind=int_kind), intent(in) :: & + nx_in ! surface node or element + + real (kind=dbl_kind), intent(out), optional :: & + strength_out + + character(len=*),parameter :: subname='(icepack_to_fesom_single_point)' + + + if (present(strength_out) ) strength_out = strength(nx_in) + + end subroutine icepack_to_fesom_single_point + !======================================================================= end submodule icedrv_transfer From 0780dce0e7fdbab682314d4578dc3fde27781ea4 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Mon, 30 Nov 2020 10:18:53 +0100 Subject: [PATCH 46/54] Small changes --- src/ice_modules.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ice_modules.F90 b/src/ice_modules.F90 index e26e6acf3..15df10002 100755 --- a/src/ice_modules.F90 +++ b/src/ice_modules.F90 @@ -32,7 +32,7 @@ MODULE i_PARAM real(kind=WP) :: theta_io=0.0_WP ! rotation angle ! (ice-ocean), available ! in EVP - real(kind=WP) :: alpha_evp=250, beta_evp=250 + real(kind=WP) :: alpha_evp=500, beta_evp=500 real(kind=WP) :: c_aevp=0.15 ! 0.1--0.2, but should be adjusted experimentally ! Ice forcing averaging integer :: ice_ave_steps=1 !ice step=ice_ave_steps*oce_step From 474fbd89498b3c344df47d24e943322db96bd399 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 2 Feb 2021 16:12:54 +0100 Subject: [PATCH 47/54] Last commit on dkrz --- src/ice_maEVP.F90 | 12 +++++------ src/icepack_drivers/icedrv_init.F90 | 2 +- src/icepack_drivers/icedrv_io.F90 | 2 ++ src/icepack_drivers/icedrv_main.F90 | 4 ++++ src/icepack_drivers/icedrv_set.F90 | 10 +++++++--- src/icepack_drivers/icedrv_step.F90 | 31 ++++++++++++++++------------- 6 files changed, 37 insertions(+), 24 deletions(-) diff --git a/src/ice_maEVP.F90 b/src/ice_maEVP.F90 index e3ba9bb4b..417ecf806 100644 --- a/src/ice_maEVP.F90 +++ b/src/ice_maEVP.F90 @@ -372,7 +372,7 @@ subroutine EVPdynamics_m(mesh) if (a_ice(i) >= 0.01_WP) then inv_thickness(i) = (rhoice*m_ice(i)+rhosno*m_snow(i))/a_ice(i) - inv_thickness(i) = 1.0_WP/max(inv_thickness(i), 9.0_WP) ! Limit the mass + inv_thickness(i) = 1.0_WP/inv_thickness(i) !max(inv_thickness(i), 9.0_WP) ! Limit the mass mass(i) = (m_ice(i)*rhoice+m_snow(i)*rhosno) mass(i) = mass(i)/((1.0_WP+mass(i)*mass(i))*area(1,i)) @@ -395,11 +395,11 @@ subroutine EVPdynamics_m(mesh) if(msum > 0.01) then ice_el(el) = .true. asum=sum(a_ice(elnodes))*val3 -#if defined (__icepack) - pressure = det2*sum(strength(elnodes))*val3 -#else - pressure = det2*pstar*msum*exp(-c_pressure*(1.0_WP-asum)) -#endif +!#if defined (__icepack) +! pressure_fac(el) = det2*sum(strength(elnodes))*val3 +!#else + pressure_fac(el) = det2*pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +!#endif endif end do diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 2a49604fd..33c36b169 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -1102,7 +1102,7 @@ subroutine init_state_var () enddo do i = 1, nx - if (tr_arr(1,i,1) <= -1.7_dbl_kind) then ! + if (tr_arr(1,i,1) < 0.0_dbl_kind) then ! do n = 1, ncat ! ice volume, snow volume aicen(i,n) = ainit(n) diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index 9e0209533..b36769272 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -147,6 +147,8 @@ module subroutine init_io_icepack(mesh) call def_stream2D(nod2D, nx_nh, 'Tsfc', 'sea ice surf. temperature', 'degC', trcr(:,nt_Tsfc), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('Tsfcn ') call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'Tsfcn', 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + case ('strength ') + call def_stream2D(nod2D, nx_nh, 'strength', 'sea ice strength', 'N', strength(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) ! If the following tracers are not defined they will not be outputed case ('iagen ') if (tr_iage) then diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index d36371fc6..16817d83d 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -856,6 +856,10 @@ end subroutine init_advection_icepack ! Driving subroutine for column physics module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) use mod_mesh + use g_config, only: dt + use i_PARAM, only: whichEVP + use g_parsup + use icepack_intfc, only: icepack_ice_strength implicit none real (kind=dbl_kind), intent(out) :: & time_therm, & diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 2fbaaa947..08c2e4306 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -103,7 +103,9 @@ module subroutine set_icepack() integer (kind=int_kind) :: krdg_partic integer (kind=int_kind) :: krdg_redist real (kind=dbl_kind) :: mu_rdg - real (kind=dbl_kind) :: Cf + real (kind=dbl_kind) :: Cf + real (kind=dbl_kind) :: P_star + real (kind=dbl_kind) :: C_star ! shortwave namelist @@ -145,8 +147,6 @@ module subroutine set_icepack() real (kind=dbl_kind) :: ustar_min real (kind=dbl_kind) :: emissivity real (kind=dbl_kind) :: dragio - real (kind=dbl_kind) :: P_star - real (kind=dbl_kind) :: C_star character (len=char_len) :: fbot_xfer_type logical (kind=log_kind) :: update_ocn_f logical (kind=log_kind) :: l_mpond_fresh @@ -394,6 +394,10 @@ module subroutine set_icepack() if (mype == 0) print*,'Reading forcing_nml' read(nu_nml, nml=forcing_nml,iostat=nml_error) if (nml_error /= 0) exit + + if (mype == 0) print*,'Reading dynamics_nml' + read(nu_nml, nml=dynamics_nml,iostat=nml_error) + if (nml_error /= 0) exit end do if (nml_error == 0) close(nu_nml) diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 6cbcbbba7..51cfd7d71 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -16,6 +16,7 @@ use icepack_intfc, only: icepack_query_tracer_indices use icepack_intfc, only: icepack_query_tracer_sizes use icepack_intfc, only: icepack_query_parameters + implicit none @@ -297,7 +298,6 @@ subroutine step_therm2 (dt) ! column package_includes use icepack_intfc, only: icepack_step_therm2 - use icepack_intfc, only: icepack_ice_strength implicit none @@ -377,11 +377,6 @@ subroutine step_therm2 (dt) floe_rad_c=floe_rad_c(:), & floe_binwidth=floe_binwidth(:)) - ! Compute sea-ice internal stress (immediately before EVP) - call icepack_ice_strength(ncat, & - aice(i), vice(i), & - aice0(i), aicen(i,:), & - vicen(i,:), strength(i)) enddo ! i call icepack_warnings_flush(ice_stderr) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & @@ -1124,6 +1119,7 @@ end subroutine coupling_prep module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) + use icepack_intfc, only: icepack_ice_strength use g_config, only: dt use i_PARAM, only: whichEVP use g_parsup @@ -1132,7 +1128,7 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) implicit none integer (kind=int_kind) :: & - k ! dynamics supercycling index + k, i ! for loop indexes logical (kind=log_kind) :: & calc_Tsfc, skl_bgc, solve_zsal, z_tracers, tr_brine, & ! from icepack @@ -1206,6 +1202,13 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) call step_therm1 (dt) ! vertical thermodynamics call step_therm2 (dt) ! ice thickness distribution thermo + !----------------------------------------------------------------- + ! tendencies needed by fesom + !----------------------------------------------------------------- + + dhi_dt(:) = ( vice(:) - dhi_dt(:) ) / dt + dhs_dt(:) = ( vsno(:) - dhi_dt(:) ) / dt + ! clean up, update tendency diagnostics offset = dt @@ -1217,6 +1220,13 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) call init_history_dyn + ! Compute sea-ice internal stress (immediately before EVP) + do i = 1, nx + call icepack_ice_strength(ncat, & + aice(i), vice(i), & + aice0(i), aicen(i,:), & + vicen(i,:), strength(i)) + end do ! 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) @@ -1286,13 +1296,6 @@ module subroutine step_icepack(mesh, time_evp, time_advec, time_therm) call coupling_prep (dt) - !----------------------------------------------------------------- - ! tendencies needed by fesom - !----------------------------------------------------------------- - - dhi_dt(:) = ( vice(:) - dhi_dt(:) ) / dt - dhs_dt(:) = ( vsno(:) - dhi_dt(:) ) / dt - !----------------------------------------------------------------- ! icepack timing !----------------------------------------------------------------- From a12b7efde3f330b5512ef577f8c16b04fd8c3c2a Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 5 Feb 2021 11:34:51 +0100 Subject: [PATCH 48/54] Change in JUWELS environment --- env/juwels/shell | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/env/juwels/shell b/env/juwels/shell index b4db0689f..0b5451c82 100644 --- a/env/juwels/shell +++ b/env/juwels/shell @@ -4,12 +4,12 @@ module use /gpfs/software/juwels/otherstages module load Stages/2019a module load StdEnv # For intel MPI -module load Intel/2019.3.199-GCC-8.3.0 IntelMPI/2018.5.288 imkl/2019.3.199 -export FC=mpiifort CC=mpiicc CXX=mpiicpc +#module load Intel/2019.3.199-GCC-8.3.0 IntelMPI/2018.5.288 imkl/2019.3.199 +#export FC=mpiifort CC=mpiicc CXX=mpiicpc # For ParaStation MPI -#module load Intel/2019.3.199-GCC-8.3.0 ParaStationMPI/5.4 imkl/2019.5.281 -#export FC=mpifort CC=mpicc CXX=mpicxx +module load Intel/2019.3.199-GCC-8.3.0 ParaStationMPI/5.4 imkl/2019.5.281 +export FC=mpifort CC=mpicc CXX=mpicxx module load netCDF/4.6.3 module load netCDF-Fortran/4.4.5 From ed8d2381c6ffc5d55fb94dfc39b615438b03209f Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Fri, 5 Feb 2021 11:40:06 +0100 Subject: [PATCH 49/54] Test 1 --- src/ice_EVP.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/ice_EVP.F90 b/src/ice_EVP.F90 index d458bde33..f154eba45 100755 --- a/src/ice_EVP.F90 +++ b/src/ice_EVP.F90 @@ -463,7 +463,8 @@ subroutine EVPdynamics(mesh) !___________________________________________________________________ ! Hunke and Dukowicz c*h*p* #if defined (__icepack) - ice_strength(el) = sum(strength(elnodes))/3.0_WP +! ice_strength(el) = sum(strength(elnodes))/3.0_WP + ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) #else ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) #endif @@ -506,7 +507,8 @@ subroutine EVPdynamics(mesh) ! ===== Hunke and Dukowicz c*h*p* #if defined (__icepack) - ice_strength(el) = sum(strength(elnodes))/3.0_WP +! ice_strength(el) = sum(strength(elnodes))/3.0_WP + ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) #else ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) #endif From ec0bad0b1297de432ac78721ef523ba09c791cf8 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Tue, 9 Feb 2021 14:25:05 +0100 Subject: [PATCH 50/54] Automatize Icepack download --- .gitignore | 2 +- CMakeLists.txt | 2 +- src/CMakeLists.txt | 10 +++++++--- src/icepack_drivers/download_icepack.sh | 10 ++++++++++ 4 files changed, 19 insertions(+), 5 deletions(-) create mode 100755 src/icepack_drivers/download_icepack.sh diff --git a/.gitignore b/.gitignore index cdc2352f8..cce77c72d 100644 --- a/.gitignore +++ b/.gitignore @@ -5,5 +5,5 @@ #*.out *~ *.swp -/Icepack +src/icepack_drivers/Icepack /work_* diff --git a/CMakeLists.txt b/CMakeLists.txt index 122359626..95b7e7b78 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,7 +11,7 @@ set(TOPLEVEL_DIR ${CMAKE_CURRENT_LIST_DIR}) set(FESOM_COUPLED OFF CACHE BOOL "compile fesom standalone or with oasis support (i.e. coupled)") set(OIFS_COUPLED OFF CACHE BOOL "compile fesom coupled to OpenIFS. (Also needs FESOM_COUPLED to work)") set(CRAY OFF CACHE BOOL "compile with cray ftn") -set(USE_ICEPACK ON CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") +set(USE_ICEPACK OFF CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") #set(VERBOSE OFF CACHE BOOL "toggle debug output") #add_subdirectory(oasis3-mct/lib/psmile) add_subdirectory(src) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index d455e88b9..367abfad0 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -7,9 +7,13 @@ option(DISABLE_MULTITHREADING "disable asynchronous operations" OFF) # get our source files set(src_home ${CMAKE_CURRENT_LIST_DIR}) # path to src directory starting from the dir containing our CMakeLists.txt -file(GLOB sources_Fortran ${src_home}/*.F90 - ${src_home}/icepack_drivers/*.F90 - ${src_home}/../Icepack/columnphysics/*.F90) +if(${USE_ICEPACK}) + file(GLOB sources_Fortran ${src_home}/*.F90 + ${src_home}/icepack_drivers/*.F90 + ${src_home}/icepack_drivers/Icepack/columnphysics/*.F90) +else() + file(GLOB sources_Fortran ${src_home}/*.F90) +endif() #list(REMOVE_ITEM sources_Fortran ${src_home}/fesom_partition_init.F90) file(GLOB sources_C ${src_home}/*.c) diff --git a/src/icepack_drivers/download_icepack.sh b/src/icepack_drivers/download_icepack.sh new file mode 100755 index 000000000..a579268eb --- /dev/null +++ b/src/icepack_drivers/download_icepack.sh @@ -0,0 +1,10 @@ +# Download icepack columphysics code +# from Lorenzo's fork on github and +# switch to the appropriate branch + +DIR="./Icepack" +if [ ! -d "$DIR" ]; then + git clone https://github.com/lzampier/Icepack.git + cd $DIR + git checkout icepack_fesom2 +fi From cf319574521393ef3f37cd03208641942cd67365 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 10 Feb 2021 11:31:46 +0100 Subject: [PATCH 51/54] Update to pull request --- CMakeLists.txt | 2 +- config/namelist.config | 0 config/namelist.config.dkrz | 0 config/namelist.config.hlrn | 0 config/namelist.config.orig | 0 config/namelist.config.toy_soufflet | 0 config/namelist.cvmix | 0 config/namelist.forcing | 0 config/namelist.forcing.era5 | 0 config/namelist.forcing.ncep | 0 config/namelist.forcing_COREI | 0 config/namelist.ice | 0 config/namelist.icepack | 0 config/namelist.icepack.cesm.ponds | 0 config/namelist.io | 0 config/namelist.oce | 0 config/namelist.oce.core2 | 0 config/namelist.oce.toy_soufflet | 0 src/ice_maEVP.F90 | 6 +---- src/ice_modules.F90 | 2 +- src/icepack_drivers/icedrv_io.F90 | 38 ++++++++++++++--------------- 21 files changed, 22 insertions(+), 26 deletions(-) mode change 100755 => 100644 config/namelist.config mode change 100755 => 100644 config/namelist.config.dkrz mode change 100755 => 100644 config/namelist.config.hlrn mode change 100755 => 100644 config/namelist.config.orig mode change 100755 => 100644 config/namelist.config.toy_soufflet mode change 100755 => 100644 config/namelist.cvmix mode change 100755 => 100644 config/namelist.forcing mode change 100755 => 100644 config/namelist.forcing.era5 mode change 100755 => 100644 config/namelist.forcing.ncep mode change 100755 => 100644 config/namelist.forcing_COREI mode change 100755 => 100644 config/namelist.ice mode change 100755 => 100644 config/namelist.icepack mode change 100755 => 100644 config/namelist.icepack.cesm.ponds mode change 100755 => 100644 config/namelist.io mode change 100755 => 100644 config/namelist.oce mode change 100755 => 100644 config/namelist.oce.core2 mode change 100755 => 100644 config/namelist.oce.toy_soufflet diff --git a/CMakeLists.txt b/CMakeLists.txt index 95b7e7b78..122359626 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,7 +11,7 @@ set(TOPLEVEL_DIR ${CMAKE_CURRENT_LIST_DIR}) set(FESOM_COUPLED OFF CACHE BOOL "compile fesom standalone or with oasis support (i.e. coupled)") set(OIFS_COUPLED OFF CACHE BOOL "compile fesom coupled to OpenIFS. (Also needs FESOM_COUPLED to work)") set(CRAY OFF CACHE BOOL "compile with cray ftn") -set(USE_ICEPACK OFF CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") +set(USE_ICEPACK ON CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") #set(VERBOSE OFF CACHE BOOL "toggle debug output") #add_subdirectory(oasis3-mct/lib/psmile) add_subdirectory(src) diff --git a/config/namelist.config b/config/namelist.config old mode 100755 new mode 100644 diff --git a/config/namelist.config.dkrz b/config/namelist.config.dkrz old mode 100755 new mode 100644 diff --git a/config/namelist.config.hlrn b/config/namelist.config.hlrn old mode 100755 new mode 100644 diff --git a/config/namelist.config.orig b/config/namelist.config.orig old mode 100755 new mode 100644 diff --git a/config/namelist.config.toy_soufflet b/config/namelist.config.toy_soufflet old mode 100755 new mode 100644 diff --git a/config/namelist.cvmix b/config/namelist.cvmix old mode 100755 new mode 100644 diff --git a/config/namelist.forcing b/config/namelist.forcing old mode 100755 new mode 100644 diff --git a/config/namelist.forcing.era5 b/config/namelist.forcing.era5 old mode 100755 new mode 100644 diff --git a/config/namelist.forcing.ncep b/config/namelist.forcing.ncep old mode 100755 new mode 100644 diff --git a/config/namelist.forcing_COREI b/config/namelist.forcing_COREI old mode 100755 new mode 100644 diff --git a/config/namelist.ice b/config/namelist.ice old mode 100755 new mode 100644 diff --git a/config/namelist.icepack b/config/namelist.icepack old mode 100755 new mode 100644 diff --git a/config/namelist.icepack.cesm.ponds b/config/namelist.icepack.cesm.ponds old mode 100755 new mode 100644 diff --git a/config/namelist.io b/config/namelist.io old mode 100755 new mode 100644 diff --git a/config/namelist.oce b/config/namelist.oce old mode 100755 new mode 100644 diff --git a/config/namelist.oce.core2 b/config/namelist.oce.core2 old mode 100755 new mode 100644 diff --git a/config/namelist.oce.toy_soufflet b/config/namelist.oce.toy_soufflet old mode 100755 new mode 100644 diff --git a/src/ice_maEVP.F90 b/src/ice_maEVP.F90 index 81f2aa944..0dbdc8543 100644 --- a/src/ice_maEVP.F90 +++ b/src/ice_maEVP.F90 @@ -409,7 +409,7 @@ subroutine EVPdynamics_m(mesh) if (a_ice(i) >= 0.01_WP) then inv_thickness(i) = (rhoice*m_ice(i)+rhosno*m_snow(i))/a_ice(i) - inv_thickness(i) = 1.0_WP/inv_thickness(i) !max(inv_thickness(i), 9.0_WP) ! Limit the mass + inv_thickness(i) = 1.0_WP/max(inv_thickness(i), 9.0_WP) ! Limit the mass mass(i) = (m_ice(i)*rhoice+m_snow(i)*rhosno) mass(i) = mass(i)/((1.0_WP+mass(i)*mass(i))*area(1,i)) @@ -438,11 +438,7 @@ subroutine EVPdynamics_m(mesh) if(msum > 0.01) then ice_el(el) = .true. asum=sum(a_ice(elnodes))*val3 -!#if defined (__icepack) -! pressure_fac(el) = det2*sum(strength(elnodes))*val3 -!#else pressure_fac(el) = det2*pstar*msum*exp(-c_pressure*(1.0_WP-asum)) -!#endif endif end do diff --git a/src/ice_modules.F90 b/src/ice_modules.F90 index cb4317643..ad8ece6d6 100755 --- a/src/ice_modules.F90 +++ b/src/ice_modules.F90 @@ -32,7 +32,7 @@ MODULE i_PARAM real(kind=WP) :: theta_io=0.0_WP ! rotation angle ! (ice-ocean), available ! in EVP - real(kind=WP) :: alpha_evp=500, beta_evp=500 + real(kind=WP) :: alpha_evp=250, beta_evp=250 real(kind=WP) :: c_aevp=0.15 ! 0.1--0.2, but should be adjusted experimentally ! Ice forcing averaging integer :: ice_ave_steps=1 !ice step=ice_ave_steps*oce_step diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index b36769272..61886bbe5 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -128,9 +128,9 @@ module subroutine init_io_icepack(mesh) case ('aicen ') call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'aicen', 'sea ice concentration', 'none', aicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) case ('vicen ') - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vicen', 'volume per unit area of ice', 'm', vicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'vicen', 'volume per unit area of ice', 'm', vicen(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) case ('vsnon ') - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vsnon', 'volume per unit area of snow', 'm', vsnon(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'vsnon', 'volume per unit area of snow', 'm', vsnon(:,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) case ('aice ') call def_stream2D(nod2D, nx_nh, 'aice', 'sea ice concentration', 'none', aice(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('vice ') @@ -146,64 +146,64 @@ module subroutine init_io_icepack(mesh) case ('Tsfc ') call def_stream2D(nod2D, nx_nh, 'Tsfc', 'sea ice surf. temperature', 'degC', trcr(:,nt_Tsfc), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('Tsfcn ') - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'Tsfcn', 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'Tsfcn', 'sea ice surf. temperature', 'degC', trcrn(:,nt_Tsfc,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) case ('strength ') call def_stream2D(nod2D, nx_nh, 'strength', 'sea ice strength', 'N', strength(:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) ! If the following tracers are not defined they will not be outputed case ('iagen ') if (tr_iage) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'iage', 'sea ice age', 's', trcrn(:,nt_iage,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'iage', 'sea ice age', 's', trcrn(:,nt_iage,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end if case ('FYn ') if (tr_FY) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'FY', 'first year ice', 'none', trcrn(:,nt_FY,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'FY', 'first year ice', 'none', trcrn(:,nt_FY,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end if case ('lvln ') if (tr_lvl) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'alvl', 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'vlvl', 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'alvl', 'ridged sea ice area', 'none', trcrn(:,nt_alvl,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'vlvl', 'ridged sea ice volume', 'm', trcrn(:,nt_vlvl,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end if case ('pond_cesmn') if (tr_pond_cesm) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end if case ('pond_topon') if (tr_pond_topo) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'ipnd', 'melt pond refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'ipnd', 'melt pond refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end if case ('pond_lvln ') if (tr_pond_lvl) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'ipnd', 'melt pond refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'apnd', 'melt pond area fraction', 'none', trcrn(:,nt_apnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'hpnd', 'melt pond depth', 'm', trcrn(:,nt_hpnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'ipnd', 'melt pond refrozen lid thickness', 'm', trcrn(:,nt_ipnd,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end if case ('brinen ') if (tr_brine) then - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), 'fbri', 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), 'fbri', 'volume fraction of ice with dynamic salt', 'none', trcrn(:,nt_fbri,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end if case ('qicen ') do k = 1,nilyr ! Separate variable for each sea ice layer write(trname,'(A6,i1)') 'qicen_', k write(longname,'(A22,i1)') 'sea ice enthalpy lyr: ', k units='J/m3' - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), trim(trname), trim(longname), trim(units), trcrn(:,nt_qice+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), trim(trname), trim(longname), trim(units), trcrn(:,nt_qice+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end do case ('sicen ') do k = 1,nilyr ! Separate variable for each sea ice layer write(trname,'(A6,i1)') 'sicen_', k write(longname,'(A22,i1)') 'sea ice salinity lyr: ', k units='psu' - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), trim(trname), trim(longname), trim(units), trcrn(:,nt_sice+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), trim(trname), trim(longname), trim(units), trcrn(:,nt_sice+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end do case ('qsnon ') do k = 1,nslyr ! Separate variable for each snow layer write(trname,'(A6,i1)') 'qsnon_', k write(longname,'(A19,i1)') 'snow enthalpy lyr: ', k units='J/m3' - call def_stream3D((/nod2D, ncat/), (/nx_nh, ncat/), trim(trname), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh) + call def_stream3D((/ncat, nod2D/), (/ncat, nx_nh/), trim(trname), trim(longname), trim(units), trcrn(:,nt_qsno+k-1,:), io_list_icepack(i)%freq, io_list_icepack(i)%unit, io_list_icepack(i)%precision, mesh, .true.) end do ! Average over categories case ('iage ') From 63b9c15c0d5023003aa6cef13c3e6a9b2d38ab81 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Wed, 10 Feb 2021 11:33:40 +0100 Subject: [PATCH 52/54] Switch off Icepack by default --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 122359626..95b7e7b78 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,7 +11,7 @@ set(TOPLEVEL_DIR ${CMAKE_CURRENT_LIST_DIR}) set(FESOM_COUPLED OFF CACHE BOOL "compile fesom standalone or with oasis support (i.e. coupled)") set(OIFS_COUPLED OFF CACHE BOOL "compile fesom coupled to OpenIFS. (Also needs FESOM_COUPLED to work)") set(CRAY OFF CACHE BOOL "compile with cray ftn") -set(USE_ICEPACK ON CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") +set(USE_ICEPACK OFF CACHE BOOL "compile fesom with the Iceapck modules for sea ice column physics.") #set(VERBOSE OFF CACHE BOOL "toggle debug output") #add_subdirectory(oasis3-mct/lib/psmile) add_subdirectory(src) From d9c59069660e35ece4d3eebf2e9706425fb98c72 Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 11 Feb 2021 12:32:05 +0100 Subject: [PATCH 53/54] =?UTF-8?q?bugfix=20for=20gfortran=20=E2=80=93=20for?= =?UTF-8?q?got=20use=20mod=5Fmesh?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/icepack_drivers/icedrv_main.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/icepack_drivers/icedrv_main.F90 b/src/icepack_drivers/icedrv_main.F90 index 16817d83d..2daf1ea91 100644 --- a/src/icepack_drivers/icedrv_main.F90 +++ b/src/icepack_drivers/icedrv_main.F90 @@ -870,12 +870,14 @@ end subroutine step_icepack ! Initialize output module subroutine init_io_icepack(mesh) + use mod_mesh implicit none type(t_mesh), intent(in), target :: mesh end subroutine init_io_icepack ! Initialize restart module subroutine init_restart_icepack(year, mesh) + use mod_mesh implicit none type(t_mesh), intent(in), target :: mesh integer(kind=int_kind), intent(in) :: year From 393282ad4413083493de8522d348e02ab542084d Mon Sep 17 00:00:00 2001 From: Lorenzo Zampieri Date: Thu, 11 Feb 2021 13:27:54 +0100 Subject: [PATCH 54/54] Now compilation with gfortran works --- src/icepack_drivers/icedrv_advection.F90 | 1 + src/icepack_drivers/icedrv_init.F90 | 1 + src/icepack_drivers/icedrv_io.F90 | 6 +++--- src/icepack_drivers/icedrv_set.F90 | 6 +++--- src/icepack_drivers/icedrv_step.F90 | 1 - 5 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 index 750ca1ae4..c15b3e47c 100644 --- a/src/icepack_drivers/icedrv_advection.F90 +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -102,6 +102,7 @@ module subroutine init_advection_icepack(mesh) use o_param use o_mesh use g_parsup + use mod_mesh implicit none diff --git a/src/icepack_drivers/icedrv_init.F90 b/src/icepack_drivers/icedrv_init.F90 index 33c36b169..aaea17469 100644 --- a/src/icepack_drivers/icedrv_init.F90 +++ b/src/icepack_drivers/icedrv_init.F90 @@ -916,6 +916,7 @@ module subroutine init_icepack(mesh) use icepack_intfc, only: icepack_init_fsd use icepack_intfc, only: icepack_init_fsd_bounds use icepack_intfc, only: icepack_warnings_flush + use mod_mesh implicit none diff --git a/src/icepack_drivers/icedrv_io.F90 b/src/icepack_drivers/icedrv_io.F90 index 61886bbe5..cb07079f4 100644 --- a/src/icepack_drivers/icedrv_io.F90 +++ b/src/icepack_drivers/icedrv_io.F90 @@ -61,6 +61,9 @@ module subroutine init_io_icepack(mesh) type(io_entry), save, allocatable, target :: io_list_icepack(:) + namelist /nml_listsize / io_listsize + namelist /nml_list_icepack / io_list_icepack + #include "../associate_mesh.h" ! Get the tracers information from icepack @@ -86,9 +89,6 @@ module subroutine init_io_icepack(mesh) tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & tr_bgc_hum_out=tr_bgc_hum) - namelist /nml_listsize / io_listsize - namelist /nml_list_icepack / io_list_icepack - ! OPEN and read namelist for icepack I/O open( unit=nm_io_unit, file='namelist.io', form='formatted', access='sequential', status='old', iostat=iost ) if (iost == 0) then diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 index 08c2e4306..4638073f3 100644 --- a/src/icepack_drivers/icedrv_set.F90 +++ b/src/icepack_drivers/icedrv_set.F90 @@ -158,9 +158,7 @@ module subroutine set_icepack() !----------------------------------------------------------------- ! Namelist definition !----------------------------------------------------------------- - - nml_filename = 'namelist.icepack' ! name of icepack namelist file - + namelist / env_nml / & nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & @@ -200,6 +198,8 @@ module subroutine set_icepack() formdrag, highfreq, natmiter, & tfrz_option, wave_spec_type, dragio + nml_filename = 'namelist.icepack' ! name of icepack namelist file + !----------------------------------------------------------------- ! env namelist - STANDARD VALUES !----------------------------------------------------------------- diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 index 51cfd7d71..ed5d047eb 100644 --- a/src/icepack_drivers/icedrv_step.F90 +++ b/src/icepack_drivers/icedrv_step.F90 @@ -7,7 +7,6 @@ submodule (icedrv_main) icedrv_step - use icedrv_constants, only: c0, c4, nu_diag, ice_stderr use icedrv_kinds use icedrv_system, only: icedrv_system_abort use icepack_intfc, only: icepack_warnings_flush