diff --git a/.gitignore b/.gitignore index bdb33f7e4..cce77c72d 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,6 @@ *.x #*.out *~ +*.swp +src/icepack_drivers/Icepack +/work_* diff --git a/CMakeLists.txt b/CMakeLists.txt index 1f1b82626..95b7e7b78 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 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/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.era5 b/config/namelist.forcing.era5 new file mode 100644 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.forcing.ncep b/config/namelist.forcing.ncep new file mode 100644 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/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 new file mode 100644 index 000000000..ed0dd4d4c --- /dev/null +++ b/config/namelist.icepack @@ -0,0 +1,146 @@ +&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) + 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 = .false. + 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 + ksno = 0.3 +/ + +&shortwave_nml + shortwave = 'ccsm3' + albedo_type = 'ccsm3' + albicev = 0.78 + albicei = 0.36 + albsnowv = 0.98 + albsnowi = 0.70 + albocn = 0.1 + 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. + P_star = 27000. + C_star = 20. +/ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!! 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.icepack.cesm.ponds b/config/namelist.icepack.cesm.ponds new file mode 100644 index 000000000..51aa33191 --- /dev/null +++ b/config/namelist.icepack.cesm.ponds @@ -0,0 +1,144 @@ +&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. + P_star = 27000. + C_star = 20. +/ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!! 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/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 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 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/src/CMakeLists.txt b/src/CMakeLists.txt index b3679c409..367abfad0 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -7,7 +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) +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) @@ -62,6 +68,9 @@ endif() if(${OIFS_COUPLED}) target_compile_definitions(${PROJECT_NAME} PRIVATE __oifs) endif() +if(${USE_ICEPACK}) + target_compile_definitions(${PROJECT_NAME} PRIVATE __icepack) +endif() if(${VERBOSE}) target_compile_definitions(${PROJECT_NAME} PRIVATE VERBOSE) endif() diff --git a/src/fvom_main.F90 b/src/fvom_main.F90 index 45d250b72..6d2f42941 100755 --- a/src/fvom_main.F90 +++ b/src/fvom_main.F90 @@ -23,9 +23,16 @@ program main use diagnostics use mo_tidal use fesom_version_info_module + +! Define icepack module +#if defined (__icepack) +use icedrv_main, only: set_icepack, init_icepack, alloc_icepack +#endif + #if defined (__oasis) use cpl_driver #endif + IMPLICIT NONE integer :: n, nsteps, offset, row, i, provided @@ -36,8 +43,7 @@ program main real(kind=real32) :: mean_rtime(15), max_rtime(15), min_rtime(15) real(kind=real32) :: runtime_alltimesteps -type(t_mesh), target, save :: mesh - +type(t_mesh), target, save :: mesh #ifndef __oifs !ECHAM6-FESOM2 coupling: cpl_oasis3mct_init is called here in order to avoid circular dependencies between modules (cpl_driver and g_PARSUP) @@ -96,6 +102,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() @@ -167,6 +184,7 @@ program main if (use_global_tides) then call foreph_ini(yearnew, month) end if + do n=1, nsteps if (use_global_tides) then call foreph(mesh) diff --git a/src/ice_EVP.F90 b/src/ice_EVP.F90 index e9357e80d..cd994f5db 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, strength +#endif + implicit none real(kind=WP), intent(in) :: ice_strength(mydim_elem2D) @@ -117,8 +122,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 (__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 end do + end subroutine stress_tensor !=================================================================== subroutine stress_tensor_no1(ice_strength, mesh) @@ -389,6 +401,11 @@ subroutine EVPdynamics(mesh) USE g_comm_auto use ice_EVP_interfaces +#if defined (__icepack) + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem, strength + use icedrv_main, only: icepack_to_fesom +#endif + IMPLICIT NONE integer :: steps, shortstep real(kind=WP) :: rdt, asum, msum, r_a, r_b @@ -413,6 +430,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) @@ -475,7 +505,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) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +#else + ice_strength(el) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +#endif ice_strength(el) = 0.5_WP*ice_strength(el) !___________________________________________________________________ @@ -522,7 +556,11 @@ subroutine EVPdynamics(mesh) asum = sum(a_ice(elnodes))/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) = pstar*msum*exp(-c_pressure*(1.0_WP-asum)) +#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: @@ -547,8 +585,14 @@ 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 - + call stress_tensor(ice_strength, mesh) call stress2rhs(inv_areamass,ice_strength, mesh) @@ -597,4 +641,6 @@ subroutine EVPdynamics(mesh) call exchange_nod(U_ice,V_ice) END DO + + end subroutine EVPdynamics diff --git a/src/ice_maEVP.F90 b/src/ice_maEVP.F90 index b10d4ff11..0dbdc8543 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, strength +#endif + implicit none integer :: elem, elnodes(3) @@ -90,7 +95,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 @@ -103,6 +112,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: @@ -275,6 +290,11 @@ subroutine EVPdynamics_m(mesh) use g_parsup use g_comm_auto +#if defined (__icepack) + use icedrv_main, only: rdg_conv_elem, rdg_shear_elem, strength + use icedrv_main, only: icepack_to_fesom +#endif + implicit none integer :: steps, shortstep, i, ed,n real(kind=WP) :: rdt, drag, det @@ -307,6 +327,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 @@ -407,8 +437,7 @@ 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 - + asum=sum(a_ice(elnodes))*val3 pressure_fac(el) = det2*pstar*msum*exp(-c_pressure*(1.0_WP-asum)) endif end do @@ -422,6 +451,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 @@ -468,6 +502,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: @@ -564,6 +603,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) @@ -609,8 +653,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 @@ -631,6 +679,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, strength +#endif + implicit none integer :: elem, elnodes(3) @@ -681,8 +734,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 @@ -695,6 +752,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: @@ -720,7 +783,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 @@ -736,6 +803,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/ice_modules.F90 b/src/ice_modules.F90 index d7a5ba8f4..ad8ece6d6 100755 --- a/src/ice_modules.F90 +++ b/src/ice_modules.F90 @@ -41,8 +41,10 @@ MODULE i_PARAM logical :: ice_free_slip=.false. 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, ellipse, c_pressure, delta_min, evp_rheol_steps, Cd_oce_ice, & ice_gamma_fct, ice_diff, theta_io, ice_ave_steps, alpha_evp, beta_evp, c_aevp + END MODULE i_PARAM ! !============================================================================= diff --git a/src/ice_oce_coupling.F90 b/src/ice_oce_coupling.F90 index 14c1fe29d..748552beb 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 @@ -24,6 +29,12 @@ subroutine oce_fluxes_mom(mesh) ! 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 cavity node skip it @@ -136,23 +147,29 @@ end subroutine ocean2ice ! !_______________________________________________________________________________ subroutine oce_fluxes(mesh) - use MOD_MESH - use g_CONFIG - use o_ARRAYS - use i_ARRAYS - use g_comm_auto - use g_forcing_param, only: use_virt_salt - use g_forcing_arrays - use g_PARSUP - use g_support - use i_therm_param - - implicit none - type(t_mesh), intent(in) , target :: mesh - integer :: n, elem, elnodes(3),n1 - real(kind=WP) :: rsss, net - real(kind=WP), allocatable :: flux(:) - + + use MOD_MESH + USE g_CONFIG + use o_ARRAYS + use i_ARRAYS + use g_comm_auto + use g_forcing_param, only: use_virt_salt + use g_forcing_arrays + use g_PARSUP + use g_support + use i_therm_param + +#if defined (__icepack) + use icedrv_main, only: icepack_to_fesom, & + init_flux_atm_ocn +#endif + + implicit none + type(t_mesh), intent(in) , target :: mesh + integer :: n, elem, elnodes(3),n1 + real(kind=WP) :: rsss, net + real(kind=WP), allocatable :: flux(:) + #include "associate_mesh.h" allocate(flux(myDim_nod2D+eDim_nod2D)) @@ -171,9 +188,33 @@ 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, & + fsalt_out=real_salt_flux, & + dhi_dt_out=thdgrsn, & + dhs_dt_out=thdgr, & + evap_ocn_out=evaporation ) + + 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 heat_flux = -net_heat_flux water_flux = -fresh_wa_flux - +#endif + if (use_cavity) call cavity_heat_water_fluxes_3eq(mesh) !!PS if (use_cavity) call cavity_heat_water_fluxes_2eq(mesh) diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index 3e622e3cb..d964f85aa 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -158,20 +158,35 @@ subroutine ice_array_setup(mesh) end subroutine ice_array_setup ! ! +! !_______________________________________________________________________________ ! Sea ice model step subroutine ice_timestep(step, mesh) - use i_arrays - use o_param - use g_parsup - use g_CONFIG - use i_PARAM, only: whichEVP - use mod_mesh - implicit none - type(t_mesh), intent(in) , target :: mesh - integer :: step,i - REAL(kind=WP) :: t0,t1, t2, t3 - t0=MPI_Wtime() +use i_arrays +use o_param +use g_parsup +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,i +REAL(kind=WP) :: t0,t1, t2, t3 + +#if defined (__icepack) +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 @@ -225,20 +240,26 @@ 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 /* (__icepack) */ t3=MPI_Wtime() - - !___________________________________________________________________________ rtime_ice = rtime_ice + (t3-t0) 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 - write(*,"(A, ES10.3)") ' Ice Advect. :', t2-t1 - write(*,"(A, ES10.3)") ' Ice Thermodyn. :', t3-t2 - write(*,*) ' _______________________________' - write(*,"(A, ES10.3)") ' Ice TOTAL :', t3-t0 - write(*,*) - endif + write(*,*) '___ICE STEP EXECUTION TIMES____________________________' +#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 /* (__icepack) */ + write(*,*) ' _______________________________' + write(*,"(A, ES10.3)") ' Ice TOTAL :', t3-t0 + write(*,*) + endif + end subroutine ice_timestep ! ! 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 diff --git a/src/icepack_drivers/icedrv_advection.F90 b/src/icepack_drivers/icedrv_advection.F90 new file mode 100644 index 000000000..c15b3e47c --- /dev/null +++ b/src/icepack_drivers/icedrv_advection.F90 @@ -0,0 +1,1330 @@ +!======================================================================= +! +! This submodule contains the subroutines +! for the advection of sea ice tracers +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + +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 + + real(kind=dbl_kind), allocatable, dimension(:) :: & + d_tr, trl, & + rhs_tr, rhs_trdiv, & + icepplus, icepminus, & + mass_matrix + + real(kind=dbl_kind), allocatable, dimension(:,:) :: & + icefluxes + + ! Variables needed for advection + + contains + + subroutine tg_rhs_icepack(mesh, trc) + + use mod_mesh + 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(nx), 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(elnodes)) + vm = sum(vvel(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(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)) + enddo + enddo + + end subroutine tg_rhs_icepack + + !======================================================================= + + module subroutine init_advection_icepack(mesh) + + use o_param + use o_mesh + use g_parsup + use mod_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(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 init_advection_icepack + + !======================================================================= + + subroutine fill_mass_matrix_icepack(mesh) + + use mod_mesh + use o_mesh + use i_param + 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_param + use g_parsup + + + 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(nx), 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_param + use g_parsup + + + 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(nx), 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 o_param + use i_param + use g_parsup + + + 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(nx), 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 o_param + use i_param + use g_parsup + + + 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(nx), 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(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(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(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(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 + 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 o_param + use i_param + use g_parsup + + + 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(nx), 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) + + use mod_mesh + + implicit none + + real(kind=dbl_kind), dimension(nx), intent(inout) :: trc + type(t_mesh), target, intent(in) :: mesh + + ! Driving sequence + 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 update_for_div_icepack(mesh, trc) + + end subroutine fct_solve_icepack + + !======================================================================= + + module subroutine tracer_advection_icepack(mesh) + + use mod_mesh + use icepack_intfc, only: icepack_aggregate + use icepack_itd, only: cleanup_itd + use g_config, only: dt + + implicit none + + integer (kind=int_kind) :: ntrcr, ntrace, narr, nbtrcr, i, & + 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) ) + + works(:,:) = c0 + + call state_to_work (ntrcr, narr, works(:,:)) + + ! Advect each tracer + + do nt = 1, narr + call fct_solve_icepack ( mesh, works(:,nt) ) + end do + + call work_to_state (ntrcr, narr, works(:,:)) + + ! cut off icepack + + call cut_off_icepack + + do i=1,nx + if (ncat < 0) 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 + + deallocate(works) + + end subroutine tracer_advection_icepack + + !======================================================================= + + subroutine work_to_state (ntrcr, narr, works) + + use icepack_intfc, only: icepack_compute_tracers + + integer (kind=int_kind), intent(in) :: ntrcr, narr + + 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_lvl, 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, & + 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) + 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) + call icepack_warnings_flush(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + trcrn(:,:,:) = c0 + aicen(:,:) = c0 + vicen(:,:) = c0 + vsnon(:,:) = c0 + aice0(:) = c0 + + ! Open water fraction + + 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 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 + +! 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 + + 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 do + end if ! ktherm==1 + + end subroutine work_to_state + + !======================================================================= + + subroutine state_to_work (ntrcr, narr, works) + + integer (kind=int_kind), intent(in) :: ntrcr, narr + + 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(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + 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) + 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(ice_stderr,*) & + "Wrong number of arrays in transport bound call" + + end subroutine state_to_work + + !======================================================================= + + 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 + + ! local variables + + 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) :: & + 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 , & + ntrcr + + real (kind=dbl_kind), dimension(ncat) :: & + aicecat + + real (kind=dbl_kind) :: & + rhos, Lfresh, & + cp_ice, cp_ocn, & + qrd_snow, qrd_ice, & + Tsfc, exc, & + depressT, Tmin, & + T_air_C, hice, & + puny, Tsmelt, & + small, rhoi, & + hpnd_max + + + + 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, nt_apnd, nt_hpnd, nt_ipnd, nt_FY, nt_iage + + 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 ) + 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_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, & + Tsmelt_out=Tsmelt, ktherm_out=ktherm, heat_capacity_out=heat_capacity) + call icepack_warnings_flush(ice_stderr) + + 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)) + endif + enddo + enddo + endif + + 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. + + do n = 1, ncat ! For each thickness cathegory + do i = 1, nx ! For each grid point + + 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 + + ! Maximum ice enthalpy + + 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 + endif + + ! 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. + + enddo !nilyr + + if (flag_cold_ice) then + + trcrn(i,nt_Tsfc,n) = Tsfc + + do k = 1, nilyr + trcrn(i,nt_qice+k-1,n) = min(qin_max(k), qin(k)) + 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) + enddo + else ! No snow + trcrn(i,nt_qsno:nt_qsno+nslyr-1,n) = c0 + endif + + 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(i) + + 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) + enddo ! nslyr + endif ! flag snow + endif ! 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(i) + + 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 + 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 + 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 + 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) > 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 + 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 .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_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 .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 + 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 + 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(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + end subroutine cut_off_icepack + +end submodule icedrv_advection + + diff --git a/src/icepack_drivers/icedrv_allocate.F90 b/src/icepack_drivers/icedrv_allocate.F90 new file mode 100644 index 000000000..e2d6d6108 --- /dev/null +++ b/src/icepack_drivers/icedrv_allocate.F90 @@ -0,0 +1,456 @@ +! ------------------------------------------------------------- +! 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 + + 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(ice_stderr) + 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(ice_stderr,*) '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) on the nodes + vvel (nx) , & ! y-component of velocity (m/s) on the nodes + 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,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(ice_stderr,*) 'Memory issue in task ', mype + if (ierr/=0) call icedrv_system_abort(file=__FILE__,line=__LINE__,string=subname) + + allocate ( & + 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(ice_stderr,*) 'Memory issue in task ', mype + 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 + ! --------------------------------------------------------------- + + 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) + 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) + 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 + 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) + 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) + 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 + 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_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(ice_stderr,*) 'Memory issue in task ', mype + 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 + ! --------------------------------------------------------------- + + 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) 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 + + 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(ice_stderr) + 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) 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 + +! ------------------------------------------------------------------------------ + + 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_constants.F90 b/src/icepack_drivers/icedrv_constants.F90 new file mode 100644 index 000000000..733253456 --- /dev/null +++ b/src/icepack_drivers/icedrv_constants.F90 @@ -0,0 +1,106 @@ +!======================================================================= +! +! 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 = 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 + + !----------------------------------------------------------------- + ! 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 + + !----------------------------------------------------------------- + ! 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..aaea17469 --- /dev/null +++ b/src/icepack_drivers/icedrv_init.F90 @@ -0,0 +1,1189 @@ +!======================================================================= +! +! This submodule 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 icepack_intfc, only: icepack_init_wave + use icedrv_system, only: icedrv_system_abort + + contains + + 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(ice_stderr) + 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 init_state_var() + + end subroutine init_state + +!======================================================================= + + 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 + 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(ice_stderr) + 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_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 + 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(ice_stderr) + 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 + fresh_tot(:) = c0 + fsalt (:) = c0 + fhocn (:) = c0 + fhocn_tot(:) = 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() + + implicit none + + 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() + + implicit none + + 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(ice_stderr) + 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() + + implicit none + + 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(ice_stderr) + 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() + + implicit none + + 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 + +!======================================================================= + + subroutine init_thermo_vertical() + + use icepack_intfc, only: icepack_init_thermo + + implicit none + + 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(ice_stderr) + 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 + + 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 + +!======================================================================= + + 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 + 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(ice_stderr) + 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(ice_stderr) + call icepack_init_orbit() + call icepack_warnings_flush(ice_stderr) + 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(ice_stderr) + 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 + +!======================================================================= + + subroutine init_fsd() + + implicit none + + 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 + +!======================================================================= + + subroutine init_wave_spec() + + 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() + + 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 + +!======================================================================= + + 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 + use mod_mesh + + 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(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(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + 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 + call icepack_warnings_flush(ice_stderr) + + 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(ice_stderr) + if (icepack_warnings_aborted(subname)) then + call icedrv_system_abort(file=__FILE__,line=__LINE__) + 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 + + 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 + + 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 + +!======================================================================= + + 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 + + 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(ice_stderr) + 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 + + ! For the moment we start we no sea ice + + 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) < 0.0_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 + !----------------------------------------------------------------- + + 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(ice_stderr) + 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_io.F90 b/src/icepack_drivers/icedrv_io.F90 new file mode 100644 index 000000000..cb07079f4 --- /dev/null +++ b/src/icepack_drivers/icedrv_io.F90 @@ -0,0 +1,445 @@ +!======================================================================= +! +! 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 icepack_intfc, only: icepack_warnings_flush + use icepack_intfc, only: icepack_warnings_aborted + use icedrv_system, only: icedrv_system_abort + + contains + + module subroutine init_io_icepack(mesh) + + use mod_mesh + use g_parsup + use io_meandata, only: def_stream3D, def_stream2D + + 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(:) + + namelist /nml_listsize / io_listsize + namelist /nml_list_icepack / 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) + + ! 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 ('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((/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((/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((/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 ') + 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_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((/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((/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((/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((/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((/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((/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((/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((/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((/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((/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((/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 ') + 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 ') + 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 + end do + + 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 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 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 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 + + 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_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_main.F90 b/src/icepack_drivers/icedrv_main.F90 new file mode 100644 index 000000000..2daf1ea91 --- /dev/null +++ b/src/icepack_drivers/icedrv_main.F90 @@ -0,0 +1,899 @@ +!======================================================================= +! +! 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 + use g_parsup, only: mype + + implicit none + + !======================================================================= +!--------- List here all the public variables and +!--------- subroutines to be seen outside icepack + !======================================================================= + + public :: & + ! Variables + ncat, rdg_conv_elem, rdg_shear_elem, strength, & + ! Subroutines + set_icepack, alloc_icepack, init_icepack, step_icepack, & + icepack_to_fesom, icepack_to_fesom_single_point, & + init_flux_atm_ocn, init_io_icepack, init_restart_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 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 + 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) on the nodes + vvel(:) , & ! y-component of velocity (m/s) on the nodes + 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) + 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) + 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), 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 + 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 a tracer + + 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) + + 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 + + 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 + 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) + 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) + 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 + !======================================================================= + + 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 ? + 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 + + real (kind=dbl_kind), allocatable, save :: & ! DIM nx + lon_val(:), & ! mesh nodes longitude + lat_val(:) ! mesh nodes latitude + + !======================================================================= + ! 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 all + 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 + 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 all + module subroutine init_icepack(mesh) + use mod_mesh + implicit none + 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 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, & + dhs_dt_out, dhi_dt_out, & + fsalt_out, evap_ocn_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, & + fsalt_out, & + 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 + 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 + + ! 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, & + time_advec, & + time_evp + type(t_mesh), intent(in), target :: mesh + 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 + end subroutine init_restart_icepack + + ! Cut off Icepack + 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 + implicit none + end subroutine cut_off_icepack + + end interface + + end module icedrv_main diff --git a/src/icepack_drivers/icedrv_set.F90 b/src/icepack_drivers/icedrv_set.F90 new file mode 100644 index 000000000..4638073f3 --- /dev/null +++ b/src/icepack_drivers/icedrv_set.F90 @@ -0,0 +1,933 @@ +!======================================================================= +! +! This module defines and and initializes the namelists +! +! Author: L. Zampieri ( lorenzo.zampieri@awi.de ) +! +!======================================================================= + + submodule (icedrv_main) icedrv_set + + 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_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 + + contains + + module subroutine set_icepack() + + use g_parsup, only: myDim_nod2D, eDim_nod2D, & + myDim_elem2D, eDim_elem2D, & + mpi_comm_fesom + use i_param, only: whichEVP + use i_param, only: cd_oce_ice, Pstar, c_pressure + use i_therm_param, only: albw + + implicit none + + ! local variables + + character(len=char_len) :: nml_filename, diag_filename + character(len=*), parameter :: subname = '(set_icepack)' + 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, mpi_error + integer (kind=int_kind) :: n + real (kind=dbl_kind) :: rpcesm, rplvl, rptopo, puny + logical (kind=log_kind) :: tr_pond, wave_spec + + ! 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 + real (kind=dbl_kind) :: P_star + real (kind=dbl_kind) :: C_star + + ! 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) :: albocn + 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 + real (kind=dbl_kind) :: ksno + + ! 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 + 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 + character (len=char_len) :: tfrz_option + logical (kind=log_kind) :: oceanmixed_ice + character (len=char_len) :: wave_spec_type + + + !----------------------------------------------------------------- + ! Namelist definition + !----------------------------------------------------------------- + + namelist / env_nml / & + nicecat, nfsdcat, nicelyr, nsnwlyr, ntraero, trzaero, tralg, & + trdoc, trdic, trdon, trfed, trfep, nbgclyr, trbgcz, & + trzs, trbri, trage, trfy, trlvl, trpnd, trbgcs, & + ndtd + + 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, ksno + + namelist / dynamics_nml / & + kstrength, krdg_partic, krdg_redist, mu_rdg, & + Cf, P_star, C_star + + namelist / shortwave_nml / & + shortwave, albedo_type, albocn, & + albicev, albicei, albsnowv, albsnowi, & + ahmax, R_ice, R_pnd, R_snw, & + dT_mlt, rsnw_mlt, kalg + + namelist / ponds_nml / & + hs0, dpscale, frzpnd, hp1, & + rfracmin, rfracmax, pndaspect, hs1 + + 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, dragio + + nml_filename = 'namelist.icepack' ! name of icepack namelist file + + !----------------------------------------------------------------- + ! 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 + ndtd = 1 ! dynamic time steps per thermodynamic time step + + !----------------------------------------------------------------- + ! 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 + 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 + 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, 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, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! other default values + !----------------------------------------------------------------- + + 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 + + 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) + 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 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 + if (mype == 0) write(*,*) 'Error while opening diagnostic file' + if (mype == 0) 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 (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.' + 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' + if (mype == 0) 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' + if (mype == 0) 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.' + if (mype == 0) 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 (ice_stderr,*) '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. + max_ntrcr = max_ntrcr + 2 ! tr_lvl brings two more tracers + 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 with FESOM2 ' + 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) ' albocn = ', albocn + 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 + write(nu_diag,1005) ' ksno = ', ksno + + 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 + 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 + 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 + 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 + + if (mype == 0) then + + 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(ice_stderr,*)'ERROR: nt_apnd:',nt_apnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_hpnd==0) then + write(ice_stderr,*)'ERROR: nt_hpnd:',nt_hpnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_ipnd==0) then + write(ice_stderr,*)'ERROR: nt_ipnd:',nt_ipnd + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_alvl==0) then + write(ice_stderr,*)'ERROR: nt_alvl:',nt_alvl + call icedrv_system_abort(file=__FILE__,line=__LINE__) + elseif (nt_vlvl==0) then + write(ice_stderr,*)'ERROR: nt_vlvl:',nt_vlvl + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + endif + + endif ! mype == 0 + + 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 + !----------------------------------------------------------------- + + ! 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, & + 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, & + 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) + 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(ice_stderr) + 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 + +!======================================================================= + + module subroutine set_grid_icepack(mesh) + + use mod_mesh + + 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(puny_out=puny) + call icepack_warnings_flush(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__, line=__LINE__) + + 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,i) >= -puny) lmask_n(i) = .true. ! N. Hem. + 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 + +!======================================================================= + + end submodule icedrv_set + + + + + + + diff --git a/src/icepack_drivers/icedrv_step.F90 b/src/icepack_drivers/icedrv_step.F90 new file mode 100644 index 000000000..ed5d047eb --- /dev/null +++ b/src/icepack_drivers/icedrv_step.F90 @@ -0,0 +1,1316 @@ +!======================================================================= +! +! Contains Icepack component driver routines common to all drivers. +! +! Authors: Lorenzo Zampieri ( lorenzo.zampieri@awi.de ) +!======================================================================= + +submodule (icedrv_main) icedrv_step + + 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(ice_stderr) + 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(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(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, 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(ice_stderr) + 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(ice_stderr) + 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(ice_stderr) + 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(ice_stderr) + 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(ice_stderr) + 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(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(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(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + 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 + + call icepack_warnings_flush(ice_stderr) + 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(ice_stderr) + 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(ice_stderr) + 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, & ! + narr + + 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(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + ! Ridging + !----------------------------------------------------------------- + + narr = 1 + ncat * (3 + ntrcr) ! max number of state variable arrays + + 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 cut_off_icepack + + call icepack_warnings_flush(ice_stderr) + 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(ice_stderr) + 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(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(ice_stderr) + 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(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(ice_stderr) + 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(ice_stderr) + 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(ice_stderr) + 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(ice_stderr) + 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), fsalt=fsalt(i), & + sss=sss(i) ) + enddo ! i + + call icepack_warnings_flush(ice_stderr) + 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, fsalt, & + sss) + + use i_therm_param, only: emiss_wat + use g_forcing_param, only: use_virt_salt + + 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) + sss , & ! sea surface salinity + frain , & ! rainfall 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) + 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) + 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, & ! 0 C in K + Lfresh, & + 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, & + ice_ref_salinity_out=ice_ref_salinity, & + 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 + + 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) + + 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(ice_stderr) + 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(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 + use mod_mesh + + implicit none + + integer (kind=int_kind) :: & + k, i ! for loop indexes + + 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 + t1, t2, t3, t4 + + real (kind=dbl_kind), intent(out) :: & + time_therm, & + time_advec, & + time_evp + + 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 + !----------------------------------------------------------------- + + 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(ice_stderr) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + ! TODO: Add appropriate timing + + !----------------------------------------------------------------- + ! copy variables from fesom2 (also ice velocities) + !----------------------------------------------------------------- + + call fesom_to_icepack(mesh) + + !----------------------------------------------------------------- + ! tendencies needed by fesom + !----------------------------------------------------------------- + + dhi_dt(:) = vice(:) + dhs_dt(:) = vsno(:) + + !----------------------------------------------------------------- + ! 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 + + !----------------------------------------------------------------- + ! tendencies needed by fesom + !----------------------------------------------------------------- + + dhi_dt(:) = ( vice(:) - dhi_dt(:) ) / dt + dhs_dt(:) = ( vsno(:) - dhi_dt(:) ) / dt + + ! clean up, update tendency diagnostics + + offset = dt + call update_state (dt, daidtt, dvidtt, dagedtt, offset) + + !----------------------------------------------------------------- + ! dynamics, transport, ridging + !----------------------------------------------------------------- + + 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) + + do k = 1, ndtd + + !----------------------------------------------------------------- + ! EVP + !----------------------------------------------------------------- + + t2 = MPI_Wtime() + + 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 + + !----------------------------------------------------------------- + ! update ice velocities + !----------------------------------------------------------------- + + call fesom_to_icepack(mesh) + + !----------------------------------------------------------------- + ! advect tracers + !----------------------------------------------------------------- + + t2 = MPI_Wtime() + + call tracer_advection_icepack(mesh) + + t3 = MPI_Wtime() + time_advec = t3 - t2 + + !----------------------------------------------------------------- + ! 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) + + !----------------------------------------------------------------- + ! icepack timing + !----------------------------------------------------------------- + + t4 = MPI_Wtime() + time_therm = t4 - t1 - time_advec - time_evp + + !time_advec = c0 + !time_therm = c0 + !time_evp = c0 + + end subroutine step_icepack + + +!======================================================================= + +end submodule icedrv_step + +!======================================================================= diff --git a/src/icepack_drivers/icedrv_system.F90 b/src/icepack_drivers/icedrv_system.F90 new file mode 100644 index 000000000..8a130bbd7 --- /dev/null +++ b/src/icepack_drivers/icedrv_system.F90 @@ -0,0 +1,62 @@ +!======================================================================= +! +! Diagnostic information output during run +! +! author: Tony Craig + + module icedrv_system + + use icedrv_kinds + use g_parsup, only: par_ex + use icedrv_constants, only: ice_stderr + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + + implicit none + + public :: icedrv_system_abort + + private + +!======================================================================= + + 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(ice_stderr,*) ' ' + + call icepack_warnings_flush(ice_stderr) + + 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 + + call par_ex(1) + stop + + end subroutine icedrv_system_abort + +!======================================================================= + + end module icedrv_system + +!======================================================================= + diff --git a/src/icepack_drivers/icedrv_transfer.F90 b/src/icepack_drivers/icedrv_transfer.F90 new file mode 100644 index 000000000..6ba70afa6 --- /dev/null +++ b/src/icepack_drivers/icedrv_transfer.F90 @@ -0,0 +1,240 @@ +!======================================================================= +! +! 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(mesh) + + 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 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 o_param, only: mstep + use mod_mesh + use o_mesh + use g_parsup + use g_clock + + 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(:) + 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 + + 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 + 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 + + 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 + + call icepack_query_parameters(calc_strair_out=calc_strair, cprho_out=cprho) + call icepack_warnings_flush(ice_stderr) + 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 i = 1, nx_nh + tvol = c0 + tx = c0 + ty = c0 + 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(i) = tx / tvol + rdg_shear(i) = ty / tvol + enddo + + 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 + +!======================================================================= + + + module subroutine icepack_to_fesom( nx_in, & + aice_out, vice_out, vsno_out, & + fhocn_tot_out, fresh_tot_out, & + strocnxT_out, strocnyT_out, & + dhs_dt_out, dhi_dt_out, & + fsalt_out, evap_ocn_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, & + fsalt_out, & + dhs_dt_out, & + dhi_dt_out, & + evap_ocn_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 + 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 + +!======================================================================= + + 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 diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index b7747d5b2..a596887bb 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -8,7 +8,7 @@ module io_MEANDATA implicit none #include "netcdf.inc" private - public output, finalize_output + public :: def_stream2D, def_stream3D, output, finalize_output ! !-------------------------------------------------------------------------------------------- ! @@ -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 @@ -501,6 +502,9 @@ function mesh_dimname_from_dimsize(size, mesh) result(name) use mod_mesh use g_PARSUP use diagnostics +#if defined (__icepack) + use icedrv_main, only: ncat ! number of ice thickness cathegories +#endif implicit none integer :: size type(t_mesh) mesh @@ -516,6 +520,10 @@ function mesh_dimname_from_dimsize(size, mesh) result(name) name='nz1' elseif (size==std_dens_N) then name='ndens' +#if defined (__icepack) + elseif (size==ncat) then + name='ncat' +#endif else name='unknown' if (mype==0) write(*,*) 'WARNING: unknown dimension in mean I/O with size of ', size @@ -556,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 @@ -656,10 +666,10 @@ subroutine write_mean(entry, entry_index) use io_gather_module implicit none type(Meandata), intent(inout) :: entry - integer :: size1, size2 - integer :: lev integer, intent(in) :: entry_index integer tag + integer :: i, size1, size2, size_gen, size_lev, order + integer :: c, lev ! Serial output implemented so far @@ -672,7 +682,7 @@ subroutine write_mean(entry, entry_index) size2=entry%glsize(2) 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 (entry%accuracy == i_real8) then if(mype==entry%root_rank) then if(.not. allocated(entry%aux_r8)) allocate(entry%aux_r8(size2)) end if @@ -698,7 +708,7 @@ subroutine write_mean(entry, entry_index) end if do lev=1, size1 if(.not. entry%is_elem_based) then - 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) + 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 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 @@ -725,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 @@ -743,6 +760,10 @@ subroutine output(istep, mesh) use mod_mesh use g_PARSUP use io_gather_module +#if defined (__icepack) + use icedrv_main, only: init_io_icepack +#endif + implicit none integer :: istep @@ -756,8 +777,12 @@ subroutine output(istep, mesh) ctime=timeold+(dayold-1.)*86400 if (lfirst) then - call ini_mean_io(mesh) - call init_io_gather() + call ini_mean_io(mesh) + call init_io_gather() +#if defined (__icepack) + call init_io_icepack(mesh) +#endif + call init_io_gather() end if call update_means @@ -843,6 +868,7 @@ subroutine output(istep, mesh) subroutine do_output_callback(entry_index) use g_PARSUP +use mod_mesh integer, intent(in) :: entry_index ! EO args type(Meandata), pointer :: entry @@ -869,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 @@ -882,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) @@ -906,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' diff --git a/src/io_restart.F90 b/src/io_restart.F90 index d65cb87f0..1961810c5 100644 --- a/src/io_restart.F90 +++ b/src/io_restart.F90 @@ -55,10 +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 + type(nc_file), save :: ip_id real(kind=WP) :: ctime !current time in seconds from the beginning of the year PRIVATE - PUBLIC :: restart, oid, iid + PUBLIC :: restart, oid, iid + PUBLIC :: ip_id, def_dim, def_variable_1d, def_variable_2d ! !-------------------------------------------------------------------------------------------- ! generic interface was required to associate variables of unknown rank with the pointers of the same rank @@ -191,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 @@ -206,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 @@ -217,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 @@ -253,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 @@ -434,9 +455,9 @@ 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 real(kind=WP) :: t0, t1, t2, t3 + integer :: i, lev, size1, size2, size_gen, size_lev, shape + integer :: c, order #include "associate_mesh.h" @@ -476,19 +497,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) - t0=MPI_Wtime() - if (size1==nod2D .or. size2==nod2D) call gather_nod (laux, aux) - if (size1==elem2D .or. size2==elem2D) call gather_elem(laux, aux) - t1=MPI_Wtime() + ! 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 t2=MPI_Wtime() #ifdef DEBUG @@ -521,8 +555,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 @@ -586,24 +620,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) 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"