diff --git a/CMakeLists.txt b/CMakeLists.txt index 0d4ca2784..0ec14dbc5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -18,7 +18,7 @@ set(USE_YAC OFF CACHE BOOL "compile fesom with yac") 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(OPENMP_REPRODUCIBLE OFF CACHE BOOL "serialize OpenMP loops that are critical for reproducible results") -set(RECOM_COUPLED OFF CACHE BOOL "compile fesom including biogeochemistry, REcoM3") +set(RECOM_COUPLED ON CACHE BOOL "compile fesom including biogeochemistry, REcoM3") set(CISO_COUPLED OFF CACHE BOOL "compile ciso coupled to REcoM3. RECOM_COUPLED has to be active") set(USE_MULTIO OFF CACHE BOOL "Use MULTIO for IO, either grib or binary for now. This also means path to MULTIO installation has to provided using env MULTIO_INSTALL_PATH='..' and multio configuration yamls must be present to run the model with MULTIO") set(OASIS_WITH_YAC OFF CACHE BOOL "Useing a version of OASIS compiled with YAC instead of SCRIP for interpolation?") diff --git a/config/bin_2p1z1d_tp/namelist.config b/config/bin_2p1z1d_tp/namelist.config new file mode 100644 index 000000000..d647c36cc --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.config @@ -0,0 +1,134 @@ +! ============================================================================ +! ============ Namelist file for FESOM2 general configuration ================ +! ============================================================================ +! This file contains the main configuration parameters for FESOM2, including: +! - Model identification and run settings +! - Time stepping and simulation duration +! - Initial time/date settings +! - File paths for mesh, forcing, and output +! - Restart and logging configuration +! - Vertical coordinate system (ALE) +! - Grid geometry and rotation +! - Calendar settings +! - Model components (ice, cavities, etc.) +! - Parallel decomposition +! - Iceberg settings +! ============================================================================ + +! ============================================================================ +! RUN IDENTIFICATION +! ============================================================================ +&modelname +runid = 'fesom' ! run identifier (used in output filenames) +/ + +! ============================================================================ +! TIME STEPPING AND RUN LENGTH +! ============================================================================ +×tep +step_per_day = 48 ! number of time steps per day (determines dt = 86400/step_per_day seconds) + ! common values: 32 (45min), 48 (30min), 72 (20min), 96 (15min), 192 (7min 30sec), + ! 216 (6min 40sec), 240 (6min), 288 (5min), 360 (4min), 720 (2min), 1440 (1min), 2880 (30sec) +run_length = 1 ! total length of simulation run +run_length_unit = 'y' ! unit for run_length: 'y' (years), 'm' (months), 'd' (days), 's' (steps) +/ + +! ============================================================================ +! INITIAL TIME/DATE SETTINGS +! ============================================================================ +&clockinit +timenew = 0.0 ! initial time within the day [seconds] (0.0 = midnight) +daynew = 1 ! initial day of the month (1-31) +yearnew = 2000 ! initial year +/ + +! ============================================================================ +! MESH, INITIALIZATION & OUTPUT PATHS +! ============================================================================ +&paths +MeshPath = '/albedo/work/projects/p_recompdaf/frbunsen/FESOM2/meshes/core2/' ! path to mesh files (nod2d.out, elem2d.out, etc.) +ClimateDataPath = '/albedo/work/user/yye/fesom2/initial_files/pi_init/' ! path to initial conditions (temperature, salinity) +ResultPath = './' ! path for output files and fesom.clock file +/ + +! ============================================================================ +! RESTART AND LOGGING CONFIGURATION +! ============================================================================ +&restart_log +restart_length = 1 ! frequency for netCDF restart files (required for d,h,s; y,m use 1) +restart_length_unit = 'y' ! unit: 'y' (years), 'm' (months), 'd' (days), 'h' (hours), 's' (steps), 'off' (disabled) +raw_restart_length = 1 ! frequency for raw core dump restart files +raw_restart_length_unit = 'off' ! unit: 'y', 'm', 'd', 'h', 's', 'off' +bin_restart_length = 1 ! frequency for binary derived type restart files +bin_restart_length_unit = 'off' ! unit: 'y', 'm', 'd', 'h', 's', 'off' +logfile_outfreq = 960 ! log file output frequency [number of time steps] +/ + +! ============================================================================ +! VERTICAL COORDINATE SYSTEM (ALE - Arbitrary Lagrangian-Eulerian) +! ============================================================================ +&ale_def +which_ALE = 'zstar' ! vertical coordinate type: + ! 'linfs' = linear free surface + ! 'zlevel' = z-level (fixed depth levels) + ! 'zstar' = z-star (terrain-following with SSH scaling) +use_partial_cell = .false. ! use partial bottom cells for better topography representation (not recommended) +/ + +! ============================================================================ +! GRID GEOMETRY AND ROTATION +! ============================================================================ +&geometry +cartesian = .false. ! use Cartesian coordinates (false = spherical Earth) +fplane = .false. ! use f-plane approximation (constant Coriolis parameter) +cyclic_length = 360 ! length of cyclic domain [degrees] (360 = global) +rotated_grid = .true. ! use rotated grid (typically for coupled models to avoid pole singularity) +force_rotation = .true. ! force grid rotation even if not coupled +alphaEuler = 50. ! first Euler angle (rotation around z-axis) [degrees] +betaEuler = 15. ! second Euler angle (rotation around new x-axis) [degrees] +gammaEuler = -90. ! third Euler angle (rotation around new z-axis) [degrees] + ! Euler angle convention: rotate first around z, then around new x, then around new z +/ + +! ============================================================================ +! CALENDAR SETTINGS +! ============================================================================ +&calendar +include_fleapyear = .true. ! include leap years in calendar (false = 365-day year, true = 365/366-day year) +/ + +! ============================================================================ +! MODEL COMPONENTS AND FEATURES +! ============================================================================ +&run_config +use_ice = .true. ! enable sea ice model +use_cavity = .false. ! enable ice shelf cavities +use_cavity_partial_cell = .false. ! use partial cells in ice shelf cavities (not recommended) +use_floatice = .false. ! enable floating ice (icebergs) +use_sw_pene = .true. ! enable shortwave radiation penetration into ocean +flag_debug = .false. ! enable debug output (verbose logging) +use_transit = .false. ! enable transient tracer module (CFCs, SF6, etc.) +num_fesom_groups = 1 +/ + +! ============================================================================ +! PARALLEL DECOMPOSITION (DOMAIN PARTITIONING) +! ============================================================================ +&machine +n_levels = 2 ! number of hierarchy levels for domain decomposition +n_part = 2, 128 ! number of partitions at each level (total CPUs = product of n_part) + ! example: 2 x 128 = 256 MPI tasks + ! adjust based on mesh size and available compute resources + ! maximum scaling reached at ~300 FESOM2 2D nodes per CPU (see first line in nod2d.out for number of 2D nodes) +/ + +! ============================================================================ +! ICEBERG SETTINGS +! ============================================================================ +&icebergs +use_icesheet_coupling = .false. ! enable ice sheet model +ib_num = 1 ! number of iceberg classes +use_icebergs = .false. ! enable iceberg module +steps_per_ib_step = 8 ! ocean time steps per iceberg time step (iceberg subcycling) +ib_async_mode = 0 ! iceberg asynchronous mode (0=synchronous, 1=asynchronous) +/ diff --git a/config/bin_2p1z1d_tp/namelist.cvmix b/config/bin_2p1z1d_tp/namelist.cvmix new file mode 100644 index 000000000..5c73d9403 --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.cvmix @@ -0,0 +1,211 @@ +! ============================================================================ +! ========== Namelist file for FESOM2 CVMix parameterizations =============== +! ============================================================================ +! This file contains configuration for CVMix (Community Vertical Mixing) +! parameterizations: +! - TKE (Turbulent Kinetic Energy) scheme +! - IDEMIX (Internal Wave Dissipation, Energy, and Mixing) +! - PP (Pacanowski-Philander) scheme +! - KPP (K-Profile Parameterization) +! - TIDAL mixing parameterization +! +! Select the active scheme in namelist.oce (mix_scheme parameter) +! ============================================================================ + +! ============================================================================ +! TKE (TURBULENT KINETIC ENERGY) SCHEME +! ============================================================================ +¶m_tke +! --- TKE Model Parameters --- +tke_c_k = 0.1 ! TKE parameter c_k [dimensionless] +tke_c_eps = 0.7 ! TKE dissipation parameter c_eps [dimensionless] +tke_alpha = 30.0 ! TKE stability function parameter [dimensionless] + +! --- Mixing Length --- +tke_mxl_min = 1.0e-8 ! minimum mixing length [m] +tke_mxl_choice = 2 ! mixing length calculation method: + ! 1 = not implemented + ! 2 = Blanke & Delecluse option (currently only option) + +! --- Viscosity/Diffusivity Limits --- +tke_kappaM_min = 0.0 ! minimum momentum diffusivity [m²/s] +tke_kappaM_max = 100.0 ! maximum momentum diffusivity [m²/s] + +! --- Boundary Conditions --- +tke_cd = 3.75 ! surface boundary condition parameter + ! 3.75 for Dirichlet BC, 1.0 for Neumann BC + +! --- TKE Minimum Values --- +tke_surf_min = 1.0e-4 ! minimum surface TKE [m²/s²] +tke_min = 1.0e-6 ! minimum interior TKE [m²/s²] + +! --- Langmuir Turbulence --- +tke_dolangmuir = .false. ! include Langmuir turbulence parameterization +/ + +! ============================================================================ +! IDEMIX (INTERNAL WAVE ENERGY PARAMETERIZATION) +! ============================================================================ +! Based on Olbers & Eden (2013) and von Pollmann et al. (2017) +! ============================================================================ +¶m_idemix +! --- Time Scales --- +idemix_tau_v = 172800.0 ! vertical symmetrization time scale [s] (2 days) +idemix_tau_h = 1296000.0 ! horizontal symmetrization time scale [s] (15 days) + +! --- Spectral Parameters --- +idemix_gamma = 1.570 ! spectral shape constant [dimensionless] (order 1) +idemix_jstar = 5.0 ! spectral bandwidth in vertical modes [dimensionless] +idemix_mu0 = 0.33333333 ! dissipation parameter [dimensionless] + +! --- Energy Forcing --- +idemix_sforcusage = 0.2 ! fraction of surface forcing used [dimensionless] +idemix_n_hor_iwe_prop_iter = 5 ! iterations for horizontal wave propagation + +! --- Surface Forcing (Wind-Generated Internal Waves) --- +idemix_surforc_file = '/pool/data/AWICM/FESOM2/FORCING/IDEMIX/fourier_smooth_2005_cfsr_inert_rgrid.nc' ! path to surface forcing file +idemix_surforc_vname = 'var706' ! variable name in surface forcing file + +! --- Bottom Forcing (Tidal Internal Waves) --- +!idemix_botforc_file = '/albedo/pool/FESOM/fesom2.0/forcing/idemix/forcing_idemix_final_bin/FIN_tidal_energy_gx1v6_20090205_CESMJayne_remapnn_0.40deg.nc' ! path to bottom forcing !file +!idemix_botforc_vname = 'wave_dissipation' ! variable name in bottom forcing file +idemix_botforc_file = '/albedo/pool/FESOM/fesom2.0/forcing/idemix/forcing_idemix_final_bin/FIN_STORMTIDE2_M2_plus_NYCANDER_CnoM2_bin_0.40deg.nc' ! path to bottom forcing file, +idemix_botforc_vname = 'stormt_M2_plus_nycand_CnoM2' ! variable name in bottom forcing file + +/ + +! ============================================================================ +! PP (PACANOWSKI-PHILANDER) SCHEME +! ============================================================================ +! Based on Pacanowski & Philander (1981) +! ============================================================================ +¶m_pp +! --- PP Variant --- +pp_use_fesompp = .true. ! use FESOM flavor of PP (true) or original PP (false) + +! --- Mixing Coefficients --- +pp_Av0 = 0.01 ! reference mixing coefficient [m²/s] +pp_alpha = 5.0 ! Richardson number dependency parameter [dimensionless] + ! (alpha in eq. 1 of Pacanowski & Philander 1981) +pp_exp = 2.0 ! Richardson number exponent [dimensionless] + ! (n in eq. 1 of Pacanowski & Philander 1981) + +! --- Background Mixing --- +pp_Avbckg = 1.0e-4 ! constant background viscosity [m²/s] +pp_Kvbckg = 1.0e-5 ! constant background diffusivity [m²/s] +pp_use_nonconstKvb = .true. ! use latitude and depth dependent background diffusivity +/ + +! ============================================================================ +! KPP (K-PROFILE PARAMETERIZATION) +! ============================================================================ +! Based on Large et al. (1994) with CVMix implementation options +! ============================================================================ +¶m_kpp +! --- KPP Implementation --- +kpp_use_fesomkpp = .false. ! use CVMix MOM5-like KPP (true) or MOM6-like KPP (false) + +! --- Ocean Boundary Layer (OBL) Depth Calculation --- +kpp_use_enhanceKv = .true. ! add enhanced diffusivity at base of boundary layer +kpp_use_compEkman = .true. ! compute Ekman depth limit for OBL depth +kpp_use_monob = .true. ! compute Monin-Obukhov limit for OBL depth + +! --- Interpolation Methods --- +kpp_interptype_ri = "linear" ! interpolation type for OBL depth determination: + ! 'linear', 'quadratic', 'cubic' +kpp_interptype_atobl = "LMD94" ! interpolation of viscosity/diffusivity at OBL depth: + ! 'linear', 'quadratic', 'cubic', 'LMD94' +kpp_matchtechc = "ParabolicNonLocal" ! diffusivity and non-local transport profile: + ! 'SimpleShapes', 'MatchGradient', 'MatchBoth', 'ParabolicNonLocal' + +! --- Mixing Below OBL --- +kpp_internalmix = "KPP" ! Richardson number dependent mixing below OBL: + ! 'KPP' or 'PP' +kpp_pp_Av0 = 0.01 ! mixing coefficient for PP scheme below OBL [m²/s] + +! --- Shear Mixing Parameters --- +kpp_Av0 = 5.0e-3 ! leading coefficient of shear mixing [m²/s] (default: 5e-3) +kpp_Kv0 = 5.0e-3 ! leading coefficient of shear diffusion [m²/s] +kpp_Ri0 = 0.7 ! critical Richardson number [dimensionless] (0.7 in LMD94) + +! --- Background Mixing --- +kpp_use_nonconstKvb = .true. ! use non-constant background diffusivity (FESOM1.4 formulation) +kpp_Avbckg = 1.0e-4 ! constant background viscosity [m²/s] +kpp_Kvbckg = 1.0e-5 ! constant background diffusivity [m²/s] + +! --- Sea Ice Effects --- +kpp_reduce_tauuice = .false. ! reduce wind stress (u*) under sea ice + +! --- Langmuir Options in cvmix KPP --- + +! Stokes Similarty package +! If true, use Stokes Similarty package (i.e. include wave‐related / Stokes drift +! effects in the surface layer). Triggers usage of additional routines +! that alter the shape functions, or mixing formulations, incorporating wave / +! Stokes drift effects consistent with Monin–Obukhov similarity theory +! (MOST). The code logic probably augments or replaces parts of the standard boundary +! (layer similarity (or nonlocal mixing) using a Stokes‐drift‐aware correction. +kpp_use_StokesMOST= .false. !.true. + +! approximate proportionality between surface wind velocity and stokes velocity +! U_stokes ~ kpp_A_stokes * U_wind +kpp_A_stokes = 0.005 ! a + +! Langmuir option +! Option of Langmuir enhanced mixing apply an enhancement factor to the +! turbulent velocity scale +! LWF16 - MixingCoefEnhancement = Langmuir_EFactor +! RWHGK16 - MixingCoefEnhancement = cvmix_one + ShapeNoMatchAtS/NMshapeMax * & +! (Langmuir_EFactor - cvmix_one) +! NONE - Langmuir switched off, MixingCoefEnhancement=1 +kpp_langmuir_mixing= "NONE" !"LWF16" + +! Option of Langmuir turbulence enhanced entrainment - modify the unresolved shear +! LWF16 - Li Q., Webb A., Fox-Kemper B., Craig A., Danabasoglu G., +! Large W., Vertenstein M., 2016, Langmuir mixing effects on +! global climate: WAVEWATCH III in CESM, Ocean Modelling 103 (2016) 145–160 +! +! LF17 - Li Q., Fox-Kemper B., Breivik O., Webb A., 2017, Statistical +! models of global Langmuir mixing, Ocean Modelling 113 (2017) 95–114 +! +! RWHGK16 - Reichl B., Wang D., Hara T., Ginis I. and Kukulka T, 2016, Impact +! of Sea-State-Dependent Langmuir Turbulence on the Ocean +! Response to a Tropical Cyclone, Mon. Wea. Rev., 144 +! +! NONE - +kpp_langmuir_entrainment= "NONE" !"LF17" +/ + + +! ============================================================================ +! TIDAL MIXING PARAMETERIZATION +! ============================================================================ +! Based on Simmons et al. (2004) +! ============================================================================ +¶m_tidal +! --- Tidal Mixing Scheme --- +tidal_mixscheme = "Simmons" ! tidal mixing scheme (currently only 'Simmons' implemented) + +! --- Energy Dissipation Parameters --- +tidal_efficiency = 0.2 ! mixing efficiency [dimensionless, 0-1] + ! (Gamma in Simmons et al. 2004) +tidal_lcl_mixfrac = 0.33 ! local dissipation fraction [dimensionless] + ! (q in Simmons et al. 2004) + ! fraction of tidal energy dissipated locally vs radiated away + +! --- Vertical Structure --- +tidal_vert_decayscale = 500.0 ! vertical decay scale [m] + ! (zeta in Simmons et al. 2004) + ! controls vertical distribution of tidal mixing + +! --- Diffusivity Limits --- +tidal_max_coeff = 50e-4 ! maximum tidal diffusivity [m²/s] + +! --- Spatial Limits --- +tidal_depth_cutoff = 0.0 ! minimum depth for tidal mixing [m, positive downward] + ! (0.0 = compute everywhere) + +! --- Bottom Forcing (Tidal Energy Input) --- +tidal_botforc_file = '/pool/data/AWICM/FESOM2/FORCING/IDEMIX/tidal_energy_gx1v6_20090205_rgrid.nc' +/ + diff --git a/config/bin_2p1z1d_tp/namelist.dyn b/config/bin_2p1z1d_tp/namelist.dyn new file mode 100644 index 000000000..e670102bb --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.dyn @@ -0,0 +1,72 @@ +! ============================================================================ +! ========== Namelist file for FESOM2 momentum dynamics ====================== +! ============================================================================ +! This file contains configuration for momentum equations and dynamics: +! - Horizontal viscosity schemes and parameters +! - Momentum advection options +! - Free-slip vs no-slip boundary conditions +! - Vertical velocity splitting +! - Split-explicit barotropic subcycling +! - Energy diagnostics +! ============================================================================ + +! ============================================================================ +! HORIZONTAL VISCOSITY +! ============================================================================ +&dynamics_visc +! --- Viscosity Coefficients --- +visc_gamma0 = 0.003 ! background viscosity coefficient [m/s] + ! viscosity = gamma0 × element_length + ! keep < 0.01 m/s for numerical stability +visc_gamma1 = 0.1 ! flow-aware viscosity coefficient [dimensionless] +visc_gamma2 = 0.285 ! additional viscosity coefficient [s/m] + ! only used for easy backscatter (opt_visc=5) and dynamic backscatter (opt_visc=8) +visc_easybsreturn = 1.5 ! energy return parameter for easy backscatter [dimensionless] + +! --- Viscosity Scheme Selection --- +opt_visc = 5 ! horizontal viscosity scheme: + ! 5 = Kinematic (easy) Backscatter + ! 6 = Biharmonic flow-aware (depends on velocity Laplacian) + ! 7 = Biharmonic flow-aware (depends on velocity differences) + ! 8 = Dynamic Backscatter +check_opt_visc = .true. ! check if opt_visc=5 is valid based on resolution/Rossby radius ratio + +! --- Vertical Viscosity --- +use_ivertvisc = .true. ! use implicit vertical viscosity (recommended for stability) +/ + +! ============================================================================ +! GENERAL DYNAMICS SETTINGS +! ============================================================================ +&dynamics_general +! --- Momentum Advection --- +momadv_opt = 2 ! momentum advection option (only 2 is currently supported) + +! --- Boundary Conditions --- +use_freeslip = .false. ! enable free-slip lateral boundary conditions (false = no-slip) + +! --- Vertical Velocity Splitting --- +use_wsplit = .false. ! enable implicit/explicit splitting of vertical velocity +wsplit_maxcfl = 1.0 ! maximum allowed vertical CFL criterion (range: 0.5-1.0) + ! in older FESOM versions this was w_exp_max=1.e-3 + +! --- Energy Diagnostics --- +ldiag_KE = .false. ! enable kinetic energy diagnostics (requires additional computation) + +! --- Time Stepping --- +AB_order = 2 ! Adams-Bashforth time stepping order (2 or 3) + +! --- Split-Explicit Barotropic Subcycling --- +use_ssh_se_subcycl = .false. ! enable split-explicit subcycling for barotropic mode + ! (faster time stepping for sea surface height) +se_BTsteps = 50 ! number of barotropic subcycles per baroclinic time step +se_BTtheta = 0.14 ! implicitness parameter for barotropic solver (0-1, default: 0.14) +se_bottdrag = .true. ! include bottom drag in barotropic subcycling +se_bdrag_si = .true. ! use semi-implicit bottom drag (true) or explicit (false) +se_visc = .true. ! include viscosity in barotropic subcycling +se_visc_gamma0 = 10 ! background viscosity for barotropic mode [dimensionless] +se_visc_gamma1 = 19500 ! flow-aware viscosity for barotropic mode [dimensionless] + ! typical values: 19500 (CORE2@32spd), 2750 (CORE2@72spd) +se_visc_gamma2 = 0 ! additional viscosity for barotropic mode [dimensionless] +/ + diff --git a/config/bin_2p1z1d_tp/namelist.forcing b/config/bin_2p1z1d_tp/namelist.forcing new file mode 100644 index 000000000..31d9b31ab --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.forcing @@ -0,0 +1,147 @@ +! ============================================================================ +! ============= Namelist file for FESOM2 atmospheric forcing ================ +! ============================================================================ +! This file contains configuration for atmospheric forcing and surface boundary +! conditions, including: +! - Bulk formulae exchange coefficients (heat, momentum, moisture) +! - Bulk formulae options and reference heights +! - Land ice freshwater forcing +! - Age tracer configuration +! - Surface forcing data files and variables +! - Runoff and salinity restoring +! - Chlorophyll data for shortwave penetration +! ============================================================================ + +! ============================================================================ +! BULK FORMULAE EXCHANGE COEFFICIENTS +! ============================================================================ +! These coefficients control the turbulent exchange of heat, moisture, and +! momentum between the atmosphere and ocean/ice surfaces. +! ============================================================================ +&forcing_exchange_coeff +Ce_atm_oce = 0.00175 ! exchange coefficient of latent heat over open water (dimensionless) +Ch_atm_oce = 0.00175 ! exchange coefficient of sensible heat over open water (dimensionless) +Cd_atm_oce = 0.001 ! drag coefficient between atmosphere and water (dimensionless) +Ce_atm_ice = 0.00175 ! exchange coefficient of latent heat over ice (dimensionless) +Ch_atm_ice = 0.00175 ! exchange coefficient of sensible heat over ice (dimensionless) +Cd_atm_ice = 0.0012 ! drag coefficient between atmosphere and ice (dimensionless) +Swind = 0.0 ! parameterization for coupled current feedback (0.0 = disabled) + ! non-zero values reduce wind stress based on ocean surface currents +/ + +! ============================================================================ +! BULK FORMULAE OPTIONS +! ============================================================================ +! Configuration for bulk formulae calculations (turbulent fluxes). +! Reference heights must match the forcing data specifications. +! ============================================================================ +&forcing_bulk +AOMIP_drag_coeff = .false. ! use AOMIP drag coefficient formulation (false = use standard) +ncar_bulk_formulae = .true. ! use NCAR bulk formulae (Large & Yeager 2004, 2009) +ncar_bulk_z_wind = 10.0 ! reference height for wind forcing [m] + ! CORE2, JRA55-do: 10m; JRA55, NCEP: 2m +ncar_bulk_z_tair = 10.0 ! reference height for air temperature forcing [m] + ! CORE2, JRA55-do: 10m; JRA55, NCEP: 2m +ncar_bulk_z_shum = 10.0 ! reference height for specific humidity forcing [m] + ! CORE2, JRA55-do: 10m; JRA55, NCEP: 2m +/ + +! ============================================================================ +! LAND ICE FRESHWATER FORCING +! ============================================================================ +! Configuration for freshwater input from land ice (glaciers, ice sheets). +! Requires use_landice_water=.true. in namelist.config to enable output. +! ============================================================================ +&land_ice +use_landice_water = .false. ! enable land ice freshwater forcing +landice_start_mon = 5 ! start month for land ice forcing (1-12) +landice_end_mon = 10 ! end month for land ice forcing (1-12) +fwf_path = '' ! path to land ice freshwater flux data files +/ + +! ============================================================================ +! AGE TRACER CONFIGURATION +! ============================================================================ +! Configuration for passive age tracer (tracks water mass age). +! Requires use_age_tracer=.true. in namelist.config to enable output. +! ============================================================================ +&age_tracer +use_age_tracer = .false. ! enable age tracer computation +use_age_mask = .false. ! use spatial mask for age tracer initialization +age_tracer_path = '' ! path to age tracer mask file (if use_age_mask=.true.) +age_start_year = 2000 ! year to start age tracer (tracer age = 0 at this year) +/ + +! ============================================================================ +! SURFACE BOUNDARY CONDITION (FORCING DATA) +! ============================================================================ +! Specification of atmospheric forcing data files and variables. +! File paths are relative to the run directory. +! ============================================================================ +&nam_sbc + ! --- Forcing file paths --- + nm_xwind_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/uas.clim61' ! name of file with zonal wind speeds + nm_ywind_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/vas.clim61' ! name of file with meridional wind speeds + nm_xstre_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/huss.clim61' ! name of file with zonal wind stress + nm_ystre_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/vas.clim61' ! name of file with meridional wind stress + nm_humi_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/huss.clim61' ! name of file with humidity + nm_qsr_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/rsds.clim61' ! name of file with solar heat + nm_qlw_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/rlds.clim61' ! name of file with Long wave + nm_tair_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/tas.clim61' ! name of file with 2m air temperature + nm_prec_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/prra.clim61' ! name of file with total precipitation + nm_snow_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/prsn.clim61' ! name of file with snow precipitation + nm_mslp_file = '/albedo/work/projects/MarESys/FROM-OLLIE/forcing_JRA55-do-v1.4.0_clim61/psl.clim61' + ! --- Variable names in netCDF forcing files --- + nm_xwind_var = 'uas' ! name of variable in file with wind + nm_ywind_var = 'vas' ! name of variable in file with wind + nm_xstre_var = 'uas' ! name of variable in file with wind + nm_ystre_var = 'vas' ! name of variable in file with wind + nm_humi_var = 'huss' ! name of variable in file with humidity + nm_qsr_var = 'rsds' ! name of variable in file with solar heat + nm_qlw_var = 'rlds' ! name of variable in file with long wave + nm_tair_var = 'tas' ! name of variable in file with 2m air temperature + nm_prec_var = 'prra' ! name of variable in file with total precipitation + nm_snow_var = 'prsn' ! name of variable in file with total precipitation + nm_mslp_var = 'psl' ! name of variable in file with air_pressure_at_sea_level + + ! --- Time axis configuration in forcing files --- + nm_nc_iyear = 1948 ! initial year of forcing data time axis + nm_nc_imm = 1 ! initial month of forcing data time axis (1-12) + nm_nc_idd = 1 ! initial day of forcing data time axis (1-31) + nm_nc_freq = 1 ! number of data points per day (1=daily, 4=6-hourly, etc.) + nm_nc_tmid = 0 ! time stamp position: 1=mid-point, 0=start of interval + y_perpetual = .false. ! use perpetual year forcing (repeat single year) + + ! --- Enable/disable individual forcing fields --- + l_xwind = .true. ! use zonal wind forcing + l_ywind = .true. ! use meridional wind forcing + l_xstre = .false. ! use zonal wind forcing + l_ystre = .false. ! use meridional wind forcing + l_humi = .true. ! use specific humidity forcing + l_qsr = .true. ! use shortwave radiation forcing + l_qlw = .true. ! use longwave radiation forcing + l_tair = .true. ! use air temperature forcing + l_prec = .true. ! use precipitation forcing + l_mslp = .true. ! use mean sea level pressure forcing + l_cloud = .false. ! use cloud cover forcing + l_snow = .true. ! use snow precipitation forcing + + ! --- Runoff configuration --- + runoff_data_source = 'CORE2' ! runoff data source: 'Dai09', 'JRA55, 'CORE2', or 'NONE' + nm_runoff_file = '/albedo/pool/FESOM/forcing/CORE2/runoff.nc' ! path to runoff data + + ! --- Sea surface salinity restoring --- + sss_data_source = 'CORE2' ! SSS restoring data source: 'CORE2', 'WOA', or 'NONE' + nm_sss_data_file = '/albedo/pool/FESOM/forcing/CORE2/PHC2_salx.nc' ! path to SSS restoring data file, e.g. PHC2_salx.nc + + ! --- Chlorophyll data for shortwave penetration --- + chl_data_source = 'None' ! chlorophyll data source: 'Sweeney' (monthly climatology) or 'None' (constant) + ! requires use_sw_pene=.true. in namelist.config + nm_chl_data_file = '/pool/data/AWICM/FESOM2/FORCING/Sweeney/Sweeney_2005.nc' ! chlorophyll data file (if Sweeney) + chl_const = 0.1 ! constant chlorophyll concentration [mg/m³] (if chl_data_source='None') + + ! --- Runoff mapper (distributes runoff over coastal area) --- + use_runoff_mapper = .false. ! enable runoff mapper (spreads runoff spatially) + runoff_basins_file = '' ! runoff basin mapping file + runoff_radius = 500000. ! radius for runoff spreading [m] (if use_runoff_mapper=.true.) +/ diff --git a/config/bin_2p1z1d_tp/namelist.ice b/config/bin_2p1z1d_tp/namelist.ice new file mode 100644 index 000000000..8b29ce4bf --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.ice @@ -0,0 +1,98 @@ +! ============================================================================ +! ============== Namelist file for FESOM2 sea ice model ===================== +! ============================================================================ +! This file contains configuration for sea ice dynamics and thermodynamics: +! - EVP (Elastic-Viscous-Plastic) rheology options +! - Ice strength and deformation parameters +! - Ocean-ice drag +! - Ice thermodynamics and thickness distribution +! - Albedo parameterizations +! ============================================================================ + +! ============================================================================ +! SEA ICE DYNAMICS +! ============================================================================ +&ice_dyn +! --- EVP Rheology Options --- +whichEVP = 0 ! EVP solver type: + ! 0 = standard EVP + ! 1 = modified EVP (mEVP) + ! 2 = adaptive EVP (aEVP) + +! --- Ice Strength Parameters --- +Pstar = 30000.0 ! ice strength parameter [N/m²] (typical: 20000-30000) +ellipse = 2.0 ! aspect ratio of yield curve ellipse (dimensionless) +c_pressure = 20.0 ! ice concentration parameter for strength computation (dimensionless) + +! --- Ice Deformation --- +delta_min = 1.0e-11 ! minimum strain rate for viscosity regularization [s⁻¹] + +! --- EVP Subcycling --- +evp_rheol_steps = 120 ! number of EVP subcycles per ice time step + +! --- mEVP Stability Parameters (for whichEVP=1) --- +alpha_evp = 250 ! mEVP stability constant (adjust with resolution) +beta_evp = 250 ! mEVP stability constant (adjust with resolution) + +! --- aEVP Tuning (for whichEVP=2) --- +c_aevp = 0.15 ! aEVP tuning constant (adjust with resolution) + +! --- Ocean-Ice Coupling --- +Cd_oce_ice = 0.0055 ! drag coefficient between ocean and ice (dimensionless, typical: 0.0055) + +! --- Numerical Stabilization --- +ice_gamma_fct = 0.5 ! smoothing parameter for ice dynamics (0.0-1.0) +ice_diff = 0.0 ! artificial diffusion for numerical stability [m²/s] +theta_io = 0.0 ! rotation angle for ice-ocean stress [degrees] + +! --- Time Stepping --- +ice_ave_steps = 1 ! ice time step = ice_ave_steps × ocean time step +/ + +! ============================================================================ +! SEA ICE THERMODYNAMICS +! ============================================================================ +&ice_therm +! --- Ice Properties --- +Sice = 4.0 ! bulk ice salinity [ppt] (typical range: 3.2-5.0) + +! --- Ice Thickness Distribution --- +iclasses = 7 ! number of ice thickness categories (default: 7) + ! set to 15 if using EM distribution (new_iceclasses=.true.) +new_iclasses = .false. ! use ice thickness distribution from EM observations + ! (Castro-Morales et al., JGR, 2013) +h_cutoff = 3.0 ! thickness cutoff for new_iclasses [m] + +! --- Lead Closing Parameters --- +h0 = 0.5 ! lead closing parameter for Northern Hemisphere [m] +h0_s = 0.5 ! lead closing parameter for Southern Hemisphere [m] + +! --- Minimum Thresholds --- +hmin = 0.01 ! minimum ice thickness [m] +armin = 0.01 ! minimum ice concentration (dimensionless) + +! --- Emissivity (Longwave Radiation) --- +emiss_ice = 0.97 ! emissivity of snow/ice surface (dimensionless, 0-1) +emiss_wat = 0.97 ! emissivity of open water (dimensionless, 0-1) + +! --- Albedo (Shortwave Radiation) --- +albsn = 0.81 ! albedo of frozen snow (dimensionless, 0-1) +albsnm = 0.77 ! albedo of melting snow (dimensionless, 0-1) +albi = 0.7 ! albedo of frozen ice (dimensionless, 0-1) +albim = 0.68 ! albedo of melting ice (dimensionless, 0-1) +albw = 0.1 ! albedo of open water (dimensionless, 0-1) +open_water_albedo = 0 ! open water albedo scheme: + ! 0 = default (constant albw) + ! 1 = Taylor et al. + ! 2 = Briegleb et al. + +! --- Thermal Conductivity --- +con = 2.1656 ! thermal conductivity of ice [W/m/K] +consn = 0.31 ! thermal conductivity of snow [W/m/K] + +! --- Snow Distribution --- +snowdist = .true. ! distribute snow depth according to ice thickness distribution + +! --- Melting Parameters --- +c_melt = 0.5 ! constant in concentration equation for melting conditions (0-1) +/ diff --git a/config/bin_2p1z1d_tp/namelist.icepack b/config/bin_2p1z1d_tp/namelist.icepack new file mode 100644 index 000000000..3fa487147 --- /dev/null +++ b/config/bin_2p1z1d_tp/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 = .true. + 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/bin_2p1z1d_tp/namelist.io b/config/bin_2p1z1d_tp/namelist.io new file mode 100644 index 000000000..982a17079 --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.io @@ -0,0 +1,359 @@ +! ============================================================================ +! ============ Namelist file for FESOM2 output configuration ================= +! ============================================================================ +! This file contains configuration for model output and diagnostics: +! - Diagnostic flags for optional output fields +! - General output settings (compression, rotation) +! - Output variable list with frequency and precision +! - Complete catalog of all available output fields +! +! See the output catalog at the end of this file for all possible variables. +! Some outputs require specific flags in &diag_list or other namelists. +! ============================================================================ + +! ============================================================================ +! DIAGNOSTIC FLAGS +! ============================================================================ +! Enable/disable optional diagnostic computations and outputs. +! Setting these to .true. enables additional output fields (see catalog below). +! ============================================================================ +&diag_list +ldiag_solver = .false. ! enables solver diagnostics (convergence, iterations) +lcurt_stress_surf = .false. ! enables 'curl_surf' output (vorticity of surface stress) +ldiag_curl_vel3 = .false. ! enables 'curl_u' output (relative vorticity from 3D velocity) +ldiag_Ri = .false. ! enables Richardson number diagnostics ('shear', 'Ri') +ldiag_turbflux = .false. ! enables turbulent flux diagnostics ('KvdTdz', 'KvdSdz') +ldiag_salt3D = .false. ! enables 3D salinity diagnostics +ldiag_dMOC = .false. ! enables 'dMOC' output (density MOC diagnostics) +ldiag_DVD = .false. ! enables 'DVD' output (Discrete Variance Decay diagnostics) +ldiag_forc = .false. ! enables 'FORC' output (comprehensive forcing diagnostics) +ldiag_extflds = .false. ! enables extended field diagnostics +ldiag_destine = .false. ! enables heat content computation ('hc300m', 'hc700m', 'hc') +ldiag_trflx = .false. ! enables tracer flux diagnostics ('utemp', 'vtemp', 'usalt', 'vsalt') +ldiag_uvw_sqr = .false. ! enables 'UVW_SQR' output (squared velocities: u2, v2, w2) +ldiag_trgrd_xyz = .false. ! enables 'TRGRD_XYZ' output (horizontal & vertical tracer gradients) +ldiag_cmor = .false. ! enables CMOR diagnostics for CMIP6/CMIP7 ('tos', 'sos', 'pbo', 'volo', etc.) +/ + +! ============================================================================ +! GENERAL OUTPUT SETTINGS +! ============================================================================ +&nml_general +io_listsize = 120 ! total number of streams to allocate. Shall be larger or equal to the number of streams in &nml_list (max. 150) +vec_autorotate = .false. ! unrotate vector fields (velocities, winds) before writing to output files +compression_level = 1 ! compression level for netCDF output (1=fastest, 9=smallest) +/ + +! ============================================================================ +! OUTPUT VARIABLE LIST +! ============================================================================ +! Format: 'variable_id', frequency, unit, precision +! frequency = output frequency (integer) +! unit = 'y' (yearly), 'm' (monthly), 'd' (daily), 'h' (hourly), 's' (steps) +! precision = 4 (single precision) or 8 (double precision) +! ============================================================================ +&nml_list +io_list = 'sst ',1, 'y', 4, + 'sss ',1, 'y', 4, +! 'ssh ',1, 'y', 4, +! 'uice ',1, 'y', 4, +! 'vice ',1, 'y', 4, + 'a_ice ',1, 'm', 4, +! 'm_ice ',1, 'y', 4, +! 'm_snow ',1, 'y', 4, + 'MLD1 ',1, 'm', 4, + 'MLD2 ',1, 'm', 4, + 'MLD3 ',1, 'm', 4, +! 'tx_sur ',1, 'y', 4, +! 'ty_sur ',1, 'y', 4, + 'temp ',1, 'y', 4, + 'salt ',1, 'y', 8, +! 'N2 ',1, 'y', 4, +! 'Kv ',1, 'y', 4, + 'u ',1, 'y', 4, + 'v ',1, 'y', 4, +! 'unod ',1, 'y', 4, +! 'vnod ',1, 'y', 4, + 'w ',1, 'y', 4, +! 'Av ',1, 'y', 4, + 'bolus_u ',1, 'y', 4, + 'bolus_v ',1, 'y', 4, + 'bolus_w ',1, 'y', 4, +! 'fw ',1, 'y', 4, +! 'fh ',1, 'y', 4, + 'otracers ',1, 'y', 4, +/ + +! ============================================================================ +! COMPLETE CATALOG OF ALL POSSIBLE OUTPUT FIELDS +! ============================================================================ +! Below is a comprehensive list of all valid io_list IDs available in FESOM2. +! To enable any field, copy the line to the &nml_list section above. +! NOTE: Some fields require specific flags to be enabled (see comments). +! ============================================================================ + +! --- 2D OCEAN SURFACE FIELDS --- +! 'sst ',1, 'm', 4, ! sea surface temperature [C] +! 'sss ',1, 'm', 4, ! sea surface salinity [psu] +! 'ssh ',1, 'm', 4, ! sea surface elevation [m] +! 'vve_5 ',1, 'm', 4, ! vertical velocity at 5th level [m/s] +! 't_star ',1, 'm', 4, ! air temperature [C] +! 'qsr ',1, 'm', 4, ! solar radiation [W/s^2] + +! --- 3D OCEAN FIELDS --- +! 'temp ',1, 'm', 4, ! temperature [C] +! 'salt ',1, 'm', 8, ! salinity [psu] +! 'sigma0 ',1, 'm', 4, ! potential density [kg/m3] +! 'u ',1, 'm', 4, ! zonal velocity [m/s] +! 'v ',1, 'm', 4, ! meridional velocity [m/s] +! 'unod ',1, 'm', 4, ! zonal velocity at nodes [m/s] +! 'vnod ',1, 'm', 4, ! meridional velocity at nodes [m/s] +! 'w ',1, 'm', 4, ! vertical velocity [m/s] +! 'otracers ',1, 'm', 4, ! all other tracers if applicable +! 'age ',1, 'm', 4, ! water age tracer [year] (require use_age_tracer=.true.) + +! --- 2D SSH DIAGNOSTIC VARIABLES --- +! 'ssh_rhs ',1, 'm', 4, ! ssh rhs [m/s] +! 'ssh_rhs_old',1, 'm', 4, ! ssh rhs old [m/s] +! 'd_eta ',1, 'm', 4, ! dssh from solver [m] +! 'hbar ',1, 'm', 4, ! ssh n+0.5 tstep [m] +! 'hbar_old ',1, 'm', 4, ! ssh n-0.5 tstep [m] +! 'dhe ',1, 'm', 4, ! dhbar @ elem [m] + +! --- SEA ICE FIELDS (require use_ice=.true.) --- +! 'uice ',1, 'm', 4, ! ice velocity x [m/s] +! 'vice ',1, 'm', 4, ! ice velocity y [m/s] +! 'a_ice ',1, 'm', 4, ! ice concentration [%] +! 'm_ice ',1, 'm', 4, ! ice height per unit area [m] +! 'thdgrice ',1, 'm', 4, ! thermodynamic growth rate ice [m/s] +! 'thdgrarea ',1, 'm', 4, ! thermodynamic growth rate ice concentration [frac/s] +! 'dyngrarea' ,1, 'm', 4, ! dynamic growth rate ice concentration [frac/s] +! 'dyngrice ',1, 'm', 4, ! dynamic growth rate ice [m/s] +! 'thdgrsn ',1, 'm', 4, ! thermodynamic growth rate snow [m/s] +! 'dyngrsnw ',1, 'm', 4, ! dynamic growth rate snow [m/s] +! 'flice ',1, 'm', 4, ! flooding growth rate ice [m/s] +! 'm_snow ',1, 'm', 4, ! snow height per unit area [m] +! 'h_ice ',1, 'm', 4, ! ice thickness over ice-covered fraction [m] +! 'h_snow ',1, 'm', 4, ! snow thickness over ice-covered fraction [m] +! 'fw_ice ',1, 'm', 4, ! fresh water flux from ice ['m/s'] +! 'fw_snw ',1, 'm', 4, ! fresh water flux from snow ['m/s'] + +! --- SEA ICE DEBUG VARIABLES (require use_ice=.true.) --- +! 'strength_ice',1, 'm', 4, ! ice strength [?] +! 'inv_areamass',1, 'm', 4, ! inv_areamass [?] +! 'rhs_a ',1, 'm', 4, ! rhs_a [?] +! 'rhs_m ',1, 'm', 4, ! rhs_m [?] +! 'sgm11 ',1, 'm', 4, ! sgm11 [?] +! 'sgm12 ',1, 'm', 4, ! sgm12 [?] +! 'sgm22 ',1, 'm', 4, ! sgm22 [?] +! 'eps11 ',1, 'm', 4, ! eps11 [?] +! 'eps12 ',1, 'm', 4, ! eps12 [?] +! 'eps22 ',1, 'm', 4, ! eps22 [?] +! 'u_rhs_ice ',1, 'm', 4, ! u_rhs_ice [?] +! 'v_rhs_ice ',1, 'm', 4, ! v_rhs_ice [?] +! 'metric_fac',1, 'm', 4, ! metric_fac [?] +! 'elevat_ice',1, 'm', 4, ! elevat_ice [?] +! 'uwice ',1, 'm', 4, ! uwice [?] +! 'vwice ',1, 'm', 4, ! vwice [?] +! 'twice ',1, 'm', 4, ! twice [?] +! 'swice ',1, 'm', 4, ! swice [?] + +! --- MIXED LAYER DEPTH --- +! 'MLD1 ',1, 'm', 4, ! Mixed Layer Depth [m] Large et al. 1997, bvfreq(nz, node) > db_max +! 'MLD2 ',1, 'm', 4, ! Mixed Layer Depth [m] Levitus treshold, rhopot(nz)-rhopot(1) > 0.125_WP kg/m +! 'MLD3 ',1, 'm', 4, ! Mixed Layer Depth [m] Griffies 2016 , rhopot(nz)-rhopot(1) > 0.03_WP kg/m + +! --- HEAT CONTENT (require ldiag_destine=.true.) --- +! 'hc300m ',1, 'm', 4, ! Vertically integrated heat content upper 300m [J m**-2] +! 'hc700m ',1, 'm', 4, ! Vertically integrated heat content upper 700m [J m**-2] +! 'hc ',1, 'm', 4, ! Vertically integrated heat content total column [J m**-2] + +! --- WATER ISOTOPES IN SEA ICE (require lwiso=.true.) --- +! 'h2o18_ice ',1, 'm', 4, ! h2o18 concentration in sea ice [kmol/m**3] +! 'hDo16_ice ',1, 'm', 4, ! hDo16 concentration in sea ice [kmol/m**3] +! 'h2o16_ice ',1, 'm', 4, ! h2o16 concentration in sea ice [kmol/m**3] + +! --- FRESHWATER FLUX (require use_landice_water=.true.) --- +! 'landice ',1, 'm', 4, ! freshwater flux [m/s] + +! --- SURFACE FORCING --- +! 'tx_sur ',1, 'm', 4, ! zonal wind str. to ocean [N/m2] +! 'ty_sur ',1, 'm', 4, ! meridional wind str. to ocean [N/m2] +! 'curl_surf ',1, 'm', 4, ! vorticity of the surface stress [none] (require lcurt_stress_surf=.true.) +! 'fh ',1, 'm', 4, ! heat flux [W/m2] +! 'fw ',1, 'm', 4, ! fresh water flux [m/s] +! 'atmice_x ',1, 'm', 4, ! stress atmice x [N/m2] +! 'atmice_y ',1, 'm', 4, ! stress atmice y [N/m2] +! 'atmoce_x ',1, 'm', 4, ! stress atmoce x [N/m2] +! 'atmoce_y ',1, 'm', 4, ! stress atmoce y [N/m2] +! 'iceoce_x ',1, 'm', 4, ! stress iceoce x [N/m2] +! 'iceoce_y ',1, 'm', 4, ! stress iceoce y [N/m2] +! 'alpha ',1, 'm', 4, ! thermal expansion [none] +! 'beta ',1, 'm', 4, ! saline contraction [none] +! 'dens_flux ',1, 'm', 4, ! density flux [kg/(m3*s)] +! 'runoff ',1, 'm', 4, ! river runoff [m/s] +! 'evap ',1, 'm', 4, ! evaporation [m/s] +! 'prec ',1, 'm', 4, ! precipitation rain [m/s] +! 'snow ',1, 'm', 4, ! precipitation snow [m/s] +! 'tair ',1, 'm', 4, ! surface air temperature [°C] +! 'shum ',1, 'm', 4, ! specific humidity [] +! 'swr ',1, 'm', 4, ! short wave radiation [W/m^2] +! 'lwr ',1, 'm', 4, ! long wave radiation [W/m^2] +! 'uwind ',1, 'm', 4, ! 10m zonal surface wind velocity [m/s] +! 'vwind ',1, 'm', 4, ! 10m merid. surface wind velocity [m/s] +! 'virtsalt ',1, 'm', 4, ! virtual salt flux [m/s*psu] +! 'relaxsalt ',1, 'm', 4, ! relaxation salt flux [m/s*psu] +! 'realsalt ',1, 'm', 4, ! real salt flux from sea ice [m/s*psu] + +! --- KPP VERTICAL MIXING (require mix_scheme_nmb==1,17,3,37) --- +! 'kpp_obldepth',1, 'm', 4, ! KPP ocean boundary layer depth [m] +! 'kpp_sbuoyflx',1, 'm', 4, ! surface buoyancy flux [m2/s3] + +! --- RECOM 2D BIOGEOCHEMISTRY (require use_REcoM=.true. and __recom) --- +! 'dpCO2s ',1, 'm', 4, ! Difference of oceanic pCO2 minus atmospheric pCO2 [uatm] +! 'pCO2s ',1, 'm', 4, ! Partial pressure of oceanic CO2 [uatm] +! 'CO2f ',1, 'm', 4, ! CO2-flux into the surface water [mmolC/m2/d] +! 'O2f ',1, 'm', 4, ! O2-flux into the surface water [mmolO/m2/d] +! 'Hp ',1, 'm', 4, ! Mean of H-plus ions in the surface water [mol/kg] +! 'aFe ',1, 'm', 4, ! Atmospheric iron input [umolFe/m2/s] +! 'aN ',1, 'm', 4, ! Atmospheric DIN input [mmolN/m2/s] +! 'benN ',1, 'm', 4, ! Benthos Nitrogen [mmol] +! 'benC ',1, 'm', 4, ! Benthos Carbon [mmol] +! 'benSi ',1, 'm', 4, ! Benthos silicon [mmol] +! 'benCalc ',1, 'm', 4, ! Benthos calcite [mmol] +! 'NPPn ',1, 'm', 4, ! Mean NPP nanophytoplankton [mmolC/m2/d] +! 'NPPd ',1, 'm', 4, ! Mean NPP diatoms [mmolC/m2/d] +! 'GPPn ',1, 'm', 4, ! Mean GPP nanophytoplankton [mmolC/m2/d] +! 'GPPd ',1, 'm', 4, ! Mean GPP diatoms [mmolC/m2/d] +! 'NNAn ',1, 'm', 4, ! Net N-assimilation nanophytoplankton [mmolN/m2/d] +! 'NNAd ',1, 'm', 4, ! Net N-assimilation diatoms [mmolN/m2/d] +! 'Chldegn ',1, 'm', 4, ! Chlorophyll degradation nanophytoplankton [1/d] +! 'Chldegd ',1, 'm', 4, ! Chlorophyll degradation diatoms [1/d] +! 'NPPc ',1, 'm', 4, ! Mean NPP coccolithophores [mmolC/(m2*d)] +! 'GPPc ',1, 'm', 4, ! Mean GPP coccolithophores [mmolC/m2/d] +! 'NNAc ',1, 'm', 4, ! Net N-assimilation coccolithophores [mmolN/(m2*d)] +! 'Chldegc ',1, 'm', 4, ! Chlorophyll degradation coccolithophores [1/d] + +! --- RECOM 3D BIOGEOCHEMISTRY (require use_REcoM=.true. and __recom) --- +! 'PAR ',1, 'm', 4, ! PAR [W/m2] +! 'respmeso ',1, 'm', 4, ! Respiration rate of mesozooplankton [mmolC/m2/d] +! 'respmacro ',1, 'm', 4, ! Respiration rate of macrozooplankton [mmolC/m2/d] +! 'respmicro ',1, 'm', 4, ! Respiration rate of microzooplankton [mmolC/m2/d] +! 'calcdiss ',1, 'm', 4, ! Calcite dissolution [mmolC/m2/d] +! 'calcif ',1, 'm', 4, ! Calcification [mmolC/m2/d] +! 'aggn ',1, 'm', 4, ! Aggregation of small phytoplankton [mmolC/m2/d] +! 'aggd ',1, 'm', 4, ! Aggregation of diatoms [mmolC/m2/d] +! 'aggc ',1, 'm', 4, ! Aggregation of coccolithophores [mmolC/m2/d] +! 'docexn ',1, 'm', 4, ! DOC excretion by small phytoplankton [mmolC/m2/d] +! 'docexd ',1, 'm', 4, ! DOC excretion by diatoms [mmolC/m2/d] +! 'docexc ',1, 'm', 4, ! DOC excretion by coccolithophores [mmolC/m2/d] +! 'respn ',1, 'm', 4, ! Respiration by small phytoplankton [mmolC/m2/d] +! 'respd ',1, 'm', 4, ! Respiration by diatoms [mmolC/m2/d] +! 'respc ',1, 'm', 4, ! Respiration by coccolithophores [mmolC/(m2*d)] +! 'NPPn3D ',1, 'm', 4, ! Net primary production of small phytoplankton [mmolC/m2/d] +! 'NPPd3D ',1, 'm', 4, ! Net primary production of diatoms [mmolC/m2/d] +! 'NPPc3D ',1, 'm', 4, ! Net primary production of coccolithophores [mmolC/m2/d] + +! --- WATER ISOTOPES IN OCEAN (require lwiso=.true.) --- +! 'h2o18 ',1, 'm', 4, ! h2o18 concentration [kmol/m**3] +! 'hDo16 ',1, 'm', 4, ! hDo16 concentration [kmol/m**3] +! 'h2o16 ',1, 'm', 4, ! h2o16 concentration [kmol/m**3] + +! --- NEUTRAL SLOPES --- +! 'slopetap_x',1, 'm', 4, ! neutral slope tapered X [none] +! 'slopetap_y',1, 'm', 4, ! neutral slope tapered Y [none] +! 'slopetap_z',1, 'm', 4, ! neutral slope tapered Z [none] +! 'slope_x ',1, 'm', 4, ! neutral slope X [none] +! 'slope_y ',1, 'm', 4, ! neutral slope Y [none] +! 'slope_z ',1, 'm', 4, ! neutral slope Z [none] + +! --- MIXING AND DYNAMICS --- +! 'N2 ',1, 'm', 4, ! brunt väisälä [1/s2] +! 'Kv ',1, 'm', 4, ! vertical diffusivity Kv [m2/s] +! 'Av ',1, 'm', 4, ! vertical viscosity Av [m2/s] + +! --- VISCOSITY TENDENCIES (require dynamics%opt_visc==8) --- +! 'u_dis_tend',1, 'm', 4, ! horizontal velocity viscosity tendency [m/s] +! 'v_dis_tend',1, 'm', 4, ! meridional velocity viscosity tendency [m/s] +! 'u_back_tend',1, 'm', 4, ! horizontal velocity backscatter tendency [m2/s2] +! 'v_back_tend',1, 'm', 4, ! meridional velocity backscatter tendency [m2/s2] +! 'u_total_tend',1, 'm', 4,! horizontal velocity total viscosity tendency [m/s] +! 'v_total_tend',1, 'm', 4,! meridional velocity total viscosity tendency [m/s] + +! --- FERRARI/GM PARAMETERISATION (require Fer_GM=.true.) --- +! 'bolus_u ',1, 'm', 4, ! GM bolus velocity U [m/s] +! 'bolus_v ',1, 'm', 4, ! GM bolus velocity V [m/s] +! 'bolus_w ',1, 'm', 4, ! GM bolus velocity W [m/s] +! 'fer_K ',1, 'm', 4, ! GM, stirring diff. [m2/s] +! 'fer_scal ',1, 'm', 4, ! GM surface scaling [] +! 'fer_C ',1, 'm', 4, ! GM, depth independent speed [m/s] +! 'cfl_z ',1, 'm', 4, ! vertical CFL criteria [?] + +! --- DENSITY MOC DIAGNOSTICS (require ldiag_dMOC=.true.) --- +! 'dMOC ',1, 'm', 4, ! fluxes for density MOC (multiple variables) + +! --- PRESSURE GRADIENT FORCE --- +! 'pgf_x ',1, 'm', 4, ! zonal pressure gradient force [m/s^2] +! 'pgf_y ',1, 'm', 4, ! meridional pressure gradient force [m/s^2] + +! --- ALE LAYER THICKNESS --- +! 'hnode ',1, 'm', 4, ! vertice layer thickness [m] +! 'hnode_new ',1, 'm', 4, ! hnode_new [m] +! 'helem ',1, 'm', 4, ! elemental layer thickness [m] + +! --- OIFS/IFS INTERFACE (require __oifs or __ifsinterface) --- +! 'alb ',1, 'm', 4, ! ice albedo [none] +! 'ist ',1, 'm', 4, ! ice surface temperature [K] +! 'qsi ',1, 'm', 4, ! ice heat flux [W/m^2] +! 'qso ',1, 'm', 4, ! oce heat flux [W/m^2] +! 'enthalpy ',1, 'm', 4, ! enthalpy of fusion [W/m^2] +! 'qcon ',1, 'm', 4, ! conductive heat flux [W/m^2] +! 'qres ',1, 'm', 4, ! residual heat flux [W/m^2] +! 'runoff_liquid',1, 'm', 4, ! liquid water runoff [m/s] +! 'runoff_solid',1, 'm', 4, ! solid water runoff [m/s] + +! --- ICEBERG OUTPUTS (require use_icebergs=.true.) --- +! 'icb ',1, 'm', 4, ! iceberg outputs (multiple variables) + +! --- TKE MIXING DIAGNOSTICS (require mix_scheme_nmb==5 or 56) --- +! 'TKE ',1, 'm', 4, ! TKE diagnostics (multiple variables) + +! --- IDEMIX MIXING DIAGNOSTICS (require mod(mix_scheme_nmb,10)==6) --- +! 'IDEMIX ',1, 'm', 4, ! IDEMIX diagnostics (multiple variables) + +! --- TIDAL MIXING DIAGNOSTICS (require mod(mix_scheme_nmb,10)==7) --- +! 'TIDAL ',1, 'm', 4, ! TIDAL diagnostics (multiple variables) + +! --- FORCING DIAGNOSTICS (require ldiag_forc=.true.) --- +! 'FORC ',1, 'm', 4, ! forcing diagnostics (multiple variables) + +! --- DISCRETE VARIANCE DECAY (require ldiag_DVD=.true.) --- +! 'DVD ',1, 'm', 4, ! DVD diagnostics (multiple variables) + +! --- SPLIT-EXPLICIT SUBCYCLING (require dynamics%use_ssh_se_subcycl=.true.) --- +! 'SPLIT-EXPL',1, 'm', 4, ! split-explicit diagnostics (multiple variables) + +! --- SQUARED VELOCITIES (require ldiag_uvw_sqr=.true.) --- +! 'UVW_SQR ',1, 'm', 4, ! squared velocities (u2, v2, w2) + +! --- TRACER GRADIENTS (require ldiag_trgrd_xyz=.true.) --- +! 'TRGRD_XYZ ',1, 'm', 4, ! horizontal and vertical tracer gradients + +! --- CMOR DIAGNOSTICS FOR CMIP6/CMIP7 (require ldiag_cmor=.true.) --- +! 'tos ',1, 'm', 8, ! sea surface temperature [degC] (CMOR standard) +! 'sos ',1, 'm', 8, ! sea surface salinity [psu] (CMOR standard) +! 'pbo ',1, 'm', 8, ! sea water pressure at sea floor [Pa] +! 'opottemptend',1, 'm', 8,! ocean potential temperature tendency [W/m^2] +! 'volo ',1, 'm', 8, ! ocean volume [m^3] (global scalar) +! 'soga ',1, 'm', 8, ! global mean sea water salinity [psu] (global scalar) +! 'thetaoga ',1, 'm', 8, ! global mean sea water potential temperature [degC] (global scalar) +! 'siarean ',1, 'm', 8, ! sea ice area Northern hemisphere [10^12 m^2] (global scalar) +! 'siareas ',1, 'm', 8, ! sea ice area Southern hemisphere [10^12 m^2] (global scalar) +! 'siextentn ',1, 'm', 8, ! sea ice extent Northern hemisphere [10^12 m^2] (global scalar) +! 'siextents ',1, 'm', 8, ! sea ice extent Southern hemisphere [10^12 m^2] (global scalar) +! 'sivoln ',1, 'm', 8, ! sea ice volume Northern hemisphere [10^9 m^3] (global scalar) +! 'sivols ',1, 'm', 8, ! sea ice volume Southern hemisphere [10^9 m^3] (global scalar) + +! ============================================================================ +! END OF CATALOG +! ============================================================================ diff --git a/config/bin_2p1z1d_tp/namelist.oce b/config/bin_2p1z1d_tp/namelist.oce new file mode 100644 index 000000000..c0dc986bd --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.oce @@ -0,0 +1,76 @@ +! ============================================================================ +! ============ Namelist file for FESOM2 ocean dynamics ====================== +! ============================================================================ +! This file contains configuration for ocean dynamics and parameterizations: +! - Bottom drag and vertical viscosity +! - Gent-McWilliams (GM) eddy parameterization +! - Redi isopycnal diffusion +! - Vertical mixing schemes (KPP, PP) +! - Convection parameters +! - Tidal forcing +! ============================================================================ + +! ============================================================================ +! OCEAN DYNAMICS AND PARAMETERIZATIONS +! ============================================================================ +&oce_dyn +! --- Basic ocean dynamics parameters --- +C_d = 0.0025 ! bottom drag coefficient (dimensionless, typical: 0.0025) +A_ver = 1.e-4 ! background vertical viscosity [m²/s] +scale_area = 5.8e9 ! reference element area for viscosity/diffusivity scaling [m²] + +! --- Salt Plume Parameterization --- +SPP = .false. ! enable Salt Plume Parameterization (for brine rejection under sea ice) + +! --- Gent-McWilliams (GM) Eddy Parameterization --- +Fer_GM = .true. ! to swith on/off GM after Ferrari et al. 2010 +K_GM_max = 1000.0 ! max. GM thickness diffusivity (m2/s) +K_GM_min = 2.0 ! max. GM thickness diffusivity (m2/s) +K_GM_bvref = 1 ! def of bvref in ferreira scaling 0=srf,1=bot mld,2=mean over mld,3=weighted mean over mld +K_GM_rampmax = -1.0 ! Resol >K_GM_rampmax[km] GM on +K_GM_rampmin = -1.0 ! Resol tiny because HetRespFlux ~ hetC**2. +pzDia = 1.0d0 !0.5d0 ! Maximum diatom preference +sDiaNsq = 0.d0 +pzPhy = 0.5d0 !0.25d0 !1.0d0 ! Maximum nano-phytoplankton preference (NEW: 3/12) +sPhyNsq = 0.d0 +pzCocco = 0.666d0 ! NEW (8/12) +sCoccoNsq = 0.d0 ! NEW +pzMicZoo = 1.0d0 ! NEW 3Zoo Maximum nano-phytoplankton preference +sMicZooNsq = 0.d0 ! NEW 3Zoo +/ + +&pasecondzooplankton +graz_max2 = 0.1d0 ! [mmol N/(m3 * day)] Maximum grazing loss parameter +epsilon2 = 0.0144d0 ! [(mmol N)2 /m6] Half saturation constant for grazing loss +res_zoo2 = 0.0107d0 ! [1/day] Respiration by heterotrophs and mortality (loss to detritus) +loss_zoo2 = 0.003d0 ! [1/day] Temperature dependent N degradation of extracellular organic N (EON) + +fecal_rate_n = 0.104d0 ! [1/day] Temperature dependent N degradation of \ +fecal_rate_c = 0.236d0 +fecal_rate_n_mes = 0.25d0 ! NEW 3Zoo +fecal_rate_c_mes = 0.32d0 ! NEW 3Zoo + +pzDia2 = 1.5d0 !1.d0 ! Maximum diatom preference +sDiaNsq2 = 0.d0 +pzPhy2 = 0.5d0 ! Maximum diatom preference +sPhyNsq2 = 0.d0 +pzCocco2 = 0.5d0 ! NEW +sCoccoNsq2 = 0.d0 ! NEW +pzHet = 1.5d0 !0.8d0 ! Maximum diatom preference +sHetNsq = 0.d0 + +t1_zoo2 = 28145.d0 ! Krill temp. function constant1 +t2_zoo2 = 272.5d0 ! Krill temp. function constant2 +t3_zoo2 = 105234.d0 ! Krill temp. function constant3 +t4_zoo2 = 274.15d0 ! Krill temp. function constant3 +/ + +&pathirdzooplankton +graz_max3 = 0.46d0 ! NEW 3Zoo [mmol N/(m3 * day)] Maximum grazing loss parameter +epsilon3 = 0.64d0 ! NEW 3Zoo [(mmol N)2 /m6] Half saturation constant for grazing loss +loss_miczoo = 0.01d0 ! NEW 3Zoo [1/day] Temperature dependent N degradation of extracellular organic N (EON) +res_miczoo = 0.01d0 ! NEW 3Zoo [1/day] Respiration by heterotrophs and mortality (loss to detritus) +pzDia3 = 0.5d0 ! NEW 3Zoo Maximum diatom preference +sDiaNsq3 = 0.d0 ! NEW 3Zoo +pzPhy3 = 1.0d0 ! NEW 3Zoo Maximum nano-phytoplankton preference +sPhyNsq3 = 0.d0 ! NEW 3Zoo +pzCocco3 = 0.d0 ! NEW 3Zoo Maximum coccolithophore preference ! ATTENTION: This value needs to be tuned; I start with zero preference! +sCoccoNsq3 = 0.d0 ! NEW 3Zoo +/ + +&pagrazingdetritus +pzDet = 0.5d0 ! Maximum small detritus prefence by first zooplankton +sDetNsq = 0.d0 +pzDetZ2 = 0.5d0 ! Maximum large detritus preference by first zooplankton +sDetZ2Nsq = 0.d0 +pzDet2 = 0.5d0 ! Maximum small detritus prefence by second zooplankton +sDetNsq2 = 0.d0 +pzDetZ22 = 0.5d0 ! Maximum large detritus preference by second zooplankton +sDetZ2Nsq2 = 0.d0 +/ + +&paaggregation +agg_PD = 0.165d0 ! [m3/(mmol N * day)] Maximum aggregation loss parameter for DetN +agg_PP = 0.015d0 ! [m3/(mmol N * day)] Maximum aggregation loss parameter for PhyN and DiaN (plankton) +/ + +&padin_rho_N +rho_N = 0.11d0 ! [1/day] Temperature dependent N degradation of extracellular organic N (EON) (Remineralization of DON) +/ + +&padic_rho_C1 +rho_C1 = 0.1d0 ! [1/day] Temperature dependent C degradation of extracellular organic C (EOC) +/ + +&paphytoplankton_N +lossN = 0.05d0 ! [1/day] Phytoplankton loss of organic N compounds +lossN_d = 0.05d0 +lossN_c = 0.05d0 ! NEW +/ + +&paphytoplankton_C +lossC = 0.10d0 ! [1/day] Phytoplankton loss of carbon +lossC_d = 0.10d0 +lossC_c = 0.10d0 ! NEW +/ + +&paphytoplankton_ChlA +deg_Chl = 0.25d0 !0.2d0 !0.25d0 ! [1/day] +deg_Chl_d = 0.15d0 !0.2d0 !0.15d0 +deg_Chl_c = 0.2d0 ! NEW (has been 0.5) +/ + +&padetritus_N +gfin = 0.3d0 ! NEW 3Zoo [] Grazing efficiency (fraction of grazing flux into zooplankton pool) +grazEff2 = 0.8d0 ! [] Grazing efficiency (fraction of grazing flux into second zooplankton pool) +grazEff3 = 0.8d0 ! NEW 3Zoo [] Grazing efficiency (fraction of grazing flux into microzooplankton pool) +reminN = 0.165d0 ! [1/day] Temperature dependent remineralisation rate of detritus +/ + +&padetritus_C +reminC = 0.15d0 ! [1/day] Temperature dependent remineralisation rate of detritus +rho_c2 = 0.1d0 ! [1/day] Temperature dependent C degradation of TEP-C +/ + +&paheterotrophs +lossN_z = 0.1d0 +lossC_z = 0.1d0 +/ + +&paseczooloss +lossN_z2 = 0.02d0 +lossC_z2 = 0.02d0 +/ + +&pathirdzooloss +lossN_z3 = 0.05d0 ! NEW 3Zoo +lossC_z3 = 0.05d0 ! NEW 3Zoo +/ + +&paco2lim ! NEW +Cunits = 976.5625 ! Conversion factor between [mol/m3] (model) and [umol/kg] (function): (1000 * 1000) / 1024 +a_co2_phy = 1.162e+00 ! [dimensionless] +a_co2_dia = 1.040e+00 ! [dimensionless] +a_co2_cocco = 1.109e+00 ! [dimensionless] +a_co2_calc = 1.102e+00 ! [dimensionless] +b_co2_phy = 4.888e+01 ! [mol/kg] +b_co2_dia = 2.890e+01 ! [mol/kg] +b_co2_cocco = 3.767e+01 ! [mol/kg] +b_co2_calc = 4.238e+01 ! [mol/kg] +c_co2_phy = 2.255e-01 ! [kg/mol] +c_co2_dia = 8.778e-01 ! [kg/mol] +c_co2_cocco = 3.912e-01 ! [kg/mol] +c_co2_calc = 7.079e-01 ! [kg/mol] +d_co2_phy = 1.023e+07 ! [kg/mol] +d_co2_dia = 2.640e+06 ! [kg/mol] +d_co2_cocco = 9.450e+06 ! [kg/mol] +d_co2_calc = 1.343e+07 ! [kg/mol] +/ + +&pairon +Fe2N = 0.033d0 ! Fe2C * 6.625 +Fe2N_benthos = 0.15d0 ! test, default was 0.14 Fe2C_benthos * 6.625 - will have to be tuned. [umol/m2/day] +kScavFe = 0.07d0 +dust_sol = 0.02d0 ! Dissolution of Dust for bioavaliable +RiverFeConc = 100 +/ + +&pacalc +calc_prod_ratio = 0.02 +calc_diss_guts = 0.0d0 +calc_diss_rate = 0.005714 ! 20.d0/3500.d0 +calc_diss_rate2 = 0.005714d0 +calc_diss_omegac = 0.197d0 ! NEW DISS Value from Aumont et al. 2015, will be used with OmegaC_diss flag +calc_diss_exp = 1.d0 ! NEW DISS Exponent in the dissolution rate of calcite, will be used with OmegaC_diss flag +/ + +&pabenthos_decay_rate +decayRateBenN = 0.005d0 +decayRateBenC = 0.005d0 +decayRateBenSi = 0.005d0 +q_NC_Denit = 0.86d0 ! N:C quota of the denitrification process +/ + +&paco2_flux_param +permil = 0.000000976 ! 1.e-3/1024.5d0 ! Converting DIC from [mmol/m3] to [mol/kg] +permeg = 1.e-6 ! [atm/uatm] Changes units from uatm to atm +!X1 = exp(-5.d0*log(10.d0)) ! Lowest ph-value = 7.7 (phlo) +!X2 = exp(-9.d0*log(10.d0)) ! Highest ph-value = 9.5 (phhi) +Xacc = 1.e-12 ! Accuracy for ph-iteration (phacc) +CO2_for_spinup = 278.d0 ! [uatm] Atmospheric partial pressure of CO2 +/ + +&paalkalinity_restoring +surf_relax_Alk = 3.2e-07 !10.d0/31536000.d0 +/ + +&paballasting +rho_POC = 1033.d0 ! kg m-3; density of POC (see Table 1 in Cram et al., 2018) +rho_PON = 1033.d0 ! kg m-3; density of PON (see Table 1 in Cram et al., 2018) +rho_CaCO3 = 2830.d0 ! kg m-3; density of CaCO3 (see Table 1 in Cram et al., 2018) +rho_opal = 2090.d0 ! kg m-3; density of Opal (see Table 1 in Cram et al., 2018) +rho_ref_part = 1230.d0 ! kg m-3; reference particle density (see Cram et al., 2018) +rho_ref_water = 1027.d0 ! kg m-3; reference seawater density (see Cram et al., 2018) +visc_ref_water = 0.00158d0 ! kg m-1 s-1; reference seawater viscosity, at Temp=4 degC (see Cram et al., 2018) +w_ref1 = 10.d0 ! m s-1; reference sinking velocity of small detritus +w_ref2 = 200.d0 ! m s-1; reference sinking velocity of large detritus +depth_scaling1 = 0.015d0 ! s-1; factor to increase sinking speed of det1 with depth, set to 0 if not wanted +depth_scaling2 = 0.d0 ! s-1; factor to increase sinking speed of det2 with depth, set to 0 if not wanted +max_sinking_velocity = 250.d0 ! d-1; for numerical stability, set a maximum possible sinking velocity here (applies to both detritus classes) +/ + +&paciso +ciso_init = .false. ! initial fractionation of bulk organic matter +ciso_14 = .false. ! include inorganic radiocarbon +ciso_organic_14 = .false. ! include organic radiocarbon +lambda_14 = 3.8561e-12 ! corresponding to 1 year = 365.00 days +delta_CO2_13 = -6.61 ! atmospheric d13C (permil), global-mean value +big_delta_CO2_14(1) = 0. ! atmospheric D14C (permil), northern hemisphere polewards of 30°N +big_delta_CO2_14(2) = 0. ! atmospheric D14C (permil), (sub) tropical zone 30°N - 30°S +big_delta_CO2_14(3) = 0. ! atmospheric D14C (permil), southern hemisphere polewards of 30°S +atbox_spinup = .false. +cosmic_14_init = 2.0 +/ + diff --git a/config/bin_2p1z1d_tp/namelist.tra b/config/bin_2p1z1d_tp/namelist.tra new file mode 100644 index 000000000..aa70ba432 --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.tra @@ -0,0 +1,140 @@ +! ============================================================================ +! ============ Namelist file for FESOM2 tracer configuration ================= +! ============================================================================ +! This file contains configuration for ocean tracers (temperature, salinity, +! and passive tracers): +! - Tracer list and advection/diffusion schemes +! - Initial conditions (3D ocean and 2D sea ice) +! - Biharmonic diffusion options +! - Vertical diffusion and time stepping +! - Physical parameterizations (mixing, restoring) +! ============================================================================ + +! ============================================================================ +! TRACER ARRAY ALLOCATION +! ============================================================================ +&tracer_listsize +num_tracers = 100 ! number of tracers to allocate (must be ≥ actual number of tracers) +/ + +! ============================================================================ +! TRACER LIST AND ADVECTION SCHEMES +! ============================================================================ +! Format: ID, horizontal_advection, vertical_advection, horizontal_diffusion, Kh_factor, Kv_factor +! Advection schemes: 'MFCT' (Multidimensional FCT), 'UPW1' (1st-order upwind), 'QR4C' (4th-order) +! Diffusion schemes: 'FCT' (Flux-Corrected Transport), 'NON' (none) +! Order switches : hor./vert. Ord.=1.0 --> 4th order, =0.0 --> 3rd order, =0.5 --> mixed 3rd&4th order +! ============================================================================ +! nml_tracer_list = +! idx, hor. Adv, vert. Adv., use FCT, hor.Ord., vert. Ord. +! 1 , 'MFCT' , 'QR4C' , 'FCT ' , 1. , 1. , ! temperature +! 2 , 'MFCT' , 'QR4C' , 'FCT ' , 1. , 1. , ! salinity +!101 , 'UPW1' , 'UPW1' , 'NON ' , 0. , 0. ! example passive tracer +&tracer_list +nml_tracer_list = +1 , 'MFCT', 'QR4C', 'FCT ', 0., 1., +2 , 'MFCT', 'QR4C', 'FCT ', 0., 1., +1001, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1002, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1003, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1004, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1005, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1006, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1007, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1008, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1009, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1010, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1011, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1012, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1013, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1014, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1015, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1016, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1017, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1018, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1019, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1020, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1021, 'MFCT', 'QR4C', 'FCT ', 0., 1., +1022, 'MFCT', 'QR4C', 'FCT ', 0., 1. +!101, 'UPW1', 'UPW1', 'NON ', 0., 0. +/ + +! ============================================================================ +! 3D TRACER INITIAL CONDITIONS (OCEAN) +! ============================================================================ +&tracer_init3d +n_ic3d = 8 ! number of 3D tracers to initialize from files +idlist = 1019, 1022, 1018, 1003, 1002, 1001, 2, 1 ! tracer IDs to initialize (1=temperature, 2=salinity) +filelist = 'fe_pisces_opa_eq_init_3D_changed_name.nc', 'woa18_all_o00_01_mmol_fesom2.nc', 'woa13_all_i00_01_fesom2.nc', 'GLODAPv2.2016b.TAlk_fesom2_mmol_fix_z_Fillvalue.nc', 'GLODAPv2.2016b.TCO2_fesom2_mmol_fix_z_Fillvalue.nc', 'woa13_all_n00_01_fesom2.nc', 'phc3.0_winter.nc', 'phc3.0_winter.nc' ! netCDF files in ClimateDataPath (one per tracer) +varlist = 'Fe', 'oxygen_mmol', 'i_an', 'TAlk_mmol', 'TCO2_mmol', 'n_an', 'salt', 'temp' ! variable names in the netCDF files +t_insitu = .true. ! if true, convert in-situ temperature to potential temperature +/ + +! ============================================================================ +! 2D TRACER INITIAL CONDITIONS (SEA ICE) +! ============================================================================ +&tracer_init2d +n_ic2d = 3 ! number of 2D tracers to initialize from files +idlist = 1, 2, 3 ! tracer IDs (1=ice concentration, 2=ice thickness, 3=snow thickness) +filelist = 'a_ice.nc', 'm_ice.nc', 'm_snow.nc' ! netCDF files in ClimateDataPath +varlist = 'a_ice', 'm_ice', 'm_snow' ! variable names in the netCDF files +ini_ice_from_file = .false. ! enable initialization from files (false = use default values) +/ + +! ============================================================================ +! TRACER GENERAL SETTINGS +! ============================================================================ +&tracer_general +! --- Biharmonic Diffusion --- +! Recommended for very high resolution runs (where Redi is typically disabled) +smooth_bh_tra = .false. ! enable biharmonic diffusion (filter implementation) for tracers +gamma0_tra = 0.0005 ! background biharmonic diffusion coefficient [dimensionless] +gamma1_tra = 0.0125 ! flow-aware biharmonic diffusion coefficient [dimensionless] +gamma2_tra = 0. ! additional biharmonic diffusion coefficient [dimensionless] + +! --- Vertical Diffusion and Time Stepping --- +i_vert_diff = .true. ! use implicit vertical diffusion (recommended for stability) +AB_order = 2 ! Adams-Bashforth time stepping order (2 or 3) +/ + +! ============================================================================ +! TRACER PHYSICS AND PARAMETERIZATIONS +! ============================================================================ +&tracer_phys +! --- Monin-Obukhov Mixing (TB04) --- +use_momix = .false. ! enable Monin-Obukhov mixing (Timmermann & Beckmann 2004) +momix_lat = -50.0 ! latitude threshold for TB04 [degrees] (90 = global, -50 = south of 50°S) +momix_kv = 0.01 ! mixing coefficient within MO length [m²/s] + +! --- Convective Instability Mixing --- +use_instabmix = .true. ! enhance mixing for unstable stratification (convection) +instabmix_kv = 0.1 ! mixing coefficient for unstable stratification [m²/s] + +! --- Wind Mixing (PP scheme only) --- +use_windmix = .false. ! enhance near-surface mixing by wind (for PP mixing stability) +windmix_kv = 1.e-3 ! wind mixing coefficient [m²/s] +windmix_nl = 2 ! number of surface layers for wind mixing + +! --- Shear Instability (KPP) --- +diff_sh_limit = 5.0e-3 ! maximum diffusivity due to shear instability [m²/s] (for KPP) + +! --- Background Diffusivity --- +Kv0_const = .true. ! use constant background vertical diffusivity +K_ver = 1.0e-5 ! background vertical diffusivity [m²/s] +K_hor = 0. ! background horizontal diffusivity [m²/s] + +! --- Double Diffusion (KPP) --- +double_diffusion = .false. ! enable double diffusion parameterization (for KPP) + +! --- Surface Restoring --- +surf_relax_T = 0.0 ! surface temperature restoring coefficient [m/s] (0 = disabled) +surf_relax_S = 1.929e-06 ! surface salinity restoring coefficient [m/s] +balance_salt_water = .true. ! balance virtual salt flux with freshwater flux + +! --- Climatology Restoring --- +clim_relax = 0.0 ! 3D climatology restoring coefficient [1/s] (0 = disabled) + +! --- Reference Salinity --- +ref_sss_local = .true. ! use local reference SSS (true) or global constant (false) +ref_sss = 34. ! global reference salinity [psu] (if ref_sss_local=false) +/ diff --git a/config/bin_2p1z1d_tp/namelist.transit b/config/bin_2p1z1d_tp/namelist.transit new file mode 100644 index 000000000..80313df59 --- /dev/null +++ b/config/bin_2p1z1d_tp/namelist.transit @@ -0,0 +1,53 @@ +! ============================================================================ +! ========== Namelist file for FESOM2 transient tracers ===================== +! ============================================================================ +! This file contains configuration for transient tracer simulations: +! - Radioactive isotopes (14C, 39Ar) +! - Chlorofluorocarbons (CFC-11, CFC-12) +! - Sulfur hexafluoride (SF6) +! - Anthropogenic vs paleoclimate simulations +! - Atmospheric boundary conditions +! - Decay constants +! +! Requires use_transit=.true. in namelist.config +! ============================================================================ + +! ============================================================================ +! TRANSIENT TRACER CONFIGURATION +! ============================================================================ +&transit_param +! --- Enable Individual Tracers --- +l_r14c = .false. ! enable radiocarbon (14C/C ratio) +l_r39ar = .false. ! enable 39Ar/Ar ratio +l_f11 = .false. ! enable CFC-11 (chlorofluorocarbon) +l_f12 = .false. ! enable CFC-12 (chlorofluorocarbon) +l_sf6 = .false. ! enable SF6 (sulfur hexafluoride) + +! --- Simulation Type --- +anthro_transit = .false. ! anthropogenic transient tracer simulation (modern era) +paleo_transit = .false. ! paleoclimate transient tracer simulation + +! --- Time Series Configuration --- +length_transit = 1 ! length of atmospheric forcing time series + ! use 166 for anthro_transit=.true. (1765-2020) +ti_start_transit = 1 ! starting time index in forcing file + ! use 1 for D14C, 80 for CFC-12 + +! --- Atmospheric Forcing File --- +ifile_transit = '/work/ab0246/a270108/fesom2_recom_config/input-for-awiesm/Table_CO2_isoC_CFCs1112_SF6.txt' + ! path to atmospheric boundary condition file + +! --- Atmospheric Concentrations (Global Mean) --- +r14c_a = 1.0000 ! atmospheric 14C/C ratio [dimensionless] +r39ar_a = 1.0000 ! atmospheric 39Ar/Ar ratio [dimensionless] +xarg_a = 9.34e-3 ! atmospheric Argon mole fraction [dimensionless] +xco2_a = 284.32e-6 ! atmospheric CO2 mole fraction [dimensionless] (preindustrial: 284.32 ppm) + +! --- Initial Ocean Concentrations (Global Mean) --- +dic_0 = 2.00 ! mixed layer DIC concentration [mol/m³] +arg_0 = 0.01 ! mixed layer Argon concentration [mol/m³] + +! --- Radioactive Decay Constants --- +decay14 = 3.8561e-12 ! decay constant of 14C [1/s] (half-life: 5700 years, 1 year = 365.0 days) +decay39 = 8.1708e-11 ! decay constant of 39Ar [1/s] (half-life: 269 years, 1 year = 365.0 days) +/ diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7b0c28486..3b7997f9b 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -71,6 +71,9 @@ if(${ENABLE_OPENMP}) find_package(OpenMP REQUIRED COMPONENTS Fortran) endif() +option(RECOM_COUPLED "Use RECOM" OFF) +message(STATUS "RECOM_COUPLED: ${RECOM_COUPLED}") + option(USE_ICEPACK "Use ICEPACK" OFF) message(STATUS "USE_ICEPACK: ${USE_ICEPACK}") @@ -317,7 +320,7 @@ if(OPENMP_REPRODUCIBLE) endif() if(${RECOM_COUPLED}) - target_compile_definitions(${PROJECT_NAME} PRIVATE __recom USE_PRECISION=2 __3Zoo2Det __coccos)# __usetp) + target_compile_definitions(${PROJECT_NAME} PRIVATE __recom USE_PRECISION=2 __usetp) #__3Zoo2Det __coccos) endif() if(${CISO_COUPLED}) @@ -332,7 +335,7 @@ endif() if(${CMAKE_Fortran_COMPILER_ID} STREQUAL Intel OR ${CMAKE_Fortran_COMPILER_ID} STREQUAL IntelLLVM ) # Base compiler flags - target_compile_options(${PROJECT_NAME} PRIVATE -O3 -r8 -i4 -fp-model precise -no-prec-div -fimf-use-svml -init=zero -no-wrap-margin -fpe0 -fpp) + target_compile_options(${PROJECT_NAME} PRIVATE -O3 -r8 -i4 -fp-model precise -no-prec-div -fimf-use-svml -init=zero -no-wrap-margin -fpe0 -fpp -fPIC) # compiler flags not supported by IntelLLVM if(${CMAKE_Fortran_COMPILER_ID} STREQUAL Intel ) @@ -353,7 +356,7 @@ if(${CMAKE_Fortran_COMPILER_ID} STREQUAL Intel OR ${CMAKE_Fortran_COMPILER_ID} # | Intel/MPI | -O3 | 144s | # |*Intel/MPI | -03 -march=core-avx2 -mtune=core-avx2 -qopt-zmm-usage=low | 140.95s | # | | -align array64byte -unroll-aggressive -qopt-malloc-options=2 | | - #target_compile_options(${PROJECT_NAME} PRIVATE -march=core-avx2 -mtune=core-avx2 -qopt-zmm-usage=low -align array64byte -unroll-aggressive -qopt-malloc-options=2) + # target_compile_options(${PROJECT_NAME} PRIVATE -march=core-avx2 -mtune=core-avx2 -qopt-zmm-usage=low -align array64byte -unroll-aggressive -qopt-malloc-options=2 -g -traceback -check) elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL leo-dcgp ) target_compile_options(${PROJECT_NAME} PRIVATE -xCORE-AVX512 -qopt-zmm-usage=high -align array64byte -ipo) elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL mn5-gpp ) @@ -431,7 +434,7 @@ elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU ) # | | -mno-fma4 -mavx2 -mfma | | # | GCC/openMPI | -O3 -march=znver3 -mtune=znver3 -ftree-vectorize -flto | 280s | chatgpt recomendation # | | -mcpu=znver3 | | - target_compile_options(${PROJECT_NAME} PRIVATE -march=znver3 -mtune=znver3 -ftree-vectorize -flto) + target_compile_options(${PROJECT_NAME} PRIVATE -march=znver3 -mtune=znver3 -ftree-vectorize -flto -fPIC) else() #[[if(NOT (${FESOM_PLATFORM_STRATEGY} STREQUAL ubuntu)) target_compile_options(${PROJECT_NAME} PRIVATE -native) diff --git a/src/MOD_PARTIT.F90 b/src/MOD_PARTIT.F90 index 2e8330a4b..4d74977d3 100644 --- a/src/MOD_PARTIT.F90 +++ b/src/MOD_PARTIT.F90 @@ -71,6 +71,12 @@ module MOD_PARTIT integer :: MPI_COMM_FESOM ! FESOM communicator (for ocean only runs if often a copy of MPI_COMM_WORLD) integer :: MPI_COMM_WORLD ! FESOM communicator (for ocean only runs if often a copy of MPI_COMM_WORLD) +! communicator for multi FESOM group loop parallelization + integer :: MPI_COMM_FESOM_WORLD + +! communicator for multi FESOM group loop parallelization + integer :: MPI_COMM_FESOM_SAME_RANK_IN_GROUPS + ! MPI Datatypes for interface exchange ! Element fields (2D; 2D integer; 3D with nl-1 or nl levels, 1 - 4 values) ! small halo and / or full halo @@ -85,8 +91,12 @@ module MOD_PARTIT integer, allocatable :: s_mpitype_nod2D(:), r_mpitype_nod2D(:) integer, allocatable :: s_mpitype_nod2D_i(:), r_mpitype_nod2D_i(:) integer, allocatable :: s_mpitype_nod3D(:,:,:), r_mpitype_nod3D(:,:,:) + integer, allocatable :: s_mpitype_nod4D(:,:,:,:), r_mpitype_nod4D(:,:,:,:) + + integer :: MPIERR - integer :: MPIERR +! multi FESOM group loop parallelization + integer :: my_fesom_group !!! remPtr_* are constructed during the runtime and shall not be dumped!!! integer, allocatable :: remPtr_nod2D(:), remList_nod2D(:) diff --git a/src/MOD_TRACER.F90 b/src/MOD_TRACER.F90 index efeeed623..ae98f4a6c 100644 --- a/src/MOD_TRACER.F90 +++ b/src/MOD_TRACER.F90 @@ -20,6 +20,9 @@ MODULE MOD_TRACER real(kind=WP) :: tra_adv_pv = 1. ! a parameter to be used in horizontal advection (for QR4C it is the fraction of fourth-order contribution in the solution) integer :: AB_order=2 integer :: ID +!___________________________________________________________________________ +! TODO: Make it as a part of namelist.tra +logical :: ltra_diag = .false. ! OG - tra_diag contains procedure WRITE_T_TRACER_DATA @@ -41,7 +44,14 @@ MODULE MOD_TRACER ! compute Tstar = 0.5*( T^(n+1) + T^n) real(kind=WP), allocatable, dimension(:,:,:) :: dvd_trflx_hor, dvd_trflx_ver -!_______________________________________________________________________________ +! in case ltra_diag=.true. --> calculate tracer diags ! OG - tra_diag +real(kind=WP), allocatable :: tra_advhoriz(:,:,:), tra_advvert(:,:,:) +real(kind=WP), allocatable :: tra_diff_part_hor_redi(:,:,:) +real(kind=WP), allocatable :: tra_diff_part_ver_expl(:,:,:) +real(kind=WP), allocatable :: tra_diff_part_ver_redi_expl(:,:,:) +real(kind=WP), allocatable :: tra_diff_part_ver_impl(:,:,:) +real(kind=WP), allocatable :: tra_recom_sms(:,:,:) + ! The fct part real(kind=WP),allocatable,dimension(:,:) :: fct_LO ! Low-order solution real(kind=WP),allocatable,dimension(:,:) :: adv_flux_hor ! Antidif. horiz. contrib. from edges / backup for iterafive fct scheme diff --git a/src/associate_part_ass.h b/src/associate_part_ass.h index 615095acc..7f182a021 100644 --- a/src/associate_part_ass.h +++ b/src/associate_part_ass.h @@ -1,3 +1,5 @@ +MPI_COMM_FESOM_WORLD => partit%MPI_COMM_FESOM_WORLD +MPI_COMM_FESOM_SAME_RANK_IN_GROUPS => partit%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS MPI_COMM_FESOM => partit%MPI_COMM_FESOM MPI_COMM_FESOM_IB => partit%MPI_COMM_FESOM_IB com_nod2D => partit%com_nod2D @@ -13,9 +15,10 @@ eDim_edge2D => partit%eDim_edge2D pe_status => partit%pe_status elem_full_flag => partit%elem_full_flag MPIERR => partit%MPIERR -MPIERR_IB => partit%MPIERR_IB +MPIERR_IB => partit%MPIERR_IB npes => partit%npes mype => partit%mype +my_fesom_group => partit%my_fesom_group maxPEnum => partit%maxPEnum part => partit%part @@ -69,4 +72,4 @@ if (allocated(partit%s_mpitype_nod2D)) then s_mpitype_nod3D(1:com_nod2D%sPEnum, lb:ub, 1:3) => partit%s_mpitype_nod3D(:,:,:) r_mpitype_nod3D(1:com_nod2D%rPEnum, lb:ub, 1:3) => partit%r_mpitype_nod3D(:,:,:) -end if \ No newline at end of file +end if diff --git a/src/associate_part_def.h b/src/associate_part_def.h index 262780a4a..c827a8762 100644 --- a/src/associate_part_def.h +++ b/src/associate_part_def.h @@ -1,3 +1,5 @@ + integer, pointer :: MPI_COMM_FESOM_WORLD + integer, pointer :: MPI_COMM_FESOM_SAME_RANK_IN_GROUPS integer, pointer :: MPI_COMM_FESOM ! FESOM communicator (for ocean only runs if often a copy of MPI_COMM_WORLD) integer, pointer :: MPI_COMM_FESOM_IB ! FESOM communicator copy for icebergs LA: 2023-05-22 type(com_struct), pointer :: com_nod2D @@ -20,6 +22,7 @@ integer, pointer :: MPIERR_IB ! copy for icebergs LA: 2023-05-22 integer, pointer :: npes integer, pointer :: mype + integer, pointer :: my_fesom_group integer, pointer :: maxPEnum integer, dimension(:), pointer :: part diff --git a/src/cpl_driver.F90 b/src/cpl_driver.F90 index d5ab69c69..91b8d8119 100644 --- a/src/cpl_driver.F90 +++ b/src/cpl_driver.F90 @@ -14,6 +14,10 @@ module cpl_driver ! use mod_oasis ! oasis module use g_config, only : dt, use_icebergs, lwiso, compute_oasis_corners +#if defined(__recom) && defined(__usetp) + use g_config, only : num_fesom_groups +#endif + use o_param, only : rad USE MOD_PARTIT use mpi @@ -311,7 +315,12 @@ subroutine node_contours(my_x_corners, my_y_corners, partit, mesh) my_y_corners=my_y_corners/rad end subroutine node_contours - subroutine cpl_oasis3mct_init(partit, localCommunicator ) +#if defined(__recom) && defined(__usetp) + subroutine cpl_oasis3mct_init(partit, localCommunicator, num_fesom_groups) +#else + subroutine cpl_oasis3mct_init(partit, localCommunicator) +#endif + USE MOD_PARTIT implicit none save @@ -325,6 +334,9 @@ subroutine cpl_oasis3mct_init(partit, localCommunicator ) ! integer, intent(OUT) :: localCommunicator type(t_partit), intent(inout), target :: partit +#if defined(__recom) && defined(__usetp) + integer, intent(inout) :: num_fesom_groups +#endif ! ! Local declarations ! @@ -346,7 +358,11 @@ subroutine cpl_oasis3mct_init(partit, localCommunicator ) !------------------------------------------------------------------ ! 1st Initialize the OASIS3-MCT coupling system for the application !------------------------------------------------------------------ +#if defined(__recom) && defined(__usetp) + CALL oasis_init_comp(comp_id, comp_name, ierror, num_program_groups = num_fesom_groups) +#else CALL oasis_init_comp(comp_id, comp_name, ierror ) +#endif IF (ierror /= 0) THEN CALL oasis_abort(comp_id, 'cpl_oasis3mct_init', 'Init_comp failed.') ENDIF @@ -357,7 +373,11 @@ subroutine cpl_oasis3mct_init(partit, localCommunicator ) CALL oasis_abort(comp_id, 'cpl_oasis3mct_init', 'comm_rank failed.') ENDIF +#if defined(__recom) && defined(__usetp) + CALL oasis_get_localcomm_all_groups( localCommunicator, ierror ) +#else CALL oasis_get_localcomm( localCommunicator, ierror ) +#endif IF (ierror /= 0) THEN CALL oasis_abort(comp_id, 'cpl_oasis3mct_init', 'get_local_comm failed.') ENDIF @@ -611,6 +631,10 @@ subroutine cpl_oasis3mct_define_unstr(partit, mesh) print *, 'FESOM after Barrier' endif +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif + if (mype .eq. localroot) then print *, 'FESOM before grid writing to oasis grid files' CALL oasis_start_grids_writing(il_flag) @@ -639,6 +663,9 @@ subroutine cpl_oasis3mct_define_unstr(partit, mesh) print *, 'FESOM after terminate_grids_writing' endif !localroot +#if defined(__recom) && defined(__usetp) + end if !(partit%my_fesom_group == 0) then +#endif DEALLOCATE(all_x_coords, all_y_coords, my_x_coords, my_y_coords, displs_from_all_pes, counts_from_all_pes) @@ -909,15 +936,49 @@ subroutine cpl_oasis3mct_recv(ind, data_array, action, partit) endif #endif +#if defined(__recom) && defined(__usetp) +! the coupling is in principle as it was before, i.e. the fesom processes - in group 0 - receive their data from echam + if(partit%my_fesom_group == 0) then +#endif + call oasis_get(recv_id(ind), seconds_til_now, exfld,info) + +#if defined(__recom) && defined(__usetp) + else + +! defensive: assignment statement "action=(info==3 ..." below is "don't care" in this case, because the actual value for action +! is received via MPI_Bcast anyway + info = 0 + + end if +#endif + t2=MPI_Wtime() ! ! FESOM's interpolation routine interpolates structured ! VarStrLoc coming from OASIS3MCT to local unstructured data_array ! and delivered back to FESOM. action=(info==3 .OR. info==10 .OR. info==11 .OR. info==12 .OR. info==13) + +#if defined(__recom) && defined(__usetp) + if(num_fesom_groups > 1) then + call MPI_Bcast(action, 1, MPI_LOGICAL, 0, partit%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, partit%MPIerr) + end if +#endif + if (action) then +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif data_array(1:partit%myDim_nod2d) = exfld +#if defined(__recom) && defined(__usetp) + end if + + if(num_fesom_groups > 1) then + call MPI_Bcast(data_array, partit%myDim_nod2d, MPI_DOUBLE_PRECISION, 0, partit%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, partit%MPIerr) + end if +#endif + call exchange_nod(data_array, partit) end if t3=MPI_Wtime() diff --git a/src/fesom_module.F90 b/src/fesom_module.F90 index 59f153840..b9b5f3e68 100755 --- a/src/fesom_module.F90 +++ b/src/fesom_module.F90 @@ -36,8 +36,10 @@ module fesom_main_storage_module use age_tracer_init_interface use iceberg_params use iceberg_step + use mod_transit use iceberg_ocean_coupling use Toy_Channel_Soufflet, only: compute_zonal_mean + ! Define icepack module #if defined (__icepack) @@ -68,6 +70,9 @@ module fesom_main_storage_module integer :: which_readr ! read which restart files (0=netcdf, 1=core dump,2=dtype) integer :: total_nsteps integer, pointer :: mype, npes, MPIerr, MPI_COMM_FESOM, MPI_COMM_WORLD, MPI_COMM_FESOM_IB +#if defined(__recom) && defined(__usetp) + integer, pointer :: my_fesom_group, MPI_COMM_FESOM_WORLD, MPI_COMM_FESOM_SAME_RANK_IN_GROUPS +#endif real(kind=WP) :: t0, t1, t2, t3, t4, t5, t6, t7, t8, t0_ice, t1_ice, t0_frc, t1_frc real(kind=WP) :: rtime_fullice, rtime_write_restart, rtime_write_means, rtime_compute_diag, rtime_read_forcing real(kind=real32) :: rtime_setup_mesh, rtime_setup_ocean, rtime_setup_forcing @@ -124,10 +129,27 @@ subroutine fesom_init(fesom_total_nsteps) #if defined(__MULTIO) use iom #endif + use cpl_driver integer, intent(out) :: fesom_total_nsteps ! EO parameters logical mpi_is_initialized integer :: tr_num + +#if defined(__recom) && defined(__usetp) +! multi FESOM group loop parallelization +! moved from fvom_main.F90 + integer :: npes_fesom_world + integer :: mype_fesom_world + integer :: processes_per_group + integer :: npes_check + integer :: mype_check + integer :: i + +! get current value for num_fesom_groups + call read_namelist_run_config + +#endif + #if !defined __ifsinterface if(command_argument_count() > 0) then call command_line_options%parse() @@ -158,9 +180,16 @@ subroutine fesom_init(fesom_total_nsteps) end if #endif + #if defined (__oasis) - call cpl_oasis3mct_init(f%partit,f%partit%MPI_COMM_FESOM) +#if defined(__recom) && defined(__usetp) +! pass num_fesom_groups to coupler + call cpl_oasis3mct_init(f%partit, f%partit%MPI_COMM_FESOM, num_fesom_groups) +#else + call cpl_oasis3mct_init(f%partit, f%partit%MPI_COMM_FESOM) +#endif + #elif defined (__yac) call cpl_yac_init(f%partit%MPI_COMM_FESOM) #endif @@ -189,7 +218,107 @@ subroutine fesom_init(fesom_total_nsteps) f%npes =>f%partit%npes - +#if defined(__recom) && defined(__usetp) +! prepare communicator splitting for multi FESOM group loop parallelization + f%my_fesom_group=>f%partit%my_fesom_group + + f%MPI_COMM_FESOM_WORLD=> f%partit%MPI_COMM_FESOM_WORLD + f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS=> f%partit%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS + + f%MPI_COMM_FESOM_WORLD = f%MPI_COMM_FESOM + npes_fesom_world = f%npes + mype_fesom_world = f%mype + if(mype_fesom_world == 0) then + write(*,*) 'npes_fesom_world, num_fesom_groups', npes_fesom_world, num_fesom_groups + end if + if(mod(npes_fesom_world, num_fesom_groups) /= 0) then + if(mype_fesom_world == 0) then + write(*,*) 'MPI_comm_split mismatch npes_fesom_world, num_fesom_groups', npes_fesom_world, num_fesom_groups + end if + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + processes_per_group = npes_fesom_world / num_fesom_groups + if(mype_fesom_world == 0) then + write(*,*) 'processes_per_group', processes_per_group + end if + f%npes = processes_per_group + f%my_fesom_group = mype_fesom_world / processes_per_group + f%mype = mod(mype_fesom_world, processes_per_group) + +! split to num_fesom_groups + call MPI_comm_split(f%MPI_COMM_FESOM_WORLD, f%my_fesom_group, 0, f%MPI_COMM_FESOM, f%MPIerr) + if (f%MPIerr /= MPI_SUCCESS) then + write(*,*) 'MPI_comm_split(MPI_COMM_FESOM_WORLD, my_fesom_group, 0, MPI_COMM_FESOM, MPIERR) failed' + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + call MPI_comm_size(f%MPI_COMM_FESOM, npes_check, f%MPIerr) + if(f%MPIerr /= MPI_SUCCESS) then + write(*,*) 'MPI_comm_size(MPI_COMM_FESOM, npes_check, MPIERR) failed' + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + call MPI_comm_rank(f%MPI_COMM_FESOM, mype_check, f%MPIerr) + if(f%MPIerr /= MPI_SUCCESS) then + write(*,*) 'MPI_comm_rank(MPI_COMM_FESOM, mype_check, MPIERR) failed' + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + if(npes_check /= f%npes) then + write(*,*) 'npes mismatch, npes, npes_check', f%npes, npes_check + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + if(mype_check /= f%mype) then + write(*,*) 'mype mismatch, mype, mype_check', f%mype, mype_check + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + +! group same ranks in each group for broadcasting + + call MPI_comm_split(f%MPI_COMM_FESOM_WORLD, f%mype, f%my_fesom_group, f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, f%MPIERR) + if (f%MPIERR /= MPI_SUCCESS) then + write(*,*) 'MPI_comm_split(MPI_COMM_FESOM_WORLD, mype, my_fesom_group, MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, MPIERR) failed' + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + call MPI_comm_size(f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, npes_check, f%MPIERR) + if(f%MPIERR /= MPI_SUCCESS) then + write(*,*) 'MPI_comm_size(MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, npes_check, MPIERR) failed' + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + call MPI_comm_rank(f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, mype_check, f%MPIERR) + if(f%MPIERR /= MPI_SUCCESS) then + write(*,*) 'MPI_comm_rank(MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, mype_check, MPIERR) failed' + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + if(npes_check /= num_fesom_groups) then + write(*,*) 'npes mismatch, num_fesom_groups, npes_check', num_fesom_groups, npes_check + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + if(mype_check /= f%my_fesom_group) then + write(*,*) 'mype mismatch, my_fesom_group, mype_check', f%my_fesom_group, mype_check + call par_ex(f%MPI_COMM_FESOM, f%mype) + stop + end if + + if(f%my_fesom_group==0) then +#endif + if(f%mype==0) then call plot_fesomlogo() write(*,*) @@ -199,6 +328,11 @@ subroutine fesom_init(fesom_total_nsteps) print *, achar(27)//'[32m' //'____________________________________________________________'//achar(27)//'[0m' print *, achar(27)//'[7;32m'//' --> FESOM BUILDS UP MODEL CONFIGURATION '//achar(27)//'[0m' end if + +#if defined(__recom) && defined(__usetp) + end if ! f%my_fesom_group==0 +#endif + !===================== ! Read configuration data, ! load the mesh and fill in @@ -209,6 +343,7 @@ subroutine fesom_init(fesom_total_nsteps) call fesom_profiler_start("setup_model") #endif call setup_model(f%partit) ! Read Namelists, always before clock_init + #if defined (FESOM_PROFILING) call fesom_profiler_end("setup_model") #endif @@ -225,6 +360,7 @@ subroutine fesom_init(fesom_total_nsteps) call fesom_profiler_set_timestep_size(86400.0d0 / real(step_per_day, kind=8)) #endif + if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call mesh_setup'//achar(27)//'[0m' #if defined (FESOM_PROFILING) call fesom_profiler_start("mesh_setup") @@ -234,22 +370,15 @@ subroutine fesom_init(fesom_total_nsteps) call fesom_profiler_end("mesh_setup") #endif +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif + if (f%mype==0) write(*,*) 'FESOM mesh_setup... complete' -! Transient tracers: control output of initial input values - if(use_transit .and. anthro_transit .and. f%mype==0) then - write (*,*) - write (*,*) "*** Transient tracers: Initial atmospheric input values >>>" - write (*,*) "Year CE, xCO2, D14C_NH, D14C_TZ, D14C_SH, xCFC-11_NH, xCFC-11_SH, xCFC-12_NH, xCFC-12_SH, xSF6_NH, xSF6_SH" - write (*, fmt="(2x,i4,10(2x,f6.2))") & - year_ce(ti_transit), xCO2_ti(ti_transit) * 1.e6, & - (r14c_nh(ti_transit) - 1.) * 1000., (r14c_tz(ti_transit) - 1.) * 1000., (r14c_sh(ti_transit) - 1.) * 1000., & - xf11_nh(ti_transit) * 1.e12, xf11_sh(ti_transit) * 1.e12, & - xf12_nh(ti_transit) * 1.e12, xf12_sh(ti_transit) * 1.e12, & - xsf6_nh(ti_transit) * 1.e12, xsf6_sh(ti_transit) * 1.e12 - write (*,*) +#if defined(__recom) && defined(__usetp) end if - +#endif !===================== ! Allocate field variables @@ -301,15 +430,36 @@ subroutine fesom_init(fesom_total_nsteps) ! recom setup #if defined (__recom) +#if defined (__usetp) + if(f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call recom_init'//achar(27)//'[0m' +#if defined (__usetp) + end if +#endif + f%t0_recom=MPI_Wtime() call recom_init(f%tracers, f%partit, f%mesh) ! adjust values for recom tracers (derived type "t_tracer") f%t1_recom=MPI_Wtime() + +#if defined (__usetp) + if(f%my_fesom_group==0) then +#endif if (f%mype==0) write(*,*) 'RECOM recom_init... complete' +#if defined (__usetp) + end if +#endif #endif if (f%mype==0) then +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif write(*,*) 'FESOM ocean_setup... complete' +#if defined(__recom) && defined(__usetp) + end if +#endif + f%t3=MPI_Wtime() endif call forcing_setup(f%partit, f%mesh) @@ -320,7 +470,15 @@ subroutine fesom_init(fesom_total_nsteps) call ice_setup(f%ice, f%tracers, f%partit, f%mesh) f%ice%ice_steps_since_upd = f%ice%ice_ave_steps-1 f%ice%ice_update=.true. + +#if defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (f%mype==0) write(*,*) 'EVP scheme option=', f%ice%whichEVP +#if defined(__usetp) + end if +#endif + else ! create a dummy ice derived type with only a_ice, m_ice, m_snow and ! uvice since oce_timesteps still needs in moment @@ -349,10 +507,38 @@ subroutine fesom_init(fesom_total_nsteps) !---age-code-end #if defined (__oasis) +! only mype == 0 in my_fesom_group == 0 handles coupling with extern models +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif call cpl_oasis3mct_define_unstr(f%partit, f%mesh) - if(f%mype==0) write(*,*) 'FESOM ----> cpl_oasis3mct_define_unstr nsend, nrecv:',nsend, nrecv +#if defined(__recom) && defined(__usetp) + end if #endif + +#if defined(__recom) && defined(__usetp) + call MPI_Barrier(f%MPI_COMM_FESOM_WORLD, f%MPIERR) + + if(num_fesom_groups > 1) then + call MPI_Bcast(nsend, 1, MPI_INTEGER, 0, f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, f%MPIerr) + call MPI_Bcast(nrecv, 1, MPI_INTEGER, 0, f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, f%MPIerr) + + if(f%my_fesom_group > 0) then + ALLOCATE(cpl_send(nsend)) + ALLOCATE(cpl_recv(nrecv)) + end if + +! kh 10.11.25 it is assumed here that both nsend and nrecv are >= 1 + call MPI_Bcast(cpl_send, len(cpl_send(1)) * nsend, MPI_CHARACTER, 0, f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, f%MPIerr) + call MPI_Bcast(cpl_recv, len(cpl_recv(1)) * nrecv, MPI_CHARACTER, 0, f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, f%MPIerr) + +! needed in SUBROUTINE net_rec_from_atm(action) + call MPI_Bcast(target_root, 1, MPI_INTEGER, 0, f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, f%MPIerr) + end if +#endif + +#endif ! defined (__oasis) ! -------------- ! LA icebergs: 2023-05-17 @@ -376,6 +562,7 @@ subroutine fesom_init(fesom_total_nsteps) call init_icepack(f%ice, f%tracers%data(1), f%mesh) if (f%mype==0) write(*,*) 'Icepack: setup complete' #endif + call clock_newyear ! check if it is a new year if (f%mype==0) f%t6=MPI_Wtime() !___READ INITIAL CONDITIONS IF THIS IS A RESTART RUN________________________ @@ -395,7 +582,14 @@ subroutine fesom_init(fesom_total_nsteps) end if ! store grid information into netcdf file + +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (.not. r_restart) call write_mesh_info(f%partit, f%mesh) +#if defined(__recom) && defined(__usetp) + end if +#endif !___IF RESTART WITH ZLEVEL OR ZSTAR IS DONE, ALSO THE ACTUAL LEVELS AND ____ !___MIDDEPTH LEVELS NEEDS TO BE CALCULATET AT RESTART_______________________ @@ -419,6 +613,10 @@ subroutine fesom_init(fesom_total_nsteps) f%rtime_setup_recom = real( f%t1_recom - f%t0_recom ,real32) #endif +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif + write(*,*) '==========================================' write(*,*) 'MODEL SETUP took on mype=0 [seconds] ' write(*,*) 'runtime setup total ',real(f%t8-f%t1,real32) @@ -432,6 +630,11 @@ subroutine fesom_init(fesom_total_nsteps) write(*,*) ' > runtime setup recom ',f%rtime_setup_recom #endif write(*,*) '============================================' + +#if defined(__recom) && defined(__usetp) + end if +#endif + endif #if defined(__MULTIO) @@ -555,25 +758,46 @@ subroutine fesom_runloop(current_nsteps) ! -------------- ! LA icebergs: 2023-05-17 + if (use_icebergs) then f%MPI_COMM_FESOM_IB = f%MPI_COMM_FESOM if (f%mype==0) then ! write (*,*) 'ib_async_mode, initial omp_num_threads ', ib_async_mode, omp_get_num_threads() write (*,*) 'current_nsteps, steps_per_ib_step, icb_outfreq :', current_nsteps, steps_per_ib_step, icb_outfreq end if + end if ! -------------- - +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (f%mype==0) write(*,*) 'FESOM start iteration before the barrier...' +#if defined(__recom) && defined(__usetp) + end if +#endif call MPI_Barrier(f%MPI_COMM_FESOM, f%MPIERR) if (f%mype==0) then +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif write(*,*) 'FESOM start iteration after the barrier...' +#if defined(__recom) && defined(__usetp) + end if +#endif f%t0 = MPI_Wtime() endif + +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if(f%mype==0) then write(*,*) print *, achar(27)//'[32m' //'____________________________________________________________'//achar(27)//'[0m' print *, achar(27)//'[7;32m'//' --> FESOM STARTS TIME LOOP '//achar(27)//'[0m' end if - + +#if defined(__recom) && defined(__usetp) + end if +#endif + ! Start main time loop profiling #if defined (FESOM_PROFILING) call fesom_profiler_start("fesom_runloop_total") @@ -639,18 +863,32 @@ subroutine fesom_runloop(current_nsteps) call foreph(f%partit, f%mesh) end if mstep = n + +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (mod(n,logfile_outfreq)==0 .and. f%mype==0) then write(*,*) 'FESOM =======================================================' ! write(*,*) 'FESOM step:',n,' day:', n*dt/24./3600., write(*,*) 'FESOM step:',n,' day:', daynew,' year:',yearnew write(*,*) end if +#if defined(__recom) && defined(__usetp) + end if +#endif + #if defined (__oifs) || defined (__oasis) seconds_til_now=INT(dt)*(n-1) #endif call clock !___compute horizontal velocity on nodes (originaly on elements)________ +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call compute_vel_nodes'//achar(27)//'[0m' +#if defined(__recom) && defined(__usetp) + end if +#endif call compute_vel_nodes(f%dynamics, f%partit, f%mesh) ! -------------- ! LA icebergs: 2023-05-17 @@ -664,11 +902,23 @@ subroutine fesom_runloop(current_nsteps) f%t1 = MPI_Wtime() if(use_ice) then !___compute fluxes from ocean to ice________________________________ +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call ocean2ice(n)'//achar(27)//'[0m' +#if defined(__recom) && defined(__usetp) + end if +#endif call ocean2ice(f%ice, f%dynamics, f%tracers, f%partit, f%mesh) !___compute update of atmospheric forcing____________________________ +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call update_atm_forcing(n)'//achar(27)//'[0m' +#if defined(__recom) && defined(__usetp) + end if +#endif f%t0_frc = MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_start("update_atm_forcing") @@ -690,7 +940,14 @@ subroutine fesom_runloop(current_nsteps) f%ice%ice_update=.false. f%ice%ice_steps_since_upd=f%ice%ice_steps_since_upd+1 endif +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call ice_timestep(n)'//achar(27)//'[0m' + +#if defined(__recom) && defined(__usetp) + end if +#endif if (f%ice%ice_update) then #if defined (FESOM_PROFILING) call fesom_profiler_start("ice_timestep") @@ -702,7 +959,13 @@ subroutine fesom_runloop(current_nsteps) endif !___compute fluxes to the ocean: heat, freshwater, momentum_________ +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call oce_fluxes_mom...'//achar(27)//'[0m' +#if defined(__recom) && defined(__usetp) + end if +#endif call oce_fluxes_mom(f%ice, f%dynamics, f%partit, f%mesh) ! momentum only call oce_fluxes(f%ice, f%dynamics, f%tracers, f%partit, f%mesh) end if @@ -711,15 +974,30 @@ subroutine fesom_runloop(current_nsteps) !___now recom____________________________________________________ #if defined (__recom) +#if defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (f%mype==0 .and. n==1) print *, achar(27)//'[46' //'_____________________________________________________________'//achar(27)//'[0m' if (f%mype==0 .and. n==1) print *, achar(27)//'[46;1m'//' --> call REcoM '//achar(27)//'[0m' +#if defined(__usetp) + end if +#endif + f%t0_recom = MPI_Wtime() call recom(f%ice, f%dynamics, f%tracers, f%partit, f%mesh) f%t1_recom = MPI_Wtime() #endif !___model ocean step____________________________________________________ +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call oce_timestep_ale'//achar(27)//'[0m' + +#if defined(__recom) && defined(__usetp) + end if +#endif + #if defined (FESOM_PROFILING) call fesom_profiler_start("oce_timestep_ale") #endif @@ -738,9 +1016,18 @@ subroutine fesom_runloop(current_nsteps) f%t3 = MPI_Wtime() !___compute energy diagnostics..._______________________________________ +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call compute_diagnostics(1)'//achar(27)//'[0m' + +#if defined(__recom) && defined(__usetp) + end if +#endif + #if defined (FESOM_PROFILING) call fesom_profiler_start("compute_diagnostics") + #endif call compute_diagnostics(1, f%dynamics, f%tracers, f%ice, f%partit, f%mesh) #if defined (FESOM_PROFILING) @@ -749,6 +1036,9 @@ subroutine fesom_runloop(current_nsteps) f%t4 = MPI_Wtime() !___prepare output______________________________________________________ +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call output (n)'//achar(27)//'[0m' #if defined (FESOM_PROFILING) call fesom_profiler_start("output") @@ -757,7 +1047,9 @@ subroutine fesom_runloop(current_nsteps) #if defined (FESOM_PROFILING) call fesom_profiler_end("output") #endif - +#if defined(__recom) && defined(__usetp) + end if +#endif ! LA icebergs: 2023-05-17 if (use_icebergs .and. mod(n, steps_per_ib_step)==0.0) then call reset_ib_fluxes @@ -783,23 +1075,6 @@ subroutine fesom_runloop(current_nsteps) f%rtime_compute_recom = f%rtime_compute_recom + f%t1_recom - f%t0_recom #endif -! Transient tracers: update of input values between restarts - if(use_transit .and. anthro_transit .and. (daynew == ndpyr) .and. (timenew==86400.)) then - ti_transit = ti_transit + 1 - if (f%mype==0) then - write (*,*) - write (*,*) "*** Transient tracers: Updated atmospheric input values >>>" - write (*,*) "Year CE, xCO2, D14C_NH, D14C_TZ, D14C_SH, xCFC-11_NH, xCFC-11_SH, xCFC-12_NH, xCFC-12_SH, xSF6_NH, xSF6_SH" - write (*, fmt="(2x,i4,10(2x,f6.2))") & - year_ce(ti_transit), xCO2_ti(ti_transit) * 1.e6, & - (r14c_nh(ti_transit) - 1.) * 1000., (r14c_tz(ti_transit) - 1.) * 1000., (r14c_sh(ti_transit) - 1.) * 1000., & - xf11_nh(ti_transit) * 1.e12, xf11_sh(ti_transit) * 1.e12, & - xf12_nh(ti_transit) * 1.e12, xf12_sh(ti_transit) * 1.e12, & - xsf6_nh(ti_transit) * 1.e12, xsf6_sh(ti_transit) * 1.e12 - write (*,*) - end if - endif - end do !call cray_acc_set_debug_global_level(3) f%from_nstep = f%from_nstep+current_nsteps @@ -812,7 +1087,6 @@ subroutine fesom_runloop(current_nsteps) #endif end subroutine fesom_runloop - subroutine fesom_finalize() use fesom_main_storage_module #if defined(__MULTIO) @@ -822,11 +1096,13 @@ subroutine fesom_finalize() ! EO parameters real(kind=real32) :: mean_rtime(15), max_rtime(15), min_rtime(15) integer :: tr_num + integer :: i ! Start finalization profiling #if defined (FESOM_PROFILING) call fesom_profiler_start("fesom_finalize_total") #endif + ! -------------- ! LA icebergs: 2023-05-17 if (use_icebergs) then @@ -834,12 +1110,34 @@ subroutine fesom_finalize() end if ! -------------- +#if defined(__recom) && defined(__usetp) + if (f%my_fesom_group==0) then +#endif call finalize_output() call finalize_restart() +#if defined(__recom) && defined(__usetp) + end if +#endif !___FINISH MODEL RUN________________________________________________________ +#if !defined (__usetp) +! multi FESOM group loop parallelization call MPI_Barrier(f%MPI_COMM_FESOM, f%MPIERR) +#endif +#if defined(__recom) && defined (__usetp) +! list statistics for all fesom_groups +! fesom groups are listed backwards, so info for the main fesom group 0 is at the end in the log + do i = num_fesom_groups - 1, 0, -1 + +! use a barrier to "sort" the output but the mpi output can still get a bit mixed up, +! because MPI does not define the handling of the order of the output lines + call MPI_Barrier(f%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, f%MPIERR) + +! for the sake of output clarity produce output only for my_fesom_group == 0 for now + if(i == f%my_fesom_group .and. f%my_fesom_group == 0) then +#endif + !$ACC EXIT DATA DELETE (f%ice%delta_min, f%ice%Tevp_inv, f%ice%cd_oce_ice) !$ACC EXIT DATA DELETE (f%ice%work%fct_tmax, f%ice%work%fct_tmin) !$ACC EXIT DATA DELETE (f%ice%work%fct_fluxes, f%ice%work%fct_plus, f%ice%work%fct_minus) @@ -929,6 +1227,11 @@ subroutine fesom_finalize() call par_ex(f%partit%MPI_COMM_FESOM, f%partit%mype) #endif +#if defined(__recom) && defined (__usetp) + end if + end do ! i = num_fesom_groups - 1, 0, -1 +#endif + #if defined(__MULTIO) && !defined(__ifsinterface) && !defined(__oasis) call mpp_stop #endif @@ -940,6 +1243,13 @@ subroutine fesom_finalize() #endif if(f%fesom_did_mpi_init) call par_ex(f%partit%MPI_COMM_FESOM, f%partit%mype) ! finalize MPI before FESOM prints its stats block, otherwise there is sometimes output from other processes from an earlier time in the programm AFTER the starts block (with parastationMPI) + +#if defined(__recom) && defined(__usetp) +! kh 07.11.25 produce output currently for all groups +! if (f%my_fesom_group==0 .or. .true.) then + if (f%my_fesom_group==0) then +#endif + if (f%mype==0) then 41 format (a35,a10,2a15) !Format for table heading 42 format (a30,3f15.4) !Format for table content @@ -978,6 +1288,11 @@ subroutine fesom_finalize() write(*,*) '======================================================' write(*,*) end if + +#if defined(__recom) && defined(__usetp) + end if +#endif + ! call clock_finish ! Enhanced profiler is already finalized above before MPI finalization diff --git a/src/gen_forcing_couple.F90 b/src/gen_forcing_couple.F90 index d5c78ad11..349c44201 100755 --- a/src/gen_forcing_couple.F90 +++ b/src/gen_forcing_couple.F90 @@ -446,7 +446,14 @@ subroutine update_atm_forcing(istep, ice, tracers, dynamics, partit, mesh) print *, 'not installed yet or error in cpl_oasis3mct_send', mype #endif endif + +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif call cpl_oasis3mct_send(i, exchange, action, partit) +#if defined(__recom) && defined(__usetp) + endif +#endif end do #ifdef VERBOSE do i=1, nsend @@ -1036,11 +1043,19 @@ SUBROUTINE net_rec_from_atm(action, partit) use o_PARAM, only: WP USE MOD_PARTIT USE MOD_PARSUP + +#if defined(__recom) && defined(__usetp) + use g_config, only: num_fesom_groups +#endif + IMPLICIT NONE LOGICAL, INTENT (IN) :: action type(t_partit), intent(inout), target :: partit INTEGER :: my_global_rank, ierror +#if defined(__recom) && defined(__usetp) + INTEGER :: my_global_rank_test +#endif INTEGER :: n INTEGER :: status(MPI_STATUS_SIZE,partit%npes) INTEGER :: request(2) @@ -1054,11 +1069,29 @@ SUBROUTINE net_rec_from_atm(action, partit) CALL MPI_COMM_RANK(MPI_COMM_WORLD, my_global_rank, ierror) atm_net_fluxes_north=0. atm_net_fluxes_south=0. +#if defined(__recom) && defined(__usetp) + my_global_rank_test = my_global_rank - (partit%my_fesom_group * partit%npes) +#endif + +#if defined(__recom) && defined(__usetp) +! check for is root in group + if (my_global_rank_test==target_root) then + if(partit%my_fesom_group == 0) then +#else if (my_global_rank==target_root) then - CALL MPI_IRecv(atm_net_fluxes_north(1), nrecv, MPI_DOUBLE_PRECISION, source_root, 111, MPI_COMM_WORLD, request(1), partit%MPIerr) +#endif + CALL MPI_IRecv(atm_net_fluxes_north(1), nrecv, MPI_DOUBLE_PRECISION, source_root, 111, MPI_COMM_WORLD, request(1), partit%MPIerr) CALL MPI_IRecv(atm_net_fluxes_south(1), nrecv, MPI_DOUBLE_PRECISION, source_root, 112, MPI_COMM_WORLD, request(2), partit%MPIerr) CALL MPI_Waitall(2, request, status, partit%MPIerr) end if + +#if defined(__recom) && defined(__usetp) + if(num_fesom_groups > 1) then + call MPI_Bcast(atm_net_fluxes_north(1), nrecv, MPI_DOUBLE_PRECISION, 0, partit%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, partit%MPIerr) + call MPI_Bcast(atm_net_fluxes_south(1), nrecv, MPI_DOUBLE_PRECISION, 0, partit%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, partit%MPIerr) + end if + end if ! (my_global_rank_test==target_root) then +#endif call MPI_Barrier(partit%MPI_COMM_FESOM, partit%MPIerr) call MPI_AllREDUCE(atm_net_fluxes_north(1), aux, nrecv, MPI_DOUBLE_PRECISION, MPI_SUM, partit%MPI_COMM_FESOM, partit%MPIerr) atm_net_fluxes_north=aux diff --git a/src/gen_ic3d.F90 b/src/gen_ic3d.F90 index 4af214cd6..14caccdb3 100644 --- a/src/gen_ic3d.F90 +++ b/src/gen_ic3d.F90 @@ -613,7 +613,9 @@ SUBROUTINE do_ic3d(tracers, partit, mesh) call MPI_AllREDUCE(locSmin , glo , 1, MPI_DOUBLE_PRECISION, MPI_MIN, partit%MPI_COMM_FESOM, partit%MPIerr) if (partit%mype==0) write(*,*) ' `-> gobal min init. salt. =', glo #if defined(__recom) - +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (partit%mype==0) write(*,*) "Sanity check for REcoM variables" call MPI_AllREDUCE(locDINmax , glo , 1, MPI_DOUBLE_PRECISION, MPI_MAX, partit%MPI_COMM_FESOM, partit%MPIerr) if (partit%mype==0) write(*,*) ' |-> gobal max init. DIN. =', glo @@ -640,6 +642,9 @@ SUBROUTINE do_ic3d(tracers, partit, mesh) if (partit%mype==0) write(*,*) ' |-> gobal max init. O2. =', glo call MPI_AllREDUCE(locO2min , glo , 1, MPI_DOUBLE_PRECISION, MPI_MIN, partit%MPI_COMM_FESOM, partit%MPIerr) if (partit%mype==0) write(*,*) ' `-> gobal min init. O2. =', glo +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif #endif END SUBROUTINE do_ic3d diff --git a/src/gen_model_setup.F90 b/src/gen_model_setup.F90 index 869b00a52..1bf3cd133 100755 --- a/src/gen_model_setup.F90 +++ b/src/gen_model_setup.F90 @@ -330,6 +330,36 @@ subroutine setup_model(partit) endif ! if ((output_length_unit=='s').or.(int(real(step_per_day)/24.0)<=1)) use_means=.false. end subroutine setup_model + + +#if defined(__recom) && defined(__usetp) +! read num_fesom_groups for multi FESOM group loop parallelization +! ================================================================= +subroutine read_namelist_run_config + + ! Reads run_config namelist and overwrite default parameters. + ! Copied by Kai Himstedt (based on read_namelist) + + !-------------------------------------------------------------- + USE MOD_PARTIT + USE MOD_PARSUP + use g_config + implicit none + + character(len=100) :: nmlfile + integer fileunit + + nmlfile ='namelist.config' ! name of general configuration namelist file + open (newunit=fileunit, file=nmlfile) + + open (fileunit,file=nmlfile) + read (fileunit,NML=run_config) + close (fileunit) + +end subroutine read_namelist_run_config + +#endif + ! ================================================================= subroutine get_run_steps(nsteps, partit) ! Coded by Qiang Wang diff --git a/src/gen_modules_config.F90 b/src/gen_modules_config.F90 index ecc17effa..6159722fd 100755 --- a/src/gen_modules_config.F90 +++ b/src/gen_modules_config.F90 @@ -162,7 +162,12 @@ module g_config use_cavity_partial_cell, cavity_partial_cell_thresh, & use_cavity_fw2press, toy_ocean, which_toy, flag_debug, flag_warn_cflz, lwiso, & use_transit, compute_oasis_corners - +#if defined(__recom) && defined(__usetp) +! number of groups for multi FESOM group loop parallelization + integer :: num_fesom_groups=1 + namelist /run_config/ num_fesom_groups +#endif + !_____________________________________________________________________________ ! *** others *** real(kind=WP) :: dt diff --git a/src/gen_surface_forcing.F90 b/src/gen_surface_forcing.F90 index b95a99af7..90e596444 100644 --- a/src/gen_surface_forcing.F90 +++ b/src/gen_surface_forcing.F90 @@ -1431,9 +1431,22 @@ SUBROUTINE sbc_ini(partit, mesh) ! OPEN and read namelist for SBC REcoM open( unit=nm_sbc_unit+1, file='namelist.recom', form='formatted', access='sequential', status='old', iostat=iost ) if (iost == 0) then +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (mype==0) WRITE(*,*) ' file : ', 'namelist.recom for sbc',' open ok' +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif else +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) WRITE(*,*) 'ERROR: --> bad opening file : ', 'namelist.recom for sbc',' ; iostat=',iost +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif call par_ex(partit%MPI_COMM_FESOM, partit%mype) stop endif @@ -1457,9 +1470,11 @@ SUBROUTINE sbc_do(partit, mesh) #if defined (__recom) use recom_config use recom_glovar + use REcoM_ciso #endif IMPLICIT NONE + include 'netcdf.inc' real(wp) :: rdate ! date integer :: fld_idx, i logical :: do_rotation_wind, do_rotation_stre, force_newcoeff, update_monthly_flag @@ -1475,6 +1490,10 @@ SUBROUTINE sbc_do(partit, mesh) real(kind=8), allocatable :: ncdata(:) integer :: CO2start, CO2count integer :: status, ncid, varid + logical :: do_read=.false. + integer :: n_lb + integer, dimension(2) :: istart, icount + real(kind=8) :: total_runoff #endif type(t_partit), intent(inout), target :: partit type(t_mesh), intent(in), target :: mesh @@ -1652,26 +1671,70 @@ SUBROUTINE sbc_do(partit, mesh) end if ! --> if(update_monthly_flag) then end if ! --> if(runoff_data_source=='Dai09' .or. ... -#if defined (__recom) +#if defined(__recom) !< read surface atmospheric deposition for Fe, N, CO2 if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> Atm_input'//achar(27)//'[0m' ! ******** Atmospheric CO2 ********* - if (mstep == 1) then ! The year has changed - + if (mstep == 1) then ! The year has changed + + if (use_atbox) then +! Atmospheric box model CO2 values + AtmCO2(:) = x_co2atm(1) + if (ciso) then + AtmCO2_13(:) = x_co2atm_13(1) + if (ciso_14) AtmCO2_14(:,1) = x_co2atm_14(1) + end if + else +! Prescribed atmospheric CO2 values if (constant_CO2) then AtmCO2(:) = CO2_for_spinup +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (mype==0) write(*,*) 'Constant_CO2 = ', CO2_for_spinup - if (mype==0) write(*,*),'Atm CO2=', AtmCO2 - else + if (mype==0) write(*,*) 'Atm CO2=', AtmCO2 +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + if (ciso) then + AtmCO2_13 = CO2_for_spinup * (1. + 0.001 * delta_co2_13) + if (ciso_14) then +! Atmospheric 14C varies with latitude + do i=1, myDim_nod2D +! Latitude of atmospheric input data + lat_val = geo_coord_nod2D(2,i) / rad +! Binning to latitude zones + if (ciso_organic_14) then +! Convert Delta_14C to delta_14C + delta_co2_14 = (big_delta_co2_14(lat_zone(lat_val)) + 2. * delta_co2_13 + 50.) / & + (0.95 - 0.002 * delta_co2_13) + else +! "Inorganic" 14C approximation: delta_14C := Delta_14C + delta_co2_14 = big_delta_co2_14(lat_zone(lat_val)) + end if + AtmCO2_14(lat_zone(lat_val),:) = CO2_for_spinup * (1. + 0.001 * delta_co2_14) + end do + end if + end if + + else !not constant_CO2 + filename=trim(make_full_path(nm_co2_data_file)) +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) write(*,*) 'Updating CO2 climatology for month ', i,' from ', trim(filename) +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif totnumyear = lastyearoffesomcycle-firstyearoffesomcycle+1 firstyearofcurrentCO2cycle = lastyearoffesomcycle-numofCO2cycles*totnumyear+(currentCO2cycle-1)*totnumyear currentCO2year = firstyearofcurrentCO2cycle + (yearnew-firstyearoffesomcycle)+1 - if(mype==0) write(*,*),currentCO2year, firstyearofcurrentCO2cycle, yearnew, firstyearoffesomcycle + if(mype==0) write(*,*) currentCO2year, firstyearofcurrentCO2cycle, yearnew, firstyearoffesomcycle write(currentCO2year_char,'(i4)') currentCO2year CO2vari = 'AtmCO2_'//currentCO2year_char @@ -1692,24 +1755,60 @@ SUBROUTINE sbc_do(partit, mesh) status=nf90_get_var(ncid, varid, ncdata, start=(/CO2start/), count=(/CO2count/)) AtmCO2(:)=ncdata(:) deallocate(ncdata) - if (mype==0) write(*,*),'Current carbon year=',currentCO2year - if (mype==0) write(*,*),'Atm CO2=', AtmCO2 +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) write(*,*) 'Current carbon year=',currentCO2year + if (mype==0) write(*,*) 'Atm CO2=', AtmCO2 +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif status=nf90_close(ncid) end if + end if ! atmospheric box model or prescribed CO2 values + +! Control output of atmospheric CO2 values + if (mype==0) then !OG +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + print *, "In atm_input: AtmCO2 = ", AtmCO2(1) + if (ciso) then + print *, " AtmCO2_13 = ", AtmCO2_13(1) + if (ciso_14) print *, " AtmCO2_14 = ", AtmCO2_14(:,1) + end if + if (use_atbox) print *, " use_atbox = .true." +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif end if + end if ! mstep ==1 ! ******** Fe deposition ********* if (fe_data_source=='Albani') then if (update_monthly_flag) then i=month - if (mstep > 1) i=i+1 + if (mstep > 1) i=i+1 if (i > 12) i=1 filename=trim(make_full_path(nm_fe_data_file)) +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) write(*,*) 'Updating iron climatology for month ', i,' from ', trim(filename) +#if defined(__usetp) + endif +#endif call read_2ddata_on_grid_NetCDF(filename,'DustClim', i, GloFeDust, partit, mesh) end if else - if (mype==0) write(*,*) 'Albani is switched off --> Check namelist.recom' +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) write(*,*) 'Albani is switched off --> Check namelist.recom' +#if defined(__usetp) + endif +#endif end if ! ******** N deposition ********* @@ -1721,7 +1820,14 @@ SUBROUTINE sbc_do(partit, mesh) ! if (i > 12) i=1 ! if (mype==0) write(*,*) 'Updating iron climatology for month ', i filename=trim(make_full_path(nm_aen_data_file)) +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) write(*,*) 'Updating nitrogen climatology for month ', i,' from ', trim(filename) +#if defined(__usetp) + endif +#endif if (yearnew .gt. 2009) then Nvari = 'NDep2009' else if (yearnew .lt. 1850) then @@ -1734,7 +1840,13 @@ SUBROUTINE sbc_do(partit, mesh) end if else GloNDust = 0.0_WP - if (mstep==1 .and. mype==0) write(*,*) 'useAeolianN is switched off' +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mstep==1 .and. mype==0) write(*,*) 'useAeolianN is switched off' +#if defined(__usetp) + endif +#endif end if ! ******** Riverine input (Nutrients) ********* @@ -1748,32 +1860,44 @@ SUBROUTINE sbc_do(partit, mesh) if (update_monthly_flag) then i=month - if (mstep > 1) i=i+1 + if (mstep > 1) i=i+1 if (i > 12) i=1 filename=trim(nm_river_data_file) +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (mype==0) write(*,*) 'Updating riverine restoring data for month', i,' from ', trim(filename) +#if defined(__usetp) + endif +#endif call read_2ddata_on_grid_NetCDF(filename,'Alkalinity', i, RiverAlk2D, partit, mesh) ! write(*,*) mype, 'RiverAlk2D', maxval(RiverAlk2D(:)), minval(RiverAlk2D(:)) ! molar convertion of [CaCo3] * 2 -> [total Alkalinity] RiverAlk2D = RiverAlk2D * 2 - - call read_2ddata_on_grid_NetCDF(filename, 'DIC', i, RiverDIC2D, partit, mesh) + + call read_2ddata_on_grid_NetCDF(filename, 'DIC', i, RiverDIC2D, partit, mesh) ! write(*,*) mype, 'RiverDIC2D', maxval(RiverDIC2D(:)), minval(RiverDIC2D(:)) - call read_2ddata_on_grid_NetCDF(filename, 'DIN', i, RiverDIN2D, partit, mesh) + call read_2ddata_on_grid_NetCDF(filename, 'DIN', i, RiverDIN2D, partit, mesh) ! write(*,*) mype, 'RiverDIN2D', maxval(RiverDIN2D(:)), minval(RiverDIN2D(:)) - call read_2ddata_on_grid_NetCDF(filename, 'DOC', i, RiverDOC2D, partit, mesh) + call read_2ddata_on_grid_NetCDF(filename, 'DOC', i, RiverDOC2D, partit, mesh) ! write(*,*) mype, 'RiverDOC2D', maxval(RiverDOC2D(:)), minval(RiverDOC2D(:)) - call read_2ddata_on_grid_NetCDF(filename, 'DON', i, RiverDON2D, partit, mesh) + call read_2ddata_on_grid_NetCDF(filename, 'DON', i, RiverDON2D, partit, mesh) ! write(*,*) mype, 'RiverDON2D', maxval(RiverDON2D(:)), minval(RiverDON2D(:)) RiverDSi2D = RiverDIN2D * (16/15) end if else is_riverinput = 0.0d0 - if (mype==0 .and. mstep==1) write(*,*) 'No riverine input' +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0 .and. mstep==1) write(*,*) 'No riverine input' +#if defined(__usetp) + endif +#endif end if ! ******** Riverine input of iron ********* @@ -1791,30 +1915,215 @@ SUBROUTINE sbc_do(partit, mesh) !< read erosion input ! *** River inputs are in mmol/m2/s *** ! add erosion nutrients as surface boundary condition (surface_bc function in oce_ale_tracers) +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> Erosion_input'//achar(27)//'[0m' +#if defined(__usetp) + endif +#endif is_erosioninput = 1.0d0 if (update_monthly_flag) then i=month - if (mstep > 1) i=i+1 + if (mstep > 1) i=i+1 if (i > 12) i=1 filename=trim(nm_erosion_data_file) +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (mype==0) write(*,*) 'Updating erosion restoring data for month ', i,' from ', trim(filename) +#if defined(__usetp) + endif +#endif call read_2ddata_on_grid_NetCDF(filename,'POC', i, ErosionTOC2D, partit, mesh) ! write(*,*) mype, 'ErosionTOC2D', maxval(ErosionTOC2D(:)), minval(ErosionTOC2D(:)) - + call read_2ddata_on_grid_NetCDF(filename,'PON', i, ErosionTON2D, partit, mesh) ! write(*,*) mype, 'ErosionTON2D', maxval(ErosionTON2D(:)), minval(ErosionTON2D(:)) ! No silicates in erosion, we convert from nitrogen with redfieldian ratio - ErosionTSi2D=ErosionTON2D * 16/15 + ErosionTSi2D=ErosionTON2D * 16/15 end if else is_erosioninput = 0.0d0 - if (mype==0 .and. mstep==1) write(*,*) 'No erosion input' +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0 .and. mstep==1) write(*,*) 'No erosion input' +#if defined(__usetp) + endif +#endif end if + +! ******** Sediment input ********* +!-Checking if files need to be opened--------------------------------------------- + if(use_MEDUSA .and. (sedflx_num .ne. 0)) then + allocate(ncdata(9)) +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> Sed_input'//achar(27)//'[0m' +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + ! MEDUSA input needs to be renamed via jobscript + filename=trim(make_full_path(nm_sed_data_file)) + if (update_monthly_flag) then + i=month + if (mstep > 1) i=i+1 + if (i > 12) i=1 +#if defined(__usetp) + if (partit%my_fesom_group==0) then #endif + if (mype==0) write(*,*) 'Updating sedimentary input for month', i, 'from', filename +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + +!-Opening files-------------------------------------------------------------------- + + call read_2ddata_on_grid_NetCDF(filename, 'df_din', 1, GloSed(:,1), partit,mesh) +! if (mype==0) write(*,*) mype, 'sediment DIN flux:', maxval(GloSed(:,1)), minval(GloSed(:,1)) + + call read_2ddata_on_grid_NetCDF(filename, 'df_dic', 1, GloSed(:,2), partit, mesh) +! if (mype==0) write(*,*) mype, 'sediment DIC flux:', maxval(GloSed(:,2)), minval(GloSed(:,2)) + + call read_2ddata_on_grid_NetCDF(filename, 'df_alk', 1, GloSed(:,3), partit, mesh) +! if (mype==0) write(*,*) mype, 'sediment Alk flux:', maxval(GloSed(:,3)), minval(GloSed(:,3)) + + call read_2ddata_on_grid_NetCDF(filename, 'df_dsi', 1, GloSed(:,4), partit, mesh) +! if (mype==0) write(*,*) mype, 'sediment DSi flux:', maxval(GloSed(:,4)), minval(GloSed(:,4)) + + call read_2ddata_on_grid_NetCDF(filename, 'df_o2', 1, GloSed(:,5), partit, mesh) +! if (mype==0) write(*,*) mype, 'sediment O2 flux:', maxval(GloSed(:,5)), minval(GloSed(:,5)) + + if(ciso) then + call read_2ddata_on_grid_NetCDF(filename, 'df_dic13', 1, GloSed(:,6), partit, mesh) +! if (mype==0) write(*,*) mype, 'sediment DIC13 flux:', maxval(GloSed(:,6)), minval(GloSed(:,6)) + if(ciso_14) then + call read_2ddata_on_grid_NetCDF(filename, 'df_dic14', 1, GloSed(:,7), partit, mesh) +! if (mype==0) write(*,*) mype, 'sediment DIC14 flux:', maxval(GloSed(:,7)), minval(GloSed(:,7)) + end if ! ciso_14 + end if ! ciso + +! unit conversion + GloSed(:,:)=GloSed(:,:)/86400 + +! read loopback fluxes from the same file + if(add_loopback) then +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) write(*,*) 'add loopback fluxes through river runoff for month', i +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + + istart = (/1,1/) + icount = (/1,1/) + ncdata = 0.d0 + + total_runoff = 8.76d5*86400 + + status=nf_open(filename, nf_nowrite, ncid) + if(status.ne.nf_noerr) call handle_err(status) + + status=nf_inq_varid(ncid, 'loopback_orgm_din', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(1)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_orgm_din (mmolN/day):', ncdata(1) + + status=nf_inq_varid(ncid, 'loopback_orgm_dic', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(2)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_orgm_dic (mmolC/day):', ncdata(2) + + status=nf_inq_varid(ncid, 'loopback_orgm_alk', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(3)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_orgm_alk (mmolAlk/day):', ncdata(3) + + status=nf_inq_varid(ncid, 'loopback_opal', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(4)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_opal (mmolSi/day):', ncdata(4) + + status=nf_inq_varid(ncid, 'loopback_caco3', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(5)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_caco3 (mmolC/day):', ncdata(5) + + if(ciso) then + status=nf_inq_varid(ncid, 'loopback_orgm_dic13', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(6)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_dic13:', ncdata(6) + + status=nf_inq_varid(ncid, 'loopback_caco313', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(7)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_caco313:', ncdata(7) + + if(ciso_14 .and. ciso_organic_14) then + status=nf_inq_varid(ncid, 'loopback_orgm_dic14', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(8)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_dic14:', ncdata(8) + + status=nf_inq_varid(ncid, 'loopback_caco314', varid) + if(status.ne.nf_noerr) call handle_err(status) + status=nf_get_vara_double(ncid,varid,istart,icount,ncdata(9)) + if(status.ne.nf_noerr) call handle_err(status) +! if (mype==0) write(*,*) mype, 'loopback_caco314:', ncdata(9) + + end if ! ciso_14 .and. ciso_organic_14 + end if ! ciso + deallocate(ncdata) + status=nf_close(ncid) + +! calculating fluxes back to ocean surface through rivers (mmol/m2/s) +! converting from fluxes out of sediment to fluxes into the ocean + do n_lb = 1,9 + lb_flux(:,n_lb) = -runoff*ncdata(n_lb)/total_runoff*lb_tscale + end do + + else + +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) write(*,*) 'loopback fluxes not added!' +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + + end if ! add_loopback + + end if ! update_monthly_flag + + else ! use_MEDUSA + +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) write(*,*) 'sedimentary input from MEDUSA not used!' +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + + end if ! use_MEDUSA and sedflx_num not 0 + +#endif !defined(__recom) !!PS if (partit%mype==0) then !!PS write(*,*) 'sbc_do --> mstep:',mstep, ' rdate=', rdate @@ -1824,7 +2133,6 @@ SUBROUTINE sbc_do(partit, mesh) call data_timeinterp(rdate, partit) END SUBROUTINE sbc_do - FUNCTION julday(yyyy, mm, dd, calendar) IMPLICIT NONE diff --git a/src/int_recom/recom_atbox.F90 b/src/int_recom/recom_atbox.F90 new file mode 100644 index 000000000..4e579c51e --- /dev/null +++ b/src/int_recom/recom_atbox.F90 @@ -0,0 +1,92 @@ + subroutine recom_atbox(partit, mesh) +! Simple 0-d box model to calculate the temporal evolution of atmospheric CO2. +! Initially the box model was part of module recom_ciso. Now it can be run also +! without carbon isotopes (ciso==.false.) +! mbutzin, 2021-07-08 + +! Settings are copied from subroutine bio_fluxes, +! some of the following modules may be unnecessary here +! use REcoM_declarations +! use REcoM_LocVar + use REcoM_GloVar + use recom_config + use recom_ciso + + use mod_mesh + USE MOD_PARTIT + USE MOD_PARSUP + + use g_config + use o_arrays + use g_comm_auto + use g_forcing_arrays + use g_support + + + implicit none + integer :: n, elem, elnodes(3),n1 + real(kind=WP) :: total_co2flux, & ! (mol / s) + total_co2flux_13, & ! (mol / s) carbon-13 + total_co2flux_14 ! (mol / s) radiocarbon + real(kind=WP), parameter :: mol_allatm = 1.7726e20 ! atmospheric inventory of all compounds (mol) + type(t_partit), intent(inout), target :: partit + type(t_mesh) , intent(inout), target :: mesh + +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + +! Globally integrated air-sea CO2 flux (mol / s) + total_co2flux = 0. + call integrate_nod(0.001 * GloCO2flux_seaicemask , total_CO2flux, partit, mesh) + +! Atmospheric carbon budget (mol) +! mass of the dry atmosphere = 5.1352e18 kg (Trenberth & Smith 2005, doi:10.1175/JCLI-3299.1) +! mean density of air = 0.02897 kg / mol (https://nssdc.gsfc.nasa.gov/planetary/factsheet/earthfact.html) +! => total molecular inventory of the dry atmosphere: moles_atm = 1.7726e20 mol == constant. +! mol_co2atm = mol_co2atm - total_co2flux * dt +! Atmospheric mixing ratios in ppm +! x_co2atm(1) = mol_co2atm / mol_allatm * 1.e6 ! ppm + x_co2atm(1) = x_co2atm(1) - total_co2flux / mol_allatm * dt * 1.e6 + x_co2atm = x_co2atm(1) + + if (ciso) then +! Consider 13CO2 (and maybe also 14CO2) + +! Globally integrated air-sea 13CO2 flux (mol / s) + total_co2flux_13 = 0. + call integrate_nod(0.001 * GloCO2flux_seaicemask_13, total_co2flux_13, partit, mesh) + +! Atmospheric carbon-13 budget (mol) +! mol_co2atm_13 = mol_co2atm_13 - total_co2flux_13 * dt +! Budget in terms of the 13C / 12C volume mixing ratio +! x_co2atm_13(1) = mol_co2atm_13 / mol_allatm * 1.e6 + x_co2atm_13(1) = x_co2atm_13(1) - total_co2flux_13 / mol_allatm * dt * 1.e6 + x_co2atm_13 = x_co2atm_13(1) + + if (ciso_14) then + total_co2flux_14 = 0. ! globally integrated air-sea 14CO2 flux (mol / s) + call integrate_nod(0.001 * GloCO2flux_seaicemask_14, total_co2flux_14, partit, mesh) +! Atmospheric radiocarbon budget in mol: +! mol_co2atm_14 = mol_co2atm_14 + dt * (cosmic_14(1) - mol_co2atm_14 * lambda_14 - total_co2flux_14) +! = (mol_co2atm_14 + dt * (cosmic_14(1) - total_co2flux_14)) / (1 + lambda_14 * dt) +! Budget in terms of the 14C / 12C volume mixing ratio + x_co2atm_14(1) = (x_co2atm_14(1) + dt * (cosmic_14(1) - total_co2flux_14) / mol_allatm * 1.e6) / & + (1 + lambda_14 * dt) + x_co2atm_14 = x_co2atm_14(1) + +! Adjust cosmogenic 14C production (mol / s) in spinup runs, + r_atm_14 = x_co2atm_14(1) / x_co2atm(1) +! r_atm_spinup_14 is calculated once-only in subroutine recom_init + if (atbox_spinup .and. abs(r_atm_14 - r_atm_spinup_14) > 0.001) then + cosmic_14(1) = cosmic_14(1) * (r_atm_spinup_14 / r_atm_14) +! cosmic_14(1) = cosmic_14(1) * (1 + 0.01 * (r_atm_14_spinup / r_atm_14)) + end if + cosmic_14 = cosmic_14(1) + endif + end if + + return + end subroutine recom_atbox + diff --git a/src/int_recom/recom_extra.F90 b/src/int_recom/recom_extra.F90 index 5495e0c8f..eb9011cfd 100644 --- a/src/int_recom/recom_extra.F90 +++ b/src/int_recom/recom_extra.F90 @@ -201,4 +201,3 @@ subroutine krill_resp(n, partit, mesh) end if endif end subroutine krill_resp - diff --git a/src/int_recom/recom_forcing.F90 b/src/int_recom/recom_forcing.F90 index 81650779d..8c683526d 100644 --- a/src/int_recom/recom_forcing.F90 +++ b/src/int_recom/recom_forcing.F90 @@ -1,7 +1,7 @@ !=============================================================================== ! REcoM_Forcing !=============================================================================== -subroutine REcoM_Forcing(zNodes, n, Nn, state, SurfSW, Loc_slp , Temp, Sali, Sali_depth & +subroutine REcoM_Forcing(zNodes, n, Nn, state, SurfSW, Loc_slp, Temp, Sali, Sali_depth & , CO2_watercolumn & , pH_watercolumn & , pCO2_watercolumn & @@ -272,6 +272,58 @@ subroutine REcoM_Forcing(zNodes, n, Nn, state, SurfSW, Loc_slp , Temp, Sali, Sal if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> ciso after REcoM_Forcing'//achar(27)//'[0m' + if (ciso) then +! Calculate carbon-isotopic fractionation, radioactive decay is calculated in oce_ale_tracer.F90 + +! Fractionation due to air-sea exchange and chemical speciation of CO2 + call recom_ciso_airsea(recom_t(1), co3(1), recom_dic(1)) ! -> alpha_aq, alpha_dic. CO3 is taken from mocsy + +! Isotopic ratios of dissolved CO2, also needed to calculate biogenic fractionation + r_dic_13 = max(tiny*1e-3,state(1,idic_13)*1e-3) / recom_dic(1) + r_co2s_13 = alpha_aq_13 / alpha_dic_13 * r_dic_13 +! Calculate air-sea fluxes of 13|14CO2 in mmol / m**2 / s + kwco2 = kw660(1) * (660/scco2(REcoM_T(1)))**0.5 ! Piston velocity (via mocsy) + co2sat = co2flux(1) / (kwco2 + tiny) + co2(1) ! Saturation concentration of CO2 (via mocsy) +! co2flux_13 = kwco2 * alpha_k_13 * (alpha_aq_13 * r_atm_13 * co2sat - r_co2s_13 * co2(1)) +! co2flux_13 = alpha_k_13 * alpha_aq_13 * kwco2 * (r_atm_13 * co2sat - r_dic_13 * co2(1) / alpha_dic_13) +! Fractionation factors were determined for freshwater, include a correction for enhanced fractionation in seawater + co2flux_13 = (alpha_k_13 * alpha_aq_13 - 0.0002) * kwco2 * (r_atm_13 * co2sat - r_dic_13 * co2(1) / alpha_dic_13) + co2flux_seaicemask_13 = co2flux_13 * 1.e3 + +! Biogenic fractionation due to photosynthesis of plankton +! phyc_13|14 and diac_13|14 are only used in REcoM_sms to calculate DIC_13|14, DOC_13|14 and DetC_13|14 + + call recom_ciso_photo(co2(1)) ! -> alpha_p + r_phyc_13 = r_co2s_13 / alpha_p_13 + r_diac_13 = r_co2s_13 / alpha_p_dia_13 +! state(1:nn,iphyc_13) = max((tiny_C * r_phyc_13), (state(1:nn,iphyc) * r_phyc_13)) +! state(1:nn,idiac_13) = max((tiny_C_d * r_diac_13), (state(1:nn,idiac) * r_diac_13)) + state(1:nn,iphyc_13) = max((tiny_C * r_phyc_13), state(1:nn,iphyc_13)) + state(1:nn,idiac_13) = max((tiny_C_d * r_diac_13), state(1:nn,idiac_13)) + +! The same for radiocarbon, fractionation factors have been already derived above + if (ciso_14) then +! Air-sea exchange + r_dic_14 = max(tiny*1e-3,state(1,idic_14)*1e-3) / recom_dic(1) + r_co2s_14 = alpha_aq_14 / alpha_dic_14 * r_dic_14 +! co2flux_14 = kwco2 * alpha_k_14 * (alpha_aq_14 * r_atm_14 * co2sat - r_co2s_14 * co2(1)) +! Fractionation factors were determined for freshwater, include a correction for enhanced fractionation seawater + co2flux_14 = (alpha_k_14 * alpha_aq_14 - 0.0004) * kwco2 * (r_atm_14 * co2sat - r_dic_14 * co2(1) / alpha_dic_14) + co2flux_seaicemask_14 = co2flux_14 * 1.e3 +! Biogenic fractionation + if (ciso_organic_14) then + r_phyc_14 = r_co2s_14 / alpha_p_14 + r_diac_14 = r_co2s_14 / alpha_p_dia_14 +! state(1:nn,iphyc_14) = max((tiny_C * r_phyc_14), (state(1:nn,iphyc) * r_phyc_14)) +! state(1:nn,idiac_14) = max((tiny_C_d * r_diac_14), (state(1:nn,idiac) * r_diac_14)) + state(1:nn,iphyc_14) = max((tiny_C * r_phyc_14), state(1:nn,iphyc_14)) + state(1:nn,idiac_14) = max((tiny_C_d * r_diac_14), state(1:nn,idiac_14)) + end if + end if +! Radiocarbon + end if +! ciso + !------------------------------------------------------------------------------- ! Diagnostics if (Diags) then @@ -291,10 +343,12 @@ subroutine REcoM_Forcing(zNodes, n, Nn, state, SurfSW, Loc_slp , Temp, Sali, Sal locNNAd = sum(vertNNAd(1:nn) * thick(1:nn)) locChldegd = sum(vertChldegd(1:nn) * thick(1:nn)) +#if defined (__coccos) locNPPc = sum(vertNPPc(1:nn) * thick(1:nn)) locGPPc = sum(vertGPPc(1:nn) * thick(1:nn)) locNNAc = sum(vertNNAc(1:nn) * thick(1:nn)) locChldegc = sum(vertChldegc(1:nn) * thick(1:nn)) +#endif end if end subroutine REcoM_Forcing diff --git a/src/int_recom/recom_forcing.F90.new_ciso b/src/int_recom/recom_forcing.F90.new_ciso new file mode 100644 index 000000000..155846b46 --- /dev/null +++ b/src/int_recom/recom_forcing.F90.new_ciso @@ -0,0 +1,353 @@ +!=============================================================================== +! REcoM_Forcing +!=============================================================================== +subroutine REcoM_Forcing(zNodes, n, Nn, state, SurfSW, Loc_slp, Temp, Sali, Sali_depth & + , CO2_watercolumn & + , pH_watercolumn & + , pCO2_watercolumn & + , HCO3_watercolumn & + , CO3_watercolumn & + , OmegaC_watercolumn & + , kspc_watercolumn & + , rhoSW_watercolumn & + , PAR, ice, dynamics, tracers, partit, mesh) + + use recom_declarations + use recom_locvar + use recom_config + use recom_glovar + use gasx + use recom_ciso + use g_clock + use o_PARAM + use g_rotate_grid + use g_config + use mod_mesh + USE MOD_PARTIT + USE MOD_PARSUP + use mod_tracer + use MOD_DYN + use MOD_ICE + + use o_param + use o_arrays + use g_forcing_arrays + use g_comm_auto + use g_support + implicit none + + type(t_dyn) , intent(inout), target :: dynamics + type(t_ice) , intent(inout), target :: ice + type(t_tracer), intent(inout), target :: tracers + type(t_partit), intent(inout), target :: partit + type(t_mesh) , intent(inout), target :: mesh + + real(kind=8) :: Latr + integer :: n, Nn ! Nn -Total number of nodes + real(kind=8),dimension(mesh%nl-1) :: zNodes ! Depth of nodes zr(1:nzmax) = Z_3d_n(1:nzmax,n) + real(kind=8),dimension(mesh%nl-1,bgc_num) :: state + real(kind=8) :: SurfSW ! [W/m2] ShortWave radiation at surface + real(kind=8) :: Loc_slp ! [Pa] sea-level pressure + real(kind=8),dimension(mesh%nl-1) :: Temp ! [degrees C] Ocean temperature + real(kind=8),dimension(mesh%nl-1) :: Sali_depth ! Salinity for the whole water column + + !!---- Watercolumn carbonate chemistry + real(kind=8),dimension(mesh%nl-1) :: CO2_watercolumn + real(kind=8),dimension(mesh%nl-1) :: pH_watercolumn + real(kind=8),dimension(mesh%nl-1) :: pCO2_watercolumn + real(kind=8),dimension(mesh%nl-1) :: HCO3_watercolumn + real(kind=8),dimension(mesh%nl-1) :: CO3_watercolumn + real(kind=8),dimension(mesh%nl-1) :: OmegaC_watercolumn + real(kind=8),dimension(mesh%nl-1) :: kspc_watercolumn + real(kind=8),dimension(mesh%nl-1) :: rhoSW_watercolumn + + real(kind=8),dimension(mesh%nl-1) :: PAR + + !!---- Subroutine Depth + + real(kind=8),dimension(mesh%nl) :: zF ! [m] Depth of fluxes + real(kind=8),dimension(mesh%nl,5) :: SinkVel ! [m/day] + real(kind=8),dimension(mesh%nl-1) :: thick ! [m] Vertical distance between two nodes = Thickness + real(kind=8),dimension(mesh%nl-1) :: recipthick ! [1/m] reciprocal of thick + + !!---- Subroutine CO2Flux /mocsy + real(kind=8) :: REcoM_DIC(1) ! [mol/m3] Conc of DIC in the surface water, used to calculate CO2 flux + real(kind=8) :: REcoM_Alk(1) ! [mol/m3] Conc of Alk in the surface water, used to calculate CO2 flux + real(kind=8) :: REcoM_Si(1) ! [mol/m3] Conc of Si in the surface water, used to calculate CO2 flux + real(kind=8) :: REcoM_Phos(1) ! [mol/m3] Conc of Phos in the surface water, used to calculate the CO2 flux + real(kind=8) :: Sali(1) ! Salinity of current surface layer + real(kind=8) :: Latd(1) ! latitude in degree + real(kind=8) :: Lond(1) ! longitude in degree + real(kind=8) :: REcoM_T(1) ! temperature again, for mocsy minimum defined as -2 + real(kind=8) :: REcoM_S(1) ! temperature again, for mocsy minimum defined as 21 +! atm pressure, now read in as forcing!! + !!---- atm pressure + real(kind=8) :: Patm(1) ! atmospheric pressure [atm] + + !!---- Subroutine o2flux /mocsy + real(kind=8) :: ppo(1) ! atmospheric pressure, divided by 1 atm + real(kind=8) :: REcoM_O2(1) ! [mmol/m3] Conc of O2 in the surface water, used to calculate O2 flux + + !!---- Subroutine REcoM_sms + real(kind=8),dimension(mesh%nl-1,bgc_num) :: sms ! matrix that entail changes in tracer concentrations + + !!---- Diagnostics + integer :: idiags,k + + integer :: tr_num + +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + + tiny_N = tiny_chl/chl2N_max ! 0.00001/ 3.15d0 Chl2N_max [mg CHL/mmol N] Maximum CHL a : N ratio = 0.3 gCHL gN^-1 + tiny_N_d = tiny_chl/chl2N_max_d ! 0.00001/ 4.2d0 + + tiny_C = tiny_N /NCmax ! NCmax = 0.2d0 [mmol N/mmol C] Maximum cell quota of nitrogen (N:C) + tiny_C_d = tiny_N_d/NCmax_d ! NCmax_d = 0.2d0 + + tiny_Si = tiny_C_d/SiCmax ! SiCmax = 0.8d0 + +#if defined (__coccos) + tiny_N_c = tiny_chl/chl2N_max_c ! 0.00001/ 3.5d0 + tiny_C_c = tiny_N_c/NCmax_c ! NCmax_c = 0.15d0 +#endif + + call Cobeta(partit, mesh) + call Depth_calculations(n, Nn,SinkVel,zF,thick,recipthick, partit, mesh) + + !! *** Mocsy *** + + !!---- convert from mmol/m3 to mol/m3 + REcoM_DIC = max(tiny*1e-3, state(one,idic)*1e-3) + REcoM_Alk = max(tiny*1e-3, state(one,ialk)*1e-3) + REcoM_Si = max(tiny*1e-3, state(one,isi) *1e-3) + + !!---- convert N to P with Redfield ratio + REcoM_Phos = max(tiny*1e-3, state(one,idin)*1e-3) /16. + + !!---- minimum set to 2 degC: K1/K2 Lueker valid between 2degC-35degC and 19-43psu + REcoM_T = max(2.d0, Temp(1)) + !!---- maximum set to 40 degC: K1/K2 Lueker valid between 2degC-35degC and 19-43psu + REcoM_T = min(REcoM_T, 40.d0) + + !!---- minimum set to 21: K1/K2 Lueker valid between 2degC-35degC and 19-43psu, else causes trouble in regions with S between 19 and 21 and ice conc above 97% + REcoM_S = max(21.d0, Sali(1)) + !!---- maximum set to 43: K1/K2 Lueker valid between 2degC-35degC and 19-43psu, else causes trouble REcoM_S = min(REcoM_S, 43.d0) !!!!!!!! + + !!---- convert from Pa to atm. + Patm = Loc_slp/Pa2atm + + !!---- lon + Lond=geo_coord_nod2D(1,n)/rad !! convert from rad to degree + !!---- lat + Latr=geo_coord_nod2D(2,n) + Latd=geo_coord_nod2D(2,n)/rad !! convert from rad to degree + + !!---- calculate piston velocity kw660, which is an input to the flxco2 calculation + !!---- pistonvel already scaled for ice-free area + !!---- compute piston velolicty kw660 (at 25 C) from wind speed + !!---- BUT without Schmidt number temperature correction (Sc differs each gas) + !! ULoc: wind speed at 10-m height + !! Loc_ice_conc: modeled sea-ice cover: fraction of grid cell, varying between 0.0 (no ice) and 1.0 (full cover) + !! kw660: piston velocity at 25°C [m/s], uncorrected by the Schmidt number for different temperatures + + call pistonvel(ULoc, Loc_ice_conc, Nmocsy, kw660) + + !! *** check *** + + if((REcoM_DIC(1) > 10000.d0)) then ! NEW: added this entire print statement (if to endif) + print*, 'NEW ERROR: DIC !' + print*, 'pco2surf: ',pco2surf + print*, 'co2: ',co2 + print*, 'rhoSW: ', rhoSW + print*, 'temp: ',REcoM_T + print*, 'tempis: ',tempis + print*, 'REcoM_S: ', REcoM_S + print*, 'REcoM_Alk: ', REcom_Alk + print*, 'REcoM_DIC: ', REcoM_DIC + print*, 'REcoM_Si: ', REcoM_Si + print*, 'REcoM_Phos: ', REcoM_Phos + print*, 'kw660: ',kw660 + print*, 'LocAtmCO2: ', LocAtmCO2 + print*, 'Patm: ', Patm + print*, 'thick(One): ',thick(One) + print*, 'Nmocsy: ', Nmocsy + print*, 'Lond: ', Lond + print*, 'Latd: ', Latd + print*, 'ULoc: ', ULoc + print*, 'Loc_ice_conc: ', Loc_ice_conc + stop + endif + + call flxco2(co2flux, co2ex, dpco2surf, & + ph, pco2surf, fco2, co2, hco3, co3, OmegaA, OmegaC, BetaD, rhoSW, p, tempis, & + REcoM_T, REcoM_S, REcoM_Alk, REcoM_DIC, REcoM_Si, REcoM_Phos, kw660, LocAtmCO2, Patm, thick(One), Nmocsy, Lond,Latd, & + optCON='mol/m3',optT='Tpot ',optP='m ',optB='u74',optK1K2='l ',optKf='dg',optGAS='Pinsitu',optS='Sprc') + +! changed optK1K2='l ' to 'm10' + if((co2flux(1)>1.e10) .or. (co2flux(1)<-1.e10)) then +! co2flux(1)=0.0 + print*, 'ERROR: co2 flux !' + print*, 'pco2surf: ',pco2surf + print*, 'co2: ',co2 + print*, 'rhoSW: ', rhoSW + print*, 'temp: ',REcoM_T + print*, 'tempis: ',tempis + print*, 'REcoM_S: ', REcoM_S + print*, 'REcoM_Alk: ', REcom_Alk + print*, 'REcoM_DIC: ', REcoM_DIC + print*, 'REcoM_Si: ', REcoM_Si + print*, 'REcoM_Phos: ', REcoM_Phos + print*, 'kw660: ',kw660 + print*, 'LocAtmCO2: ', LocAtmCO2 + print*, 'Patm: ', Patm + print*, 'thick(One): ',thick(One) + print*, 'Nmocsy: ', Nmocsy + print*, 'Lond: ', Lond + print*, 'Latd: ', Latd + print*, 'ULoc: ', ULoc + print*, 'Loc_ice_conc: ', Loc_ice_conc + stop + endif + +! use ice-free area and also convert from mol/m2/s to mmol/m2/d +! if(mype==0) write(*,*), 'co2flux (mol/m2/s) =',co2flux + +! ice-fraction is already considered in piston-velocity, so don't apply it here + dflux = co2flux * 1.e3 *SecondsPerDay !* (1.d0 - Loc_ice_conc) +! if(mype==0) write(*,*), 'dflux (mmol/m2/d) =',dflux + + co2flux_seaicemask = co2flux * 1.e3 ! [mmol/m2/s] * (1.d0 - Loc_ice_conc) +! if(mype==0) write(*,*), 'co2flux_seaicemask (mmol/m2/s) =',co2flux_seaicemask + +! then oxygen + ppo = Loc_slp/Pa2atm !1 !slp divided by 1 atm + REcoM_O2 = max(tiny*1e-3,state(one,ioxy)*1e-3) ! convert from mmol/m3 to mol/m3 for mocsy + + call o2flux(REcoM_T, REcoM_S, kw660, ppo, REcoM_O2, Nmocsy, o2ex) + oflux = o2ex * 1.e3 *SecondsPerDay !* (1.d0 - Loc_ice_conc) [mmol/m2/d] + o2flux_seaicemask = o2ex * 1.e3 ! back to mmol here [mmol/m2/s] + +! Source-Minus-Sinks + +if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> REcoM_sms'//achar(27)//'[0m' + +! call REcoM_sms(n, Nn, state, thick, recipthick, SurfSW, sms, Temp ,zF, PAR, mesh) + + call REcoM_sms(n, Nn, state, thick, recipthick, SurfSW, sms, Temp, Sali_depth & + , CO2_watercolumn & ! MOCSY [mol/m3] + , pH_watercolumn & ! MOCSY on total scale + , pCO2_watercolumn & ! MOCSY [uatm] + , HCO3_watercolumn & ! MOCSY [mol/m3] + , CO3_watercolumn & ! DISS [mol/m3] + , OmegaC_watercolumn & ! DISS calcite saturation state + , kspc_watercolumn & ! DISS stoichiometric solubility product [mol^2/kg^2] + , rhoSW_watercolumn & ! DISS in-situ density of seawater [kg/m3] + , Loc_slp & + , zF, PAR, Lond, Latd, ice, dynamics, tracers, partit, mesh) + + state(1:nn,:) = max(tiny,state(1:nn,:) + sms(1:nn,:)) + + state(1:nn,ipchl) = max(tiny_chl,state(1:nn,ipchl)) + state(1:nn,iphyn) = max(tiny_N, state(1:nn,iphyn)) + state(1:nn,iphyc) = max(tiny_C, state(1:nn,iphyc)) + state(1:nn,idchl) = max(tiny_chl,state(1:nn,idchl)) + state(1:nn,idian) = max(tiny_N_d,state(1:nn,idian)) + state(1:nn,idiac) = max(tiny_C_d,state(1:nn,idiac)) + state(1:nn,idiasi) = max(tiny_Si, state(1:nn,idiasi)) + +#if defined (__coccos) + state(1:nn,icchl) = max(tiny_chl,state(1:nn,icchl)) + state(1:nn,icocn) = max(tiny_N_c,state(1:nn,icocn)) + state(1:nn,icocc) = max(tiny_C_c,state(1:nn,icocc)) +#endif + +#if defined (__3Zoo2Det) + state(1:nn,imiczoon) = max(tiny,state(1:nn,imiczoon)) + state(1:nn,imiczooc) = max(tiny,state(1:nn,imiczooc)) +#endif + +if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> ciso after REcoM_Forcing'//achar(27)//'[0m' + +! Calculate carbon-isotopic fractionation, radioactive decay is calculated in oce_ale_tracer.F90 + +! Fractionation due to air-sea exchange and chemical speciation of CO2 + call recom_ciso_airsea(recom_t(1), co3(1), recom_dic(1)) ! -> alpha_aq, alpha_dic. CO3 is taken from mocsy + +! Isotopic ratios of dissolved CO2, also needed to calculate biogenic fractionation + r_dic_13 = max(tiny*1e-3,state(1,idic_13)*1e-3) / recom_dic(1) + r_co2s_13 = alpha_aq_13 / alpha_dic_13 * r_dic_13 +! Calculate air-sea fluxes of 13|14CO2 in mmol / m**2 / s + kwco2 = kw660(1) * (660/scco2(REcoM_T(1)))**0.5 ! Piston velocity (via mocsy) + co2sat = co2flux(1) / (kwco2 + tiny) + co2(1) ! Saturation concentration of CO2 (via mocsy) +! co2flux_13 = kwco2 * alpha_k_13 * (alpha_aq_13 * r_atm_13 * co2sat - r_co2s_13 * co2(1)) +! co2flux_13 = alpha_k_13 * alpha_aq_13 * kwco2 * (r_atm_13 * co2sat - r_dic_13 * co2(1) / alpha_dic_13) +! Fractionation factors were determined for freshwater, include a correction for enhanced fractionation in seawater + co2flux_13 = (alpha_k_13 * alpha_aq_13 - 0.0002) * kwco2 * (r_atm_13 * co2sat - r_dic_13 * co2(1) / alpha_dic_13) + co2flux_seaicemask_13 = co2flux_13 * 1.e3 + +! Biogenic fractionation due to photosynthesis of plankton +! phyc_13|14 and diac_13|14 are only used in REcoM_sms to calculate DIC_13|14, DOC_13|14 and DetC_13|14 + + call recom_ciso_photo(co2(1)) ! -> alpha_p + r_phyc_13 = r_co2s_13 / alpha_p_13 + r_diac_13 = r_co2s_13 / alpha_p_dia_13 +! state(1:nn,iphyc_13) = max((tiny_C * r_phyc_13), (state(1:nn,iphyc) * r_phyc_13)) +! state(1:nn,idiac_13) = max((tiny_C_d * r_diac_13), (state(1:nn,idiac) * r_diac_13)) + state(1:nn,iphyc_13) = max((tiny_C * r_phyc_13), state(1:nn,iphyc_13)) + state(1:nn,idiac_13) = max((tiny_C_d * r_diac_13), state(1:nn,idiac_13)) + +! The same for radiocarbon, fractionation factors have been already derived above + if (ciso_14) then +! Air-sea exchange + r_dic_14 = max(tiny*1e-3,state(1,idic_14)*1e-3) / recom_dic(1) + r_co2s_14 = alpha_aq_14 / alpha_dic_14 * r_dic_14 +! co2flux_14 = kwco2 * alpha_k_14 * (alpha_aq_14 * r_atm_14 * co2sat - r_co2s_14 * co2(1)) +! Fractionation factors were determined for freshwater, include a correction for enhanced fractionation seawater + co2flux_14 = (alpha_k_14 * alpha_aq_14 - 0.0004) * kwco2 * (r_atm_14 * co2sat - r_dic_14 * co2(1) / alpha_dic_14) + co2flux_seaicemask_14 = co2flux_14 * 1.e3 +! Biogenic fractionation + if (ciso_organic_14) then + r_phyc_14 = r_co2s_14 / alpha_p_14 + r_diac_14 = r_co2s_14 / alpha_p_dia_14 +! state(1:nn,iphyc_14) = max((tiny_C * r_phyc_14), (state(1:nn,iphyc) * r_phyc_14)) +! state(1:nn,idiac_14) = max((tiny_C_d * r_diac_14), (state(1:nn,idiac) * r_diac_14)) + state(1:nn,iphyc_14) = max((tiny_C * r_phyc_14), state(1:nn,iphyc_14)) + state(1:nn,idiac_14) = max((tiny_C_d * r_diac_14), state(1:nn,idiac_14)) + end if + end if +! Radiocarbon + end if +! ciso + +!------------------------------------------------------------------------------- +! Diagnostics + if (Diags) then + +! logical, optional :: lNPPn + +! if (present(lNPPn))then +! locNPPn = sum(diags3Dloc(1:nn,idiags) * thick(1:nn)) +! endif + locNPPn = sum(vertNPPn(1:nn) * thick(1:nn)) + locGPPn = sum(vertGPPn(1:nn) * thick(1:nn)) + locNNAn = sum(vertNNAn(1:nn) * thick(1:nn)) + locChldegn = sum(vertChldegn(1:nn) * thick(1:nn)) + + locNPPd = sum(vertNPPd(1:nn) * thick(1:nn)) + locGPPd = sum(vertGPPd(1:nn) * thick(1:nn)) + locNNAd = sum(vertNNAd(1:nn) * thick(1:nn)) + locChldegd = sum(vertChldegd(1:nn) * thick(1:nn)) + +#if defined (__coccos) + locNPPc = sum(vertNPPc(1:nn) * thick(1:nn)) + locGPPc = sum(vertGPPc(1:nn) * thick(1:nn)) + locNNAc = sum(vertNNAc(1:nn) * thick(1:nn)) + locChldegc = sum(vertChldegc(1:nn) * thick(1:nn)) +#endif + + end if +end subroutine REcoM_Forcing diff --git a/src/int_recom/recom_init.F90 b/src/int_recom/recom_init.F90 index e9b5aebbf..b1846534d 100644 --- a/src/int_recom/recom_init.F90 +++ b/src/int_recom/recom_init.F90 @@ -89,7 +89,7 @@ subroutine recom_init(tracers, partit, mesh) allocate(GlodPCO2surf ( node_size )) allocate(GlodecayBenthos ( node_size, benthos_num )) allocate(Benthos ( node_size, benthos_num )) - allocate(Benthos_tr ( node_size, benthos_num, num_tracers )) ! kh 25.03.22 buffer per tracer index + allocate(Benthos_tr ( node_size, benthos_num, num_tracers )) ! buffer per tracer index allocate(GloHplus ( node_size )) allocate(DenitBen ( node_size )) @@ -124,7 +124,7 @@ subroutine recom_init(tracers, partit, mesh) GlodPCO2surf = 0.d0 GlodecayBenthos = 0.d0 Benthos = 0.d0 - Benthos_tr(:,:,:) = 0.0d0 ! kh 25.03.22 + Benthos_tr(:,:,:) = 0.0d0 GloHplus = exp(-8.d0 * log(10.d0)) ! = 10**(-8) DenitBen = 0.d0 @@ -246,6 +246,100 @@ subroutine recom_init(tracers, partit, mesh) Sinkingvel1(:,:) = 0.d0 Sinkingvel2(:,:) = 0.d0 + if (use_MEDUSA) then + allocate(GloSed(node_size,sedflx_num)) + allocate(SinkFlx(node_size,bottflx_num)) + allocate(SinkFlx_tr(node_size,bottflx_num,num_tracers)) ! buffer sums per tracer index + + SinkFlx(:,:) = 0.d0 + SinkFlx_tr(:,:,:) = 0.0d0 + GloSed(:,:) = 0.d0 + allocate(lb_flux(node_size,9)) + lb_flux(:,:) = 0.d0 + end if + + if (useRivFe) then + allocate(RiverFe ( node_size )) + RiverFe(:) = 0.d0 + end if + +! Atmospheric box model + if (use_atbox) then +! if (mype==0 .and. my_fesom_group == 0) print *, "Initializing the atmospheric isoCO2 box model ..." !OG + allocate(x_co2atm(node_size)) + x_co2atm = CO2_for_spinup + if (ciso) then + allocate(x_co2atm_13(node_size)) + r_atm_spinup_13 = 1. + 0.001 * delta_co2_13 + x_co2atm_13 = CO2_for_spinup * r_atm_spinup_13 + if (ciso_14) then + allocate(x_co2atm_14(node_size)) + allocate(cosmic_14(node_size)) + if (ciso_organic_14) then + delta_co2_14 = (big_delta_co2_14(1) + 2. * delta_co2_13 + 50.) / (0.95 - 0.002 * delta_co2_13) + else + delta_co2_14 = big_delta_co2_14(1) + end if + r_atm_spinup_14 = 1. + 0.001 * delta_co2_14 + x_co2atm_14 = CO2_for_spinup * r_atm_spinup_14 +! Conversion of initial cosmogenic 14C production rates (mol / s) to fluxes (atoms / s / cm**2) +! Since 14C values are scaled to 12C, we need to include the standard 14C / 12C ratio here: +! 1.176e-12 (Karlen et al., 1964) * 6.0221e23 (Avogadro constant) * 1.e-4 (cm**2 / m**2) +! = 7.0820e7 cm**2 / m**2 + production_rate_to_flux_14 = 7.0820e7 / ocean_area + cosmic_14 = cosmic_14_init / production_rate_to_flux_14 + end if + end if + end if ! use_atbox + + if (ciso) then +!! Define ciso variables assigning additional ciso tracer indices + idic_13 = bgc_base_num + 1 + iphyc_13 = bgc_base_num + 2 + idetc_13 = bgc_base_num + 3 + ihetc_13 = bgc_base_num + 4 + idoc_13 = bgc_base_num + 5 + idiac_13 = bgc_base_num + 6 + iphycal_13 = bgc_base_num + 7 + idetcal_13 = bgc_base_num + 8 + idic_14 = bgc_base_num + 9 + iphyc_14 = bgc_base_num + 10 + idetc_14 = bgc_base_num + 11 + ihetc_14 = bgc_base_num + 12 + idoc_14 = bgc_base_num + 13 + idiac_14 = bgc_base_num + 14 + iphycal_14 = bgc_base_num + 15 + idetcal_14 = bgc_base_num + 16 + + !< Allocate 13CO2 surface fields + allocate(GloPCO2surf_13 ( node_size )) + allocate(GloCO2flux_13 ( node_size )) + allocate(GloCO2flux_seaicemask_13 ( node_size )) + + GloPCO2surf_13 = 0.d0 + GloCO2flux_13 = 0.d0 + GloCO2flux_seaicemask_13 = 0.0d0 + + !< Allocate auxiliary inital delta13C_DIC field + allocate(delta_dic_13_init (nl-1, nod2D )) + + if (ciso_14) then + !< Allocate 14CO2 surface fields + allocate(GloPCO2surf_14 ( node_size )) + allocate(GloCO2flux_14 ( node_size )) + allocate(GloCO2flux_seaicemask_14 ( node_size )) + + GloPCO2surf_14 = 0.d0 + GloCO2flux_14 = 0.d0 + GloCO2flux_seaicemask_14 = 0.0d0 + + !< Allocate auxiliary inital d|Delta14C_DIC fields + allocate(delta_dic_14_init ( nl-1, nod2D )) + allocate(big_delta_dic_14_init ( nl-1, nod2D )) + end if ! ciso_14 + + end if ! ciso + DO i=num_tracers-bgc_num+1, num_tracers id=tracers%data(i)%ID @@ -308,6 +402,9 @@ subroutine recom_init(tracers, partit, mesh) CASE (1021) tracers%data(i)%values(:,:) = tiny ! DetCalc + CASE (1022) + tracers%data(i)%values(:,:) = tiny ! O2 + ! ******************* ! CASE 2phy 2zoo 2det ! ******************* @@ -332,20 +429,26 @@ subroutine recom_init(tracers, partit, mesh) #if defined (__coccos) & defined (__3Zoo2Det) CASE (1029) tracers%data(i)%values(:,:) = tiny_chl/chl2N_max ! CoccoN + CASE (1030) tracers%data(i)%values(:,:) = tiny_chl/chl2N_max/NCmax ! CoccoC + CASE (1031) tracers%data(i)%values(:,:) = tiny_chl ! CoccoChl + ! ******************* ! CASE 3phy 1zoo 1det ! ******************* #elif defined (__coccos) & !defined (__3Zoo2Det) CASE (1023) tracers%data(i)%values(:,:) = tiny_chl/chl2N_max ! CoccoN + CASE (1024) tracers%data(i)%values(:,:) = tiny_chl/chl2N_max/NCmax ! CoccoC + CASE (1025) tracers%data(i)%values(:,:) = tiny_chl ! CoccoChl + #endif ! ******************* @@ -354,16 +457,20 @@ subroutine recom_init(tracers, partit, mesh) #if defined (__coccos) & defined (__3Zoo2Det) CASE (1032) tracers%data(i)%values(:,:) = tiny ! Zoo3N + CASE (1033) tracers%data(i)%values(:,:) = tiny * Redfield ! Zoo3C + #elif !defined (__coccos) & defined (__3Zoo2Det) ! ******************* ! CASE 2phy 3zoo 2det ! ******************* CASE (1029) tracers%data(i)%values(:,:) = tiny ! Zoo3N + CASE (1030) tracers%data(i)%values(:,:) = tiny * Redfield ! Zoo3C + #endif END SELECT @@ -389,7 +496,7 @@ subroutine recom_init(tracers, partit, mesh) tracers%data(21)%values(:,:) = max(tiny, tracers%data(21)%values(:,:)) !------------------------------------------ - if(mype==0) write(*,*),'Tracers have been initialized as spinup from WOA/glodap netcdf files' + if(mype==0) write(*,*) 'Tracers have been initialized as spinup from WOA/glodap netcdf files' locDINmax = -66666 locDINmin = 66666 locDICmax = locDINmax diff --git a/src/int_recom/recom_main.F90 b/src/int_recom/recom_main.F90 index c9c5575e5..0c5b02653 100755 --- a/src/int_recom/recom_main.F90 +++ b/src/int_recom/recom_main.F90 @@ -94,10 +94,11 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) real(kind=8) :: SW, Loc_slp integer :: tr_num, num_tracers - integer :: nz, n, nzmin, nzmax + integer :: nz, n, nzmin, nzmax, nu1, nl1 integer :: idiags real(kind=8) :: Sali + logical :: do_update = .false. real(kind=8), allocatable :: Temp(:), Sali_depth(:), zr(:), PAR(:) real(kind=8), allocatable :: C(:,:) @@ -113,6 +114,7 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) real(kind=8), allocatable :: OmegaC_watercolumn(:) real(kind=8), allocatable :: kspc_watercolumn(:) real(kind=8), allocatable :: rhoSW_watercolumn(:) + real(kind=WP) :: ttf_rhs_bak (mesh%nl-1, tracers%num_tracers) ! local variable ! OG - tra_diag #include "../associate_part_def.h" #include "../associate_mesh_def.h" @@ -135,6 +137,17 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) if (restore_alkalinity) call bio_fluxes(tracers, partit, mesh) if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> bio_fluxes'//achar(27)//'[0m' + if (use_atbox) then ! MERGE +! Prognostic atmospheric isoCO2 + call recom_atbox(partit,mesh) +! optional I/O of isoCO2 and inferred cosmogenic 14C production; this may cost some CPU time + if (ciso .and. ciso_14) then + call annual_event(do_update,1) + if (do_update .and. mype==0) write (*, fmt = '(a50,2x,i6,4(2x,f6.2))') & + 'Year, xCO2 (ppm), cosmic 14C flux (at / cm² / s):', & + yearold, x_co2atm(1), x_co2atm_13(1), x_co2atm_14(1), cosmic_14(1) * production_rate_to_flux_14 + end if + end if ! ====================================================================================== !********************************* LOOP STARTS ***************************************** @@ -176,6 +189,31 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) !!---- Atmospheric CO2 in LocVar LocAtmCO2 = AtmCO2(month) +! Update of prognostic atmospheric CO2 values + if (use_atbox) then + LocAtmCO2 = x_co2atm(1) + if (ciso) then + LocAtmCO2_13 = x_co2atm_13(1) + if (ciso_14) LocAtmCO2_14 = x_co2atm_14(1) + end if + else +! Consider prescribed atmospheric CO2 values + if (ciso) then + LocAtmCO2_13 = AtmCO2_13(month) + if (ciso_14) then +! Latitude of nodal point n + lat_val = geo_coord_nod2D(2,n) / rad +! Zonally binned NH / SH / TZ 14CO2 input values + LocAtmCO2_14 = AtmCO2_14(lat_zone(lat_val), month) + end if + end if + end if ! use_atbox + + if (ciso) then + r_atm_13 = LocAtmCO2_13(1) / LocAtmCO2(1) + if (ciso_14) r_atm_14 = LocAtmCO2_14(1) / LocAtmCO2(1) + end if + !!---- Shortwave penetration SW = parFrac * shortwave(n) SW = SW * (1.d0 - a_ice(n)) @@ -206,6 +244,14 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) C(1:nzmax, tr_num-2) = tracers%data(tr_num)%values(1:nzmax, n) end do + ttf_rhs_bak = 0.0 ! OG - tra_diag + + if (tracers%data(1)%ltra_diag) then ! OG - tra_diag + do tr_num=1, num_tracers + ttf_rhs_bak(1:nzmax,tr_num) = tracers%data(tr_num)%values(1:nzmax, n) + end do + end if + !!---- Depth of the nodes in the water column zr(1:nzmax) = Z_3d_n(1:nzmax, n) @@ -219,29 +265,36 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) if (Diags) then !! * Allocate 3D diagnostics * - allocate(vertrespmeso(nl-1), vertrespmacro(nl-1), vertrespmicro(nl-1)) + allocate(vertrespmeso(nl-1)) vertrespmeso = 0.d0 + +#if defined (__3Zoo2Det) + allocate(vertrespmacro(nl-1), vertrespmicro(nl-1)) vertrespmacro = 0.d0 vertrespmicro = 0.d0 - +#endif allocate(vertcalcdiss(nl-1), vertcalcif(nl-1)) vertcalcdiss = 0.d0 vertcalcif = 0.d0 - allocate(vertaggn(nl-1), vertaggd(nl-1), vertaggc(nl-1)) + allocate(vertaggn(nl-1), vertaggd(nl-1)) vertaggn = 0.d0 vertaggd = 0.d0 - vertaggc = 0.d0 - allocate(vertdocexn(nl-1), vertdocexd(nl-1), vertdocexc(nl-1)) + allocate(vertdocexn(nl-1), vertdocexd(nl-1)) vertdocexn = 0.d0 vertdocexd = 0.d0 - vertdocexc = 0.d0 - allocate(vertrespn(nl-1), vertrespd(nl-1), vertrespc(nl-1)) + allocate(vertrespn(nl-1), vertrespd(nl-1)) vertrespn = 0.d0 vertrespd = 0.d0 + +#if defined (__coccos) + allocate(vertaggc(nl-1), vertdocexc(nl-1), vertrespc(nl-1)) + vertaggc = 0.d0 + vertdocexc = 0.d0 vertrespc = 0.d0 +#endif !! * Allocate 2D diagnostics * allocate(vertNPPn(nl-1), vertGPPn(nl-1), vertNNAn(nl-1), vertChldegn(nl-1)) @@ -256,11 +309,13 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) vertNNAd = 0.d0 vertChldegd = 0.d0 +#if defined (__coccos) allocate(vertNPPc(nl-1), vertGPPc(nl-1), vertNNAc(nl-1), vertChldegc(nl-1)) vertNPPc = 0.d0 vertGPPc = 0.d0 vertNNAc = 0.d0 vertChldegc = 0.d0 +#endif end if if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> REcoM_Forcing'//achar(27)//'[0m' @@ -282,6 +337,14 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) tracers%data(tr_num)%values(1:nzmax, n) = C(1:nzmax, tr_num-2) end do + ! recom_sms + if (tracers%data(1)%ltra_diag) then ! OG - tra_diag + do tr_num=1, num_tracers + tracers%work%tra_recom_sms(1:nzmax,n,tr_num) = tracers%data(tr_num)%values(1:nzmax, n) - ttf_rhs_bak(1:nzmax,tr_num) + !if (mype==0) print *, tra_recom_sms(:,:,tr_num) + end do + end if + !!---- Local variables that have been changed during the time-step are stored so they can be saved Benthos(n,1:benthos_num) = LocBenthos(1:benthos_num) GlodecayBenthos(n, 1:benthos_num) = decayBenthos(1:benthos_num)/SecondsPerDay ! convert from [mmol/m2/d] to [mmol/m2/s] @@ -304,35 +367,52 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) !! * Update 3D diagnostics * respmeso (1:nzmax,n) = vertrespmeso (1:nzmax) +#if defined (__3Zoo2Det) respmacro (1:nzmax,n) = vertrespmacro (1:nzmax) respmicro (1:nzmax,n) = vertrespmicro (1:nzmax) +#endif calcdiss (1:nzmax,n) = vertcalcdiss (1:nzmax) calcif (1:nzmax,n) = vertcalcif (1:nzmax) + aggn (1:nzmax,n) = vertaggn (1:nzmax) - aggd (1:nzmax,n) = vertaggd (1:nzmax) - aggc (1:nzmax,n) = vertaggc (1:nzmax) docexn (1:nzmax,n) = vertdocexn (1:nzmax) - docexd (1:nzmax,n) = vertdocexd (1:nzmax) - docexc (1:nzmax,n) = vertdocexc (1:nzmax) respn (1:nzmax,n) = vertrespn (1:nzmax) - respd (1:nzmax,n) = vertrespd (1:nzmax) - respc (1:nzmax,n) = vertrespc (1:nzmax) NPPn3D (1:nzmax,n) = vertNPPn (1:nzmax) + + aggd (1:nzmax,n) = vertaggd (1:nzmax) + docexd (1:nzmax,n) = vertdocexd (1:nzmax) + respd (1:nzmax,n) = vertrespd (1:nzmax) NPPd3D (1:nzmax,n) = vertNPPd (1:nzmax) + +#if defined (__coccos) + aggc (1:nzmax,n) = vertaggc (1:nzmax) + docexc (1:nzmax,n) = vertdocexc (1:nzmax) + respc (1:nzmax,n) = vertrespc (1:nzmax) NPPc3D (1:nzmax,n) = vertNPPc (1:nzmax) +#endif + +!YY: why printing this? if (recom_debug .and. mype==0) print *, achar(27)//'[36m'//' --> ciso after REcoM_Forcing'//achar(27)//'[0m' !! * Deallocating 2D diagnostics * deallocate(vertNPPn, vertGPPn, vertNNAn, vertChldegn) deallocate(vertNPPd, vertGPPd, vertNNAd, vertChldegd) +#if defined (__coccos) deallocate(vertNPPc, vertGPPc, vertNNAc, vertChldegc) +#endif !! * Deallocating 3D Diagnostics * - deallocate(vertrespmeso, vertrespmacro, vertrespmicro ) - deallocate(vertcalcdiss, vertcalcif ) - deallocate(vertaggn, vertaggd, vertaggc ) - deallocate(vertdocexn, vertdocexd, vertdocexc ) - deallocate(vertrespn, vertrespd, vertrespc ) + deallocate(vertrespmeso) +#if defined (__3Zoo2Det) + deallocate(vertrespmacro, vertrespmicro) +#endif + deallocate(vertcalcdiss, vertcalcif) + deallocate(vertaggn, vertdocexn, vertrespn) + deallocate(vertaggd, vertdocexd, vertrespd) +#if defined (__coccos) +! deallocate(vertgrazmeso_c) + deallocate(vertaggc, vertdocexc, vertrespc) +#endif end if @@ -345,6 +425,12 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) GloCO2flux(n) = dflux(1) ! [mmol/m2/d] GloCO2flux_seaicemask(n) = co2flux_seaicemask(1) ! [mmol/m2/s] GloO2flux_seaicemask(n) = o2flux_seaicemask(1) ! [mmol/m2/s] + if (ciso) then + GloCO2flux_seaicemask_13(n) = co2flux_seaicemask_13(1) ! [mmol/m2/s] + if (ciso_14) then + GloCO2flux_seaicemask_14(n) = co2flux_seaicemask_14(1) ! [mmol/m2/s] + end if + end if GloO2flux(n) = oflux(1) ! [mmol/m2/d] PAR3D(1:nzmax,n) = PAR(1:nzmax) @@ -375,6 +461,16 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) call exchange_nod(GloCO2flux_seaicemask, partit) call exchange_nod(GloO2flux_seaicemask, partit) + if (ciso) then + call exchange_nod(GloPCO2surf_13, partit) + call exchange_nod(GloCO2flux_13, partit) + call exchange_nod(GloCO2flux_seaicemask_13, partit) + if (ciso_14) then + call exchange_nod(GloPCO2surf_14, partit) + call exchange_nod(GloCO2flux_14, partit) + call exchange_nod(GloCO2flux_seaicemask_14, partit) + end if + end if do n=1, benthos_num call exchange_nod(Benthos(:,n), partit) end do @@ -388,10 +484,12 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) call exchange_nod(NNAd, partit) call exchange_nod(Chldegn, partit) call exchange_nod(Chldegd, partit) +#if defined (__coccos) call exchange_nod(NPPc, partit) call exchange_nod(GPPc, partit) call exchange_nod(NNAc, partit) call exchange_nod(Chldegc, partit) +#endif endif do n=1, benthos_num @@ -412,6 +510,7 @@ subroutine recom(ice, dynamics, tracers, partit, mesh) call exchange_nod(OmegaC3D, partit) call exchange_nod(kspc3D, partit) call exchange_nod(rhoSW3D, partit) + end subroutine recom ! ====================================================================================== @@ -496,4 +595,4 @@ subroutine bio_fluxes(tracers, partit, mesh) relax_alk=relax_alk-net/ocean_area ! at ocean surface layer -end subroutine bio_fluxes \ No newline at end of file +end subroutine bio_fluxes diff --git a/src/int_recom/recom_modules.F90 b/src/int_recom/recom_modules.F90 index c4113377c..a7b10dae0 100644 --- a/src/int_recom/recom_modules.F90 +++ b/src/int_recom/recom_modules.F90 @@ -110,7 +110,7 @@ module recom_config Logical :: REcoM_restart = .false. Integer :: bgc_num = 33 ! NEW increased the number from 28 to 34 (added coccos and respiration) ! NEW 3Zoo changed from 31 to 33 - integer :: bgc_base_num = 22 ! standard tracers + integer :: bgc_base_num = 22 ! tracer number for case 2phy 1zoo 1det Integer :: diags3d_num = 28 ! Number of diagnostic 3d tracers to be saved Real(kind=8) :: VDet = 20.d0 ! Sinking velocity, constant through the water column and positive downwards Real(kind=8) :: VDet_zoo2 = 200.d0 ! Sinking velocity, constant through the water column @@ -121,6 +121,7 @@ module recom_config Integer :: biostep = 1 ! Number of times biology should be stepped forward for each time step Logical :: REcoM_Geider_limiter = .false. ! Decides what routine should be used to calculate limiters in sms Logical :: REcoM_Grazing_Variable_Preference = .true. ! Decides if grazing should have preference for phyN or DiaN + Logical :: REcoM_Grazing_Variable_Efficiency = .true. ! allowes grazing efficiency to vary with food availability Logical :: Grazing_detritus = .false. ! Decides grazing on detritus Logical :: het_resp_noredfield = .true. ! Decides respiratation of copepods Logical :: diatom_mucus = .true. ! Effect of nutrient limitation on the aggregation @@ -169,7 +170,7 @@ module recom_config VDet, VDet_zoo2, & VPhy, VDia, VCocco, & allow_var_sinking, biostep, REcoM_Geider_limiter, & - REcoM_Grazing_Variable_Preference, & + REcoM_Grazing_Variable_Preference, REcoM_Grazing_Variable_Efficiency, & Grazing_detritus, & het_resp_noredfield, & diatom_mucus, & @@ -184,8 +185,7 @@ module recom_config currentCO2cycle, DIC_PI, Nmocsy, & recom_debug, ciso, benthos_num, & use_MEDUSA, sedflx_num, bottflx_num, & - add_loopback, lb_tscale, use_atbox, & - fe_2ligands, fe_compl_nica + add_loopback, lb_tscale, use_atbox !!------------------------------------------------------------------------------ !! *** Sinking *** @@ -269,7 +269,7 @@ module recom_config !! *** Iron chemistry *** Real(kind=8) :: totalligand = 1.d0 ! [mumol/m3] order 1. Total free ligand Real(kind=8) :: ligandStabConst = 100.d0 ! [m3/mumol] order 100. Ligand-free iron stability constant - namelist /pairon_chem/ totalligand, ligandStabConst + namelist /pairon_chem/ totalligand, ligandStabConst, fe_2ligands, fe_compl_nica !!------------------------------------------------------------------------------ !! *** Zooplankton *** Real(kind=8) :: graz_max = 2.4d0 ! [mmol N/(m3 * day)] Maximum grazing loss parameter @@ -688,7 +688,7 @@ Module REcoM_GloVar save Real(kind=8),allocatable,dimension(:,:) :: Benthos ! 4 types of benthos-tracers with size [4 n2d] - Real(kind=8),allocatable,dimension(:,:,:) :: Benthos_tr ! kh 25.03.22 buffer sums per tracer index to avoid non bit identical results regarding global sums when running the tracer loop in parallel + Real(kind=8),allocatable,dimension(:,:,:) :: Benthos_tr ! buffer sums per tracer index to avoid non bit identical results regarding global sums when running the tracer loop in parallel Real(kind=8),allocatable,dimension(:) :: GloFeDust ! [umol/m2/s] Monthly 2D field of iron soluted in surface water from dust Real(kind=8),allocatable,dimension(:) :: GloNDust ! [mmol/m2/s] 10-year mean 2D fields of nitrogen soluted in surface water from dust @@ -766,7 +766,7 @@ Module REcoM_GloVar ! for using MEDUSA Real(kind=8),allocatable,dimension(:,:) :: SinkFlx ! Diagnostics in 2D [4 n2d] or [6 n2d] with ciso - Real(kind=8),allocatable,dimension(:,:,:) :: SinkFlx_tr ! kh 25.03.22 buffer sums per tracer index to avoid non bit identical results regarding global sums when running the tracer loop in parallel + Real(kind=8),allocatable,dimension(:,:,:) :: SinkFlx_tr ! buffer sums per tracer index to avoid non bit identical results regarding global sums when running the tracer loop in parallel Real(kind=8),allocatable,dimension(:,:) :: Sinkingvel1 ! Diagnostics for vertical sinking Real(kind=8),allocatable,dimension(:,:) :: Sinkingvel2 ! Diagnostics for vertical sinking Real(kind=8),allocatable,dimension(:,:,:) :: Sinkvel1_tr ! Sinking speed of particle class 1 OG 16.03.23 diff --git a/src/int_recom/recom_sinking.F90 b/src/int_recom/recom_sinking.F90 index 0971e5bd0..0c37995a2 100644 --- a/src/int_recom/recom_sinking.F90 +++ b/src/int_recom/recom_sinking.F90 @@ -41,11 +41,6 @@ subroutine ver_sinking_recom_benthos(tr_num, tracer, partit, mesh) end interface end module !=============================================================================== -! YY: sinking of second detritus adapted from Ozgur's code -! but not using recom_det_tracer_id, since -! second detritus has a different sinking speed than the first -! define recom_det2_tracer_id to make it consistent??? -!=============================================================================== subroutine ver_sinking_recom_benthos(tr_num, tracers, partit, mesh) use MOD_MESH @@ -138,35 +133,183 @@ subroutine ver_sinking_recom_benthos(tr_num, tracers, partit, mesh) !! * Particulate Organic Nitrogen * if( tracers%data(tr_num)%ID==1004 .or. & !iphyn tracers%data(tr_num)%ID==1007 .or. & !idetn - tracers%data(tr_num)%ID==1013 .or. & !idian - tracers%data(tr_num)%ID==1025 ) then !idetz2n + tracers%data(tr_num)%ID==1013 ) then !idian +! Benthos(n,1)= Benthos(n,1) + add_benthos_2d(n) ![mmol] + +#if defined(__usetp) +! buffer sums per tracer index to avoid non bit identical results regarding global sums when running the tracer loop in parallel + Benthos_tr(n,1,tr_num)= Benthos_tr(n,1,tr_num) + add_benthos_2d(n) ![mmol] + + if (use_MEDUSA) then + SinkFlx_tr(n,1,tr_num) = SinkFlx_tr(n,1,tr_num) + add_benthos_2d(n) / area(1,n)/dt ![mmol/m2] + ! now SinkFlx hat the unit mmol/time step + ! but mmol/m2/time is needed for MEDUSA: thus /area + endif +#else Benthos(n,1)= Benthos(n,1) + add_benthos_2d(n) ![mmol] + if (use_MEDUSA) then + SinkFlx(n,1) = SinkFlx(n,1) + add_benthos_2d(n) / area(1,n)/dt ![mmol/m2] + endif +#endif endif !! * Particulate Organic Carbon * if( tracers%data(tr_num)%ID==1005 .or. & !iphyc tracers%data(tr_num)%ID==1008 .or. & !idetc - tracers%data(tr_num)%ID==1014 .or. & !idiac - tracers%data(tr_num)%ID==1026 ) then !idetz2c + tracers%data(tr_num)%ID==1014 ) then +! Benthos(n,2)= Benthos(n,2) + add_benthos_2d(n) + +#if defined(__usetp) + Benthos_tr(n,2,tr_num)= Benthos_tr(n,2,tr_num) + add_benthos_2d(n) + + if (use_MEDUSA) then + SinkFlx_tr(n,2,tr_num) = SinkFlx_tr(n,2,tr_num) + add_benthos_2d(n) / area(1,n)/dt + endif +#else Benthos(n,2)= Benthos(n,2) + add_benthos_2d(n) + if (use_MEDUSA) then + SinkFlx(n,2) = SinkFlx(n,2) + add_benthos_2d(n) / area(1,n)/dt + endif + +#endif endif !! *Particulate Organic Silicon * if( tracers%data(tr_num)%ID==1016 .or. & !idiasi - tracers%data(tr_num)%ID==1017 .or. & !idetsi - tracers%data(tr_num)%ID==1027 ) then !idetz2si + tracers%data(tr_num)%ID==1017 ) then +! Benthos(n,3)= Benthos(n,3) + add_benthos_2d(n) + +#if defined(__usetp) + Benthos_tr(n,3,tr_num)= Benthos_tr(n,3,tr_num) + add_benthos_2d(n) + + if (use_MEDUSA) then + SinkFlx_tr(n,3,tr_num) = SinkFlx_tr(n,3,tr_num) + add_benthos_2d(n) / area(1,n)/dt + endif +#else Benthos(n,3)= Benthos(n,3) + add_benthos_2d(n) + if (use_MEDUSA) then + SinkFlx(n,3) = SinkFlx(n,3) + add_benthos_2d(n) / area(1,n)/dt + endif +#endif endif !! * Cal * if( tracers%data(tr_num)%ID==1020 .or. & !iphycal - tracers%data(tr_num)%ID==1021 .or. & !idetcal - tracers%data(tr_num)%ID==1028 ) then !idetz2cal + tracers%data(tr_num)%ID==1021 ) then !idetcal +! Benthos(n,4)= Benthos(n,4) + add_benthos_2d(n) + +#if defined(__usetp) + Benthos_tr(n,4,tr_num)= Benthos_tr(n,4,tr_num) + add_benthos_2d(n) + + if (use_MEDUSA) then + SinkFlx_tr(n,4,tr_num) = SinkFlx_tr(n,4,tr_num) + add_benthos_2d(n) / area(1,n)/dt + endif +#else Benthos(n,4)= Benthos(n,4) + add_benthos_2d(n) + if (use_MEDUSA) then + SinkFlx(n,4) = SinkFlx(n,4) + add_benthos_2d(n) / area(1,n)/dt + endif +#endif endif + + ! flux of 13C into the sediment + if (ciso) then + if( tracers%data(tr_num)%ID==1305 .or. & !iphyc_13 + tracers%data(tr_num)%ID==1308 .or. & !idetc_13 + tracers%data(tr_num)%ID==1314 ) then !idiac_13 +! Benthos(n,5)= Benthos(n,5) + add_benthos_2d(n) + +#if defined(__usetp) + Benthos_tr(n,5,tr_num)= Benthos_tr(n,5,tr_num) + add_benthos_2d(n) + + if (use_MEDUSA) then + SinkFlx_tr(n,5,tr_num) = SinkFlx_tr(n,5,tr_num) + add_benthos_2d(n) / area(1,n)/dt + endif +#else + Benthos(n,5)= Benthos(n,5) + add_benthos_2d(n) + if (use_MEDUSA) then + SinkFlx(n,5) = SinkFlx(n,5) + add_benthos_2d(n) / area(1,n)/dt + endif +#endif + endif + + if( tracers%data(tr_num)%ID==1320 .or. & !iphycal_13 + tracers%data(tr_num)%ID==1321 ) then !idetcal_13 +! Benthos(n,6)= Benthos(n,6) + add_benthos_2d(n) + +#if defined(__usetp) + Benthos_tr(n,6,tr_num)= Benthos_tr(n,6,tr_num) + add_benthos_2d(n) + + if (use_MEDUSA) then + SinkFlx_tr(n,6,tr_num) = SinkFlx_tr(n,6,tr_num) + add_benthos_2d(n) / area(1,n)/dt + endif +#else + Benthos(n,6)= Benthos(n,6) + add_benthos_2d(n) + if (use_MEDUSA) then + SinkFlx(n,6) = SinkFlx(n,6) + add_benthos_2d(n) / area(1,n)/dt + endif +#endif + endif + + endif + + ! flux of 14C into the sediment + if (ciso .and. ciso_organic_14) then + if( tracers%data(tr_num)%ID==1405 .or. & !iphyc_14 + tracers%data(tr_num)%ID==1408 .or. & !idetc_14 + tracers%data(tr_num)%ID==1414 ) then !idiac_14 +! Benthos(n,7)= Benthos(n,7) + add_benthos_2d(n) + +#if defined(__usetp) + Benthos_tr(n,7,tr_num)= Benthos_tr(n,7,tr_num) + add_benthos_2d(n) + + if (use_MEDUSA) then + SinkFlx_tr(n,7,tr_num) = SinkFlx_tr(n,7,tr_num) + add_benthos_2d(n) / area(1,n)/dt + endif +#else + Benthos(n,7)= Benthos(n,7) + add_benthos_2d(n) + if (use_MEDUSA) then + SinkFlx(n,7) = SinkFlx(n,7) + add_benthos_2d(n) / area(1,n)/dt + endif +#endif + endif + + if( tracers%data(tr_num)%ID==1420 .or. & !iphycal_14 + tracers%data(tr_num)%ID==1421 ) then !idetcal_14 +! Benthos(n,8)= Benthos(n,8) + add_benthos_2d(n) + +#if defined(__usetp) + Benthos_tr(n,8,tr_num)= Benthos_tr(n,8,tr_num) + add_benthos_2d(n) + if (use_MEDUSA) then + SinkFlx_tr(n,8,tr_num) = SinkFlx_tr(n,8,tr_num) + add_benthos_2d(n) / area(1,n)/dt + endif +#else + Benthos(n,8)= Benthos(n,8) + add_benthos_2d(n) + if (use_MEDUSA) then + SinkFlx(n,8) = SinkFlx(n,8) + add_benthos_2d(n) / area(1,n)/dt + endif +#endif + endif + endif + end do + + if(use_MEDUSA) then + do n=1, bottflx_num +#if defined(__usetp) + call exchange_nod(SinkFlx_tr(:,n,tr_num), partit) +#else + call exchange_nod(SinkFlx(:,n), partit) +#endif + end do + end if ! use_MEDUSA + do n=1, benthos_num +#if defined(__usetp) + call exchange_nod(Benthos_tr(:,n,tr_num), partit) +#else call exchange_nod(Benthos(:,n), partit) +#endif end do end subroutine ver_sinking_recom_benthos @@ -223,6 +366,43 @@ subroutine diff_ver_recom_expl(tr_num, tracers, partit, mesh) bottom_flux = 0._WP id = tracers%data(tr_num)%ID +#if defined(__recom) +if (use_MEDUSA .and. (sedflx_num .ne. 0)) then + !CV update: the calculation later has been changed by Ozgur in such + !a way that now the variable bottom_flux is in (mol/time) units, + !rather than a flux in (mol/time/area). I therefore multiply the + !Medusa fluxes by the area to get the same unit. + + SELECT CASE (id) + CASE (1001) + bottom_flux = GloSed(:,1) * area(1,:) ! DIN + CASE (1002) + bottom_flux = GloSed(:,2) * area(1,:) ! DIC + CASE (1003) + bottom_flux = GloSed(:,3) * area(1,:) ! Alk + CASE (1018) + bottom_flux = GloSed(:,4) * area(1,:) ! Si + CASE (1019) + bottom_flux = GloSed(:,1) * Fe2N_benthos * area(1,:) + CASE (1022) + bottom_flux = GloSed(:,5) * area(1,:) ! Oxy + CASE (1302) + if (ciso) then + bottom_flux = GloSed(:,6) * area(1,:) ! DIC_13 and Calc: DIC_13 + end if + CASE (1402) + if (ciso) then + bottom_flux = GloSed(:,7) * area(1,:) ! DIC_14 and Calc: DIC_14 + end if + CASE DEFAULT + if (partit%mype==0) then + write(*,*) 'check specified in boundary conditions' + write(*,*) 'the model will stop!' + end if + call par_ex(partit%MPI_COMM_FESOM, partit%mype) + stop + END SELECT +else SELECT CASE (id) CASE (1001) bottom_flux = GlodecayBenthos(:,1) !*** DIN [mmolN/m^2/s] *** @@ -236,6 +416,14 @@ subroutine diff_ver_recom_expl(tr_num, tracers, partit, mesh) bottom_flux = GlodecayBenthos(:,1) * Fe2N_benthos !*** DFe *** CASE (1022) bottom_flux = -GlodecayBenthos(:,2) * redO2C !*** O2 *** + CASE (1302) + if (ciso) then + bottom_flux = GlodecayBenthos(:,5) + GlodecayBenthos(:,6) !*** DIC_13 and Calc: DIC_13 *** + end if + CASE (1402) + if (ciso) then + bottom_flux = GlodecayBenthos(:,7) + GlodecayBenthos(:,8) !*** DIC_14 and Calc: DIC_14 *** + end if CASE DEFAULT if (partit%mype==0) then write(*,*) 'check specified in boundary conditions' @@ -244,6 +432,8 @@ subroutine diff_ver_recom_expl(tr_num, tracers, partit, mesh) call par_ex(partit%MPI_COMM_FESOM, partit%mype) stop END SELECT +endif ! (use_MEDUSA .and. (sedflux_num .gt. 0)) +#endif do n=1, myDim_nod2D @@ -438,7 +628,7 @@ subroutine ver_sinking_recom(tr_num, tracers, partit, mesh) endif #endif - end do + end do !nz=nzmin,nzmax+1 dt_sink = dt vd_flux = 0.0d0 @@ -479,7 +669,7 @@ subroutine ver_sinking_recom(tr_num, tracers, partit, mesh) tv= (0.5 * wPs * (trarr(nz,n) + psiM * Rj)+ & 0.5 * wM * (trarr(max(nzmin,nz-1),n) + psiP * Rj)) vd_flux(nz)= - tv*area(nz,n) - end do + end do !nz=nzmax, nzmin+1,-1 end if ! 3rd Order DST Sceheme with flux limiting if (.FALSE.) then ! simple upwind @@ -503,12 +693,12 @@ subroutine ver_sinking_recom(tr_num, tracers, partit, mesh) trarr(nz ,n)*(Wvel_flux(nz)+abs(Wvel_flux(nz)))) vd_flux(nz)= tv*area(nz,n) - end do + end do !nz=nzmin+1,nzmax end if ! simple upwind do nz=nzmin,nzmax vert_sink(nz,n) = vert_sink(nz,n) + (vd_flux(nz)-vd_flux(nz+1))*dt/areasvol(nz,n)/hnode_new(nz,n) !/(zbar_3d_n(nz,n)-zbar_3d_n(nz+1,n)) end do - end do + end do !n = 1,myDim_nod2D end if ! Vsink .gt. 0.1 end subroutine ver_sinking_recom diff --git a/src/int_recom/recom_sms.F90 b/src/int_recom/recom_sms.F90 index 044d59c1e..3200aaa31 100644 --- a/src/int_recom/recom_sms.F90 +++ b/src/int_recom/recom_sms.F90 @@ -258,6 +258,50 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & if (Grazing_detritus) recipDet2 = DetZ2C / DetZ2N #endif + if (ciso) then +!< additional variables are declared in module REcoM_ciso + DIC_13 = max(tiny,state(k,idic_13) + sms(k,idic_13 )) + PhyC_13 = max(tiny_C,state(k,iphyc_13) + sms(k,iphyc_13 )) + DetC_13 = max(tiny,state(k,idetc_13) + sms(k,idetc_13 )) + HetC_13 = max(tiny,state(k,ihetc_13) + sms(k,ihetc_13 )) + EOC_13 = max(tiny,state(k,idoc_13) + sms(k,idoc_13 )) + DiaC_13 = max(tiny_C,state(k,idiac_13) + sms(k,idiac_13 )) + PhyCalc_13 = max(tiny,state(k,iphycal_13) + sms(k,iphycal_13)) + DetCalc_13 = max(tiny,state(k,idetcal_13) + sms(k,idetcal_13)) + + calc_diss_13 = alpha_dcal_13 * calc_diss + + quota_13 = PhyN / PhyC_13 + recipQuota_13 = real(one) / quota_13 + + quota_dia_13 = DiaN / DiaC_13 + recipQuota_dia_13 = real(one) / quota_dia_13 + + recipQZoo_13 = HetC_13 / HetN + + if (ciso_14) then + DIC_14 = max(tiny,state(k,idic_14) + sms(k,idic_14 )) + if (ciso_organic_14) then + PhyC_14 = max(tiny_C,state(k,iphyc_14) + sms(k,iphyc_14 )) + DetC_14 = max(tiny,state(k,idetc_14) + sms(k,idetc_14 )) + HetC_14 = max(tiny,state(k,ihetc_14) + sms(k,ihetc_14 )) + EOC_14 = max(tiny,state(k,idoc_14) + sms(k,idoc_14 )) + DiaC_14 = max(tiny_C,state(k,idiac_14) + sms(k,idiac_14 )) + PhyCalc_14 = max(tiny,state(k,iphycal_14) + sms(k,iphycal_14)) + DetCalc_14 = max(tiny,state(k,idetcal_14) + sms(k,idetcal_14)) + + calc_diss_14 = alpha_dcal_14 * calc_diss + + quota_14 = PhyN / PhyC_14 + recipQuota_14 = real(one) / quota_14 + + quota_dia_14 = DiaN / DiaC_14 + recipQuota_dia_14 = real(one) / quota_dia_14 + recipQZoo_14 = HetC_14 / HetN + end if ! ciso_organic_14 + end if ! ciso_14 + end if ! ciso + !------------------------------------------------------------------------------- !> Temperature dependence of rates !------------------------------------------------------------------------------- @@ -415,7 +459,9 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & !------------------------------------------------------------------------------ ! Calcite dissolution dependent on OmegaC ! DISS !------------------------------------------------------------------------------ - Sink_Vel = Vdet_a* abs(zF(k)) + Vdet +!Ying 26.12.2025: calcite dissolution applied a different depth dependence relative to sinking + Sink_Vel = Vcalc * abs(zF(k)) + Vdet +! Sink_Vel = Vdet_a* abs(zF(k)) + Vdet if (OmegaC_diss) then ! Calcdiss dependent on carbonate saturation Ca = (0.02128d0/40.078d0) * Sali_depth(k)/1.80655d0 ! Calcium ion concentration [mol/kg], function from varsolver.f90 @@ -619,7 +665,19 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & !< *** Iron chemistry *** !< ********************** ! select the method to calculate freeFe - freeFe = iron_chemistry(Fe,totalligand,ligandStabConst) + if (fe_2ligands) then + if (fe_compl_nica) then + logK1 = max(tiny, 24.36 - 1.67 * pH_watercolumn(k) & + + EOC * (-2.e-4 * EOC + 0.034)) + logK2 = logK1 + 2.67 + Klig1 = 10 ** (logK1 - 9) + Klig2 = 10 ** (logK2 - 9) + freeFe = iron_chemistry_2ligands(Fe,1.7,0.6,Klig1,Klig2) + endif + else + freeFe = iron_chemistry(Fe,totalligand,ligandStabConst) + endif + !------------------------------------------------------------------------------- !< *** Chlorophyll synthesis *** !< ***************************** @@ -748,7 +806,11 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & !< *** Grazing efficiency *** !< ************************** - grazEff = gfin + 1/(0.2*food + 2) + if (REcoM_Grazing_Variable_Efficiency) then + grazEff = gfin + 1/(0.2*food + 2) + else + grazEff = gfin + end if grazingFluxcarbon_mes = (grazingFlux_phy * recipQuota * grazEff) & + (grazingFlux_Dia * recipQuota_Dia * grazEff) @@ -939,6 +1001,18 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & HetRespFlux = max(zero, HetRespFlux) !!!!!!!! CHECK Judith Valid for het_resp_noredfield case as well ???????? Then move it below endif + if (ciso) then +!MB set HetRespFlux_plus = .true. in namelist.recom +! HetRespFlux_13 = max(zero, recip_res_het * arrFunc * (hetC_13 * recip_hetN_plus - redfield) * HetC_13) +! Numerically safer parametrization avoiding instable results which may result from different cutoff values -- CHECK + HetRespFlux_13 = HetRespFlux * HetC_13 / HetC +!! HetRespFlux_13 = HetRespFlux * (HetC_13 / HetC) **2 + if (ciso_14 .and. ciso_organic_14) then +! HetRespFlux_14 = max(zero, recip_res_het * arrFunc * (hetC_14 * recip_hetN_plus - redfield) * HetC_14) + HetRespFlux_14 = HetRespFlux * HetC_14 / HetC +!! HetRespFlux_14 = HetRespFlux * (HetC_14 / HetC) **2 + end if + end if !------------------------------------------------------------------------------- !< Zooplanton mortality (Quadratic) @@ -1059,6 +1133,19 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & calc_loss_gra3 = grazingFlux_phy3 * aux ! 3Zoo #endif #endif + + if (ciso) then + calcification_13 = calc_prod_ratio * Cphot * PhyC_13 * alpha_calc_13 + calcification_13 = calcification * alpha_calc_13 + calc_loss_agg_13 = aggregationRate * PhyCalc_13 + calc_loss_gra_13 = grazingFlux_phy * recipQuota_13/(PhyC_13 + tiny) * PhyCalc_13 + if (ciso_14 .and. ciso_organic_14) then + calcification_14 = calc_prod_ratio * Cphot * PhyC_14 * alpha_calc_14 + calc_loss_agg_14 = aggregationRate * PhyCalc_14 + calc_loss_gra_14 = grazingFlux_phy * recipQuota_14/(PhyC_14 + tiny) * PhyCalc_14 + end if + end if + !------------------------------------------------------------------------------- ! Sources minus sinks (SMS) !------------------------------------------------------------------------------- @@ -1219,25 +1306,25 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & if (Grazing_detritus) then #if defined (__3Zoo2Det) sms(k,idetn) = ( & - + grazingFlux_phy3 & - - grazingFlux_phy3 * grazEff3 & - + grazingFlux_dia3 & - - grazingFlux_dia3 * grazEff3 & + + grazingFlux_phy3 & ! --> grazing on small phytoplankton by third zooplankton + - grazingFlux_phy3 * grazEff3 & ! --> fraction of grazingFlux_phy3 into microzooplankton pool + + grazingFlux_dia3 & ! --> grazing on diatoms by third zooplankton + - grazingFlux_dia3 * grazEff3 & ! --> fraction of grazingFlux_dia3 into microzooplankton pool #if defined (__coccos) - + grazingFlux_Cocco3 & - - grazingFlux_Cocco3 * grazEff3 & + + grazingFlux_Cocco3 & ! --> grazing on coccolithophores by third zooplankton + - grazingFlux_Cocco3 * grazEff3 & ! --> fraction of grazingFlux_Cocco3 into microzooplankton pool + aggregationRate * CoccoN & #endif - - grazingFlux_Det * grazEff & - - grazingFlux_Det2 * grazEff2 & ! --> okay, grazing of second zoo on first detritus + - grazingFlux_Det * grazEff & ! --> grazing of first zoo (meso) on first detritus class + - grazingFlux_Det2 * grazEff2 & ! --> grazing of second zoo (macro) on first detritus class + aggregationRate * PhyN & + aggregationRate * DiaN & - + miczooLossFlux & - - reminN * arrFunc * O2Func * DetN & ! O2remin + + miczooLossFlux & ! --> microzooplankton, mortality + - reminN * arrFunc * O2Func * DetN & ! --> O2remin ) * dt_b + sms(k,idetn) #else sms(k,idetn) = ( & - + grazingFlux_phy & + + grazingFlux_phy & ! Technically it is mesooooooooooooooooo - grazingFlux_phy * grazEff & + grazingFlux_dia & - grazingFlux_dia * grazEff & @@ -1301,7 +1388,7 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & + aggregationRate * CoccoC & #endif - grazingFlux_Det * recipDet * grazEff & - - grazingFlux_Det2 * recipDet2 * grazEff2 & + - grazingFlux_Det2 * recipDet * grazEff2 & ! corrected recipDet2 -> recipDet + aggregationRate * PhyC & + aggregationRate * DiaC & + miczooLossFlux * recipQZoo3 & @@ -1319,7 +1406,7 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & + aggregationRate * CoccoC & #endif - grazingFlux_Det * recipDet * grazEff & - - grazingFlux_Det2 * recipDet2 * grazEff & !!!!!! CHECK + ! - grazingFlux_Det2 * recipDet2 * grazEff & !!!!!! CHECK + aggregationRate * phyC & + aggregationRate * DiaC & + hetLossFlux * recipQZoo & @@ -2001,6 +2088,188 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & #endif ) * redO2C * dt_b + sms(k,ioxy) ! + if (ciso) then +!------------------------------------------------------------------------------- +! DIC_13 + sms(k,idic_13) = ( & +! - Cphot * PhyC_13 & + - Cphot * r_phyc_13 * PhyC & + + phyRespRate * PhyC_13 & +! - Cphot_Dia * DiaC_13 & + - Cphot_Dia * r_diac_13 * DiaC & + + phyRespRate_Dia * DiaC_13 & + + rho_C1 * arrFunc * EOC_13 & + + HetRespFlux_13 & + + calc_diss_13 * DetCalc_13 & + + calc_loss_gra_13 * calc_diss_guts & + - calcification_13 & + ) * dt_b + sms(k,idic_13) +!------------------------------------------------------------------------------- +! Phytoplankton C_13 + sms(k,iphyc_13) = ( & +! + Cphot * PhyC_13 & + + Cphot * r_phyc_13 * PhyC & + - lossC * limitFacN * PhyC_13 & + - phyRespRate * PhyC_13 & + - aggregationRate * PhyC_13 & + - grazingFlux_phy * recipQuota_13 & + ) * dt_b + sms(k,iphyc_13) +!------------------------------------------------------------------------------- +! Detritus C_13 + sms(k,idetc_13) = ( & + + grazingFlux_phy * recipQuota_13 & + - grazingFlux_phy * recipQuota_13 * grazEff & + + grazingFlux_Dia * recipQuota_dia_13 & + - grazingFlux_Dia * recipQuota_dia_13 * grazEff & + + aggregationRate * phyC_13 & + + aggregationRate * DiaC_13 & + + hetLossFlux * recipQZoo_13 & + - reminC * arrFunc * DetC_13 & + ) * dt_b + sms(k,idetc_13) +!------------------------------------------------------------------------------- +! Heterotrophic C_13 + sms(k,ihetc_13) = ( & + + grazingFlux_phy * recipQuota_13 * grazEff & + + grazingFlux_Dia * recipQuota_dia_13 * grazEff & + - hetLossFlux * recipQZoo_13 & + - lossC_z * HetC_13 & + - hetRespFlux_13 & + ) * dt_b + sms(k,ihetc_13) +!------------------------------------------------------------------------------- +! EOC_13 + sms(k,idoc_13) = ( & + + lossC * limitFacN * phyC_13 & + + lossC_d * limitFacN_dia * DiaC_13 & + + reminC * arrFunc * DetC_13 & + + lossC_z * HetC_13 & + - rho_c1 * arrFunc * EOC_13 & + + LocRiverDOC * r_iorg_13 & + ) * dt_b + sms(k,idoc_13) +!------------------------------------------------------------------------------- +! Diatom C_13 + sms(k,idiac_13) = ( & +! + Cphot_dia * DiaC_13 & + + Cphot_dia * r_diac_13 * DiaC & + - lossC_d * limitFacN_dia * DiaC_13 & + - phyRespRate_dia * DiaC_13 & + - aggregationRate * DiaC_13 & + - grazingFlux_dia * recipQuota_dia_13 & + ) * dt_b + sms(k,idiac_13) +!------------------------------------------------------------------------------- +! Small phytoplankton calcite_13 + sms(k,iphycal_13) = ( & + + calcification_13 & + - lossC * limitFacN * phyCalc_13 & + - phyRespRate * phyCalc_13 & + - calc_loss_agg_13 & + - calc_loss_gra_13 & + ) * dt_b + sms(k,iphycal_13) +!------------------------------------------------------------------------------- +! Detritus calcite_13 + sms(k,idetcal_13) = ( & + + lossC * limitFacN * phyCalc_13 & + + phyRespRate * phyCalc_13 & + + calc_loss_agg_13 & + + calc_loss_gra_13 & + - calc_loss_gra_13 * calc_diss_guts & + - calc_diss_13 * DetCalc_13 & + ) * dt_b + sms(k,idetcal_13) +!------------------------------------------------------------------------------- + if (ciso_14) then +!------------------------------------------------------------------------------- + if (ciso_organic_14) then +! DIC_14 + sms(k,idic_14) = ( & +! - Cphot * PhyC_14 & + - Cphot * r_phyc_14 * PhyC & + + phyRespRate * PhyC_14 & +! - Cphot_Dia * DiaC_14 & + - Cphot_Dia * r_diac_14 * DiaC & + + phyRespRate_Dia * DiaC_14 & + + rho_C1 * arrFunc * EOC_14 & + + HetRespFlux_14 & + + calc_diss_14 * DetCalc_14 & + + calc_loss_gra_14 * calc_diss_guts & + - calcification_14 & + ) * dt_b + sms(k,idic_14) +!------------------------------------------------------------------------------- +! Phytoplankton C_14 + sms(k,iphyc_14) = ( & +! + Cphot * PhyC_14 & + + Cphot * r_phyc_14 * PhyC & + - lossC * limitFacN * PhyC_14 & + - phyRespRate * PhyC_14 & + - aggregationRate * PhyC_14 & + - grazingFlux_phy * recipQuota_14 & + ) * dt_b + sms(k,iphyc_14) +!------------------------------------------------------------------------------- +! Detritus C_14 + sms(k,idetc_14) = ( & + + grazingFlux_phy * recipQuota_14 & + - grazingFlux_phy * recipQuota_14 * grazEff & + + grazingFlux_Dia * recipQuota_dia_14 & + - grazingFlux_Dia * recipQuota_dia_14 * grazEff & + + aggregationRate * phyC_14 & + + aggregationRate * DiaC_14 & + + hetLossFlux * recipQZoo_14 & + - reminC * arrFunc * DetC_14 & + ) * dt_b + sms(k,idetc_14) +!------------------------------------------------------------------------------- +! Heterotrophic C_14 + sms(k,ihetc_14) = ( & + + grazingFlux_phy * recipQuota_14 * grazEff & + + grazingFlux_Dia * recipQuota_dia_14 * grazEff & + - hetLossFlux * recipQZoo_14 & + - lossC_z * HetC_14 & + - hetRespFlux_14 & + ) * dt_b + sms(k,ihetc_14) +!------------------------------------------------------------------------------- +! EOC_14 + sms(k,idoc_14) = ( & + + lossC * limitFacN * phyC_14 & + + lossC_d * limitFacN_dia * DiaC_14 & + + reminC * arrFunc * DetC_14 & + + lossC_z * HetC_14 & + - rho_c1 * arrFunc * EOC_14 & + + LocRiverDOC * r_iorg_14 & + ) * dt_b + sms(k,idoc_14) +!------------------------------------------------------------------------------- +! Diatom C_14 + sms(k,idiac_14) = ( & +! + Cphot_dia * DiaC_14 & + + Cphot_dia * r_diac_14 * DiaC & + - lossC_d * limitFacN_dia * DiaC_14 & + - phyRespRate_dia * DiaC_14 & + - aggregationRate * DiaC_14 & + - grazingFlux_dia * recipQuota_dia_14 & + ) * dt_b + sms(k,idiac_14) +!------------------------------------------------------------------------------- +! Small phytoplankton calcite_14 + sms(k,iphycal_14) = ( & + + calcification_14 & + - lossC * limitFacN * phyCalc_14 & + - phyRespRate * phyCalc_14 & + - calc_loss_agg_14 & + - calc_loss_gra_14 & + ) * dt_b + sms(k,iphycal_14) +!------------------------------------------------------------------------------- +! Detritus calcite_14 + sms(k,idetcal_14) = ( & + + lossC * limitFacN * phyCalc_14 & + + phyRespRate * phyCalc_14 & + + calc_loss_agg_14 & + + calc_loss_gra_14 & + - calc_loss_gra_14 * calc_diss_guts & + - calc_diss_14 * DetCalc_14 & + ) * dt_b + sms(k,idetcal_14) +!------------------------------------------------------------------------------- + else +! "Abiotic" DIC_14, identical to DIC except for radioactive decay (-> +! recom_forcing) + sms(k,idic_14) = sms(k,idic) + end if ! ciso_organic_14 + end if ! ciso_14 + end if ! ciso !------------------------------------------------------------------------------- ! Diagnostics: Averaged rates @@ -2153,6 +2422,13 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & !------------------------------------------------------------------------------- ! Remineralization from the sediments into the bottom layer + + if (use_MEDUSA .and. (sedflx_num .ne. 0)) then + if (mype==0) then !OG + write(*,*) ' --> Sedimentary input of nutrients through MEDUSA' + endif + + else ! not use_MEDUSA or sedflx_num = 0 !*** DIN *** !< decayRateBenN: Remineralization rate for benthic N [day^-1] !< LocBenthos(1): Vertically integrated N concentration in benthos (1 layer) [mmolN/m^2] @@ -2175,6 +2451,29 @@ subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & decayBenthos(4) = calc_diss_ben * LocBenthos(4) ! NEW DISS changed calc_diss to calc_diss_ben to not make the dissolution omega dependent when using the switch OmegaC_diss LocBenthos(4) = LocBenthos(4) - decayBenthos(4) * dt_b + if (ciso) then +!*** DIC_13 *** We ignore isotopic fractionation during remineralization. + decayBenthos(5) = alpha_dcal_13 * decayRateBenC * LocBenthos(5) + LocBenthos(5) = LocBenthos(5) - decayBenthos(5) * dt_b +!*** Calc: DIC_13 *** + decayBenthos(6) = calc_diss_13 * LocBenthos(6) + LocBenthos(6) = LocBenthos(6) - decayBenthos(6) * dt_b ! / depth of benthos + if (ciso_14) then + if (ciso_organic_14) then +!*** DIC_14 *** We ignore isotopic fractionation during remineralization. + decayBenthos(7) = alpha_dcal_14 * decayRateBenC * LocBenthos(7) + LocBenthos(7) = LocBenthos(7) - decayBenthos(7) * dt_b +!*** Calc: DIC_14 *** + decayBenthos(8) = calc_diss_14 * LocBenthos(8) + LocBenthos(8) = LocBenthos(8) - decayBenthos(8) * dt_b ! / depth of benthos + else +! Do nothing here because sms(idic_14) is defined as sms(idic) further +! above + end if ! ciso_organic_14 + end if ! ciso_14 + end if ! ciso + endif ! use_MEDUSA + end do ! Main time loop ends @@ -2271,5 +2570,5 @@ function iron_chemistry(Fe, totalLigand, ligandStabConst) iron_chemistry = freeFe return - end + end function iron_chemistry diff --git a/src/int_recom/recom_sms.F90.new_ciso b/src/int_recom/recom_sms.F90.new_ciso new file mode 100644 index 000000000..513163130 --- /dev/null +++ b/src/int_recom/recom_sms.F90.new_ciso @@ -0,0 +1,2571 @@ +subroutine REcoM_sms(n,Nn,state,thick,recipthick,SurfSR,sms,Temp, Sali_depth & + , CO2_watercolumn & + , pH_watercolumn & + , pCO2_watercolumn & + , HCO3_watercolumn & + , CO3_watercolumn & + , OmegaC_watercolumn & + , kspc_watercolumn & + , rhoSW_watercolumn & + , Loc_slp, zF, PAR, Lond, Latd, ice, dynamics, tracers, partit, mesh) + + use recom_declarations + use recom_locvar + use recom_glovar + use recom_config + use recoM_ciso + use g_clock + + use g_config + use MOD_MESH + use MOD_TRACER + use MOD_DYN + USE MOD_ICE + use o_ARRAYS + use o_PARAM + USE MOD_PARTIT + USE MOD_PARSUP + + use g_forcing_arrays + use g_comm_auto + use mvars + use mdepth2press + use gsw_mod_toolbox, only: gsw_sa_from_sp,gsw_ct_from_pt,gsw_rho + + implicit none + type(t_dyn) , intent(inout), target :: dynamics + type(t_tracer), intent(inout), target :: tracers + type(t_partit), intent(inout), target :: partit + type(t_mesh) , intent(inout), target :: mesh + type(t_ice) , intent(inout), target :: ice + + integer, intent(in) :: Nn !< Total number of nodes in the vertical + real(kind=8),dimension(mesh%nl-1,bgc_num),intent(inout) :: state !< ChlA conc in phytoplankton [mg/m3] + !! should be in instead of inout + + real(kind=8),dimension(mesh%nl-1) :: thick !< [m] Vertical distance between two nodes = Thickness + real(kind=8),dimension(mesh%nl-1) :: recipthick !< [1/m] reciprocal of thick + real(kind=8),intent(in) :: SurfSR !< [W/m2] ShortWave radiation at surface + + real(kind=8),dimension(mesh%nl-1,bgc_num),intent(inout) :: sms !< Source-Minus-Sinks term + real(kind=8),dimension(mesh%nl-1) ,intent(in) :: Temp !< [degrees C] Ocean temperature + real(kind=8),dimension(mesh%nl-1) ,intent(in) :: Sali_depth !< NEW MOCSY Salinity for the whole water column + + Real(kind=8),dimension(mesh%nl-1),intent(inout) :: CO2_watercolumn !< [mol/m3] + Real(kind=8),dimension(mesh%nl-1),intent(inout) :: pH_watercolumn !< on total scale + Real(kind=8),dimension(mesh%nl-1),intent(inout) :: pCO2_watercolumn !< [uatm] + Real(kind=8),dimension(mesh%nl-1),intent(inout) :: HCO3_watercolumn !< [mol/m3] + Real(kind=8),dimension(mesh%nl-1),intent(inout) :: CO3_watercolumn !< [mol/m3] + Real(kind=8),dimension(mesh%nl-1),intent(inout) :: OmegaC_watercolumn !< calcite saturation state + Real(kind=8),dimension(mesh%nl-1),intent(inout) :: kspc_watercolumn !< stoichiometric solubility product [mol^2/kg^2] + Real(kind=8),dimension(mesh%nl-1),intent(inout) :: rhoSW_watercolumn !< in-situ density of seawater [kg/m3] + + real(kind=8),dimension(mesh%nl) ,intent(in) :: zF !< [m] Depth of fluxes + real(kind=8),dimension(mesh%nl-1),intent(inout) :: PAR + + real(kind=8) :: dt_d !< Size of time steps [day] + real(kind=8) :: dt_b !< Size of time steps [day] + real(kind=8),dimension(mesh%nl-1) :: Sink + real(kind=8) :: dt_sink !< Size of local time step + + real(kind=8) :: recip_hetN_plus !< MB's addition to heterotrophic respiration + real(kind=8) :: recip_res_het !< [day] Reciprocal of respiration by heterotrophs and mortality (loss to detritus) + real(kind=8) :: Sink_Vel + real(kind=8) :: aux + integer :: k,step,ii, idiags,n + + real(kind=8), intent(in) :: Loc_slp ![Pa] sea-level pressure + real(kind=8) :: Patm_depth(1) + real(kind=8) :: REcoM_T_depth(1) ! MOCSY temperature for the whole water column for mocsy minimum defined as -2 + real(kind=8) :: REcoM_S_depth(1) + real(kind=8) :: REcoM_DIC_depth(1) + real(kind=8) :: REcoM_Alk_depth(1) + real(kind=8) :: REcoM_Si_depth(1) + real(kind=8) :: REcoM_Phos_depth(1) + real(kind=8), intent(in) :: Latd(1) ! latitude in degree + real(kind=8), intent(in) :: Lond(1) ! longitude in degree + real(kind=8) :: mocsy_step_per_day + real(kind=8) :: & + DIN, & !< Dissolved Inorganic Nitrogen [mmol/m3] + DIC, & !< Dissolved Inorganic Carbon [mmol/m3] + Alk, & !< Total Alkalinity [mmol/m3] + PhyN, & !< Intracellular conc of Nitrogen in small phytoplankton [mmol/m3] + PhyC, & !< Intracellular conc of Carbon in small phytoplankton [mmol/m3] + PhyChl, & !< Current intracellular ChlA conc. [mg/m3] + DetN, & !< Conc of N in Detritus [mmol/m3] + DetC, & !< Conc of C in Detritus [mmol/m3] + HetN, & !< Conc of N in heterotrophs [mmol/m3] + HetC, & !< Conc of C in heterotrophs [mmol/m3] + DON, & !< Dissolved organic N in the water [mmol/m3] + EOC, & !< Extracellular Organic C conc [mmol/m3] + DiaN, & + DiaC, & + DiaChl, & + DiaSi, & + DetSi, & +#if defined (__coccos) + CoccoN, & + CoccoC, & + CoccoChl,& +#endif + Si, & + Fe, & + PhyCalc, & + DetCalc, & +#if defined (__3Zoo2Det) + Zoo2N, & + Zoo2C, & + DetZ2N, & + DetZ2C, & + DetZ2Si, & + DetZ2Calc,& + MicZooN, & ! 3Zoo + MicZooC, & ! 3Zoo +#endif + FreeFe, & + O2 + +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + sms = zero ! double precision + + tiny_N = tiny_chl/chl2N_max !< 0.00001/ 3.15d0 Chl2N_max [mg CHL/mmol N] Maximum CHL a : N ratio = 0.3 gCHL gN^-1 + tiny_N_d = tiny_chl/chl2N_max_d !< 0.00001/ 4.2d0 + + tiny_C = tiny_N /NCmax !< NCmax = 0.2d0 [mmol N/mmol C] Maximum cell quota of nitrogen (N:C) + tiny_C_d = tiny_N_d/NCmax_d !< NCmax_d = 0.2d0 + + tiny_Si = tiny_C_d/SiCmax !< SiCmax = 0.8d0 + +#if defined (__coccos) + tiny_N_c = tiny_chl/chl2N_max_c + tiny_C_c = tiny_N_c/NCmax_c +#endif + + recip_res_het = 1.d0/res_het !< res_het = 0.01d0 [1/day] Respiration by heterotrophs and mortality (loss to detritus) + + Patm_depth = Loc_slp/Pa2atm ! MOCSY convert from Pa to atm. + +!------------------------------------------------------------------------------- +!> REcoM time steps [day] +!------------------------------------------------------------------------------- + + rTref = real(one)/recom_Tref + + dt_d = dt/SecondsPerDay !< Size of FESOM time step [day] + dt_b = dt_d/real(biostep) !< Size of REcoM time step [day] + +!------------------------------------------------------------------------------- +!Main time loop starts + do step = one,biostep + + kdzUpper = 0.d0 !< Upper light attenuation of top cell is set to zero + + if (any(abs(sms(:,:)) <= tiny)) sms(:,:) = zero ! tiny = 2.23D-16 + +!------------------------------------------------------------------------------- +! Main vertical loop starts + do k = one,Nn ! nzmin, nzmax +! do n=1, myDim_nod2D!+eDim_nod2D +! Nn=nlevels_nod2D(n)-1 !nzmax +! nzmin = ulevels_nod2D(row) +! nzmax = nlevels_nod2D(row) + DIN = max(tiny,state(k,idin) + sms(k,idin )) !< Avoids division by zero + DIC = max(tiny,state(k,idic) + sms(k,idic )) !! and updates Conc between + ALK = max(tiny,state(k,ialk) + sms(k,ialk )) !! local steps in REcoM when + PhyN = max(tiny_N,state(k,iphyn) + sms(k,iphyn )) !! biostep > 1 + PhyC = max(tiny_C,state(k,iphyc) + sms(k,iphyc )) + PhyChl = max(tiny_chl,state(k,ipchl) + sms(k,ipchl )) + DetN = max(tiny,state(k,idetn) + sms(k,idetn )) + DetC = max(tiny,state(k,idetc) + sms(k,idetc )) + HetN = max(tiny,state(k,ihetn) + sms(k,ihetn )) + HetC = max(tiny,state(k,ihetc) + sms(k,ihetc )) +#if defined (__3Zoo2Det) + Zoo2N = max(tiny,state(k,izoo2n) + sms(k,izoo2n)) + Zoo2C = max(tiny,state(k,izoo2c) + sms(k,izoo2c)) + DetZ2N = max(tiny,state(k,idetz2n) + sms(k,idetz2n)) + DetZ2C = max(tiny,state(k,idetz2c) + sms(k,idetz2c)) + DetZ2Si = max(tiny,state(k,idetz2si) + sms(k,idetz2si)) + DetZ2Calc = max(tiny,state(k,idetz2calc) + sms(k,idetz2calc)) + MicZooN = max(tiny,state(k,imiczoon) + sms(k,imiczoon)) + MicZooC = max(tiny,state(k,imiczooc) + sms(k,imiczooc)) +#endif + DON = max(tiny,state(k,idon) + sms(k,idon )) + EOC = max(tiny,state(k,idoc) + sms(k,idoc )) + DiaN = max(tiny_N_d,state(k,idian) + sms(k,idian )) + DiaC = max(tiny_C_d,state(k,idiac) + sms(k,idiac )) + DiaChl = max(tiny_chl,state(k,idchl) + sms(k,idchl )) + DiaSi = max(tiny_si,state(k,idiasi) + sms(k,idiasi)) + DetSi = max(tiny,state(k,idetsi) + sms(k,idetsi)) + Si = max(tiny,state(k,isi) + sms(k,isi )) +#if defined (__coccos) + CoccoN = max(tiny_N_c,state(k,icocn) + sms(k,icocn )) + CoccoC = max(tiny_C_c,state(k,icocc) + sms(k,icocc )) + CoccoChl = max(tiny_chl,state(k,icchl) + sms(k,icchl )) +#endif + Fe = max(tiny,state(k,ife) + sms(k,ife )) + O2 = max(tiny,state(k,ioxy) + sms(k,ioxy)) + FreeFe = zero + +! For Mocsy + REcoM_T_depth = max(2.d0, Temp(k)) ! minimum set to 2 degC: K1/K2 Lueker valid between 2degC-35degC and 19-43psu + REcoM_T_depth = min(REcoM_T_depth, 40.d0) ! maximum set to 40 degC: K1/K2 Lueker valid between 2degC-35degC and 19-43psu + REcoM_S_depth = max(21.d0, Sali_depth(k)) ! minimum set to 21: K1/K2 Lueker valid between 2degC-35degC and 19-43psu, else causes trouble in regions with S between 19 and 21 and ice conc above 97% + REcoM_S_depth = min(REcoM_S_depth, 43.d0) ! maximum set to 43: K1/K2 Lueker valid between 2degC-35degC and 19-43psu, else causes trouble + REcoM_DIC_depth = max(tiny*1e-3,state(k,idic)*1e-3 + sms(k,idic )*1e-3) + REcoM_Alk_depth = max(tiny*1e-3,state(k,ialk)*1e-3 + sms(k,ialk )*1e-3) + REcoM_Si_depth = max(tiny*1e-3,state(k,isi)*1e-3 + sms(k,isi )*1e-3) + + REcoM_Phos_depth = max(tiny*1e-3,state(k,idin)*1e-3 + sms(k,idin )*1e-3) /16 ! convert N to P with Redfield [mol/m3] + + PhyCalc = max(tiny,state(k,iphycal) + sms(k,iphycal)) + DetCalc = max(tiny,state(k,idetcal) + sms(k,idetcal)) + +!!------------------------------------------------------------------------------ +!< Quotas + ! *** Small phytoplankton + quota = PhyN / PhyC ! include variability of the N: C ratio, cellular chemical composition + recipquota = real(one) / quota + Chl2C = PhyChl / PhyC ! Chl a:phytoplankton carbon ratio, cellular chemical composition [gCHL gC^-1] + Chl2N = PhyChl / PhyN ! Chl a:phytoplankton nitrogen ratio, cellular chemical composition [gCHL gN^-1] + CHL2C_plast = Chl2C * (quota/(quota - NCmin)) + + ! *** Diatoms + quota_dia = DiaN / DiaC + recipQuota_dia = real(one)/quota_dia + Chl2C_dia = DiaChl / DiaC + Chl2N_dia = DiaChl / DiaN + CHL2C_plast_dia = Chl2C_dia * (quota_dia/(quota_dia - NCmin_d)) + qSiC = DiaSi / DiaC + qSiN = DiaSi / DiaN + +#if defined (__coccos) + quota_cocco = CoccoN / CoccoC + recipQuota_cocco = real(one)/quota_cocco + Chl2C_cocco = CoccoChl / CoccoC + Chl2N_cocco = CoccoChl / CoccoN + CHL2C_plast_cocco = Chl2C_cocco * (quota_cocco/(quota_cocco - NCmin_c)) +#endif + recipQZoo = HetC / HetN + recip_hetN_plus = 1.d0 / (HetN + tiny_het) ! MB's addition for more stable zoo respiration + if (Grazing_detritus) recipDet = DetC / DetN +#if defined (__3Zoo2Det) + recipQZoo2 = Zoo2C / Zoo2N + recipQZoo3 = MicZooC / MicZooN + if (Grazing_detritus) recipDet2 = DetZ2C / DetZ2N +#endif + + if (ciso) then +!< additional variables are declared in module REcoM_ciso + DIC_13 = max(tiny,state(k,idic_13) + sms(k,idic_13 )) + PhyC_13 = max(tiny_C,state(k,iphyc_13) + sms(k,iphyc_13 )) + DetC_13 = max(tiny,state(k,idetc_13) + sms(k,idetc_13 )) + HetC_13 = max(tiny,state(k,ihetc_13) + sms(k,ihetc_13 )) + EOC_13 = max(tiny,state(k,idoc_13) + sms(k,idoc_13 )) + DiaC_13 = max(tiny_C,state(k,idiac_13) + sms(k,idiac_13 )) + PhyCalc_13 = max(tiny,state(k,iphycal_13) + sms(k,iphycal_13)) + DetCalc_13 = max(tiny,state(k,idetcal_13) + sms(k,idetcal_13)) + + calc_diss_13 = alpha_dcal_13 * calc_diss + + quota_13 = PhyN / PhyC_13 + recipQuota_13 = real(one) / quota_13 + + quota_dia_13 = DiaN / DiaC_13 + recipQuota_dia_13 = real(one) / quota_dia_13 + + recipQZoo_13 = HetC_13 / HetN + + if (ciso_14) then + DIC_14 = max(tiny,state(k,idic_14) + sms(k,idic_14 )) + if (ciso_organic_14) then + PhyC_14 = max(tiny_C,state(k,iphyc_14) + sms(k,iphyc_14 )) + DetC_14 = max(tiny,state(k,idetc_14) + sms(k,idetc_14 )) + HetC_14 = max(tiny,state(k,ihetc_14) + sms(k,ihetc_14 )) + EOC_14 = max(tiny,state(k,idoc_14) + sms(k,idoc_14 )) + DiaC_14 = max(tiny_C,state(k,idiac_14) + sms(k,idiac_14 )) + PhyCalc_14 = max(tiny,state(k,iphycal_14) + sms(k,iphycal_14)) + DetCalc_14 = max(tiny,state(k,idetcal_14) + sms(k,idetcal_14)) + + calc_diss_14 = alpha_dcal_14 * calc_diss + + quota_14 = PhyN / PhyC_14 + recipQuota_14 = real(one) / quota_14 + + quota_dia_14 = DiaN / DiaC_14 + recipQuota_dia_14 = real(one) / quota_dia_14 + recipQZoo_14 = HetC_14 / HetN + end if ! ciso_organic_14 + end if ! ciso_14 + end if ! ciso + +!------------------------------------------------------------------------------- +!> Temperature dependence of rates +!------------------------------------------------------------------------------- +!< Schourup 2013 Eq. A54 +!< Temperature dependence of metabolic rate, fT, dimensionless +!< Ae: Slope of the linear region of the Arrhenius plot +!< rTloc: Inverse of local temperature in [1/Kelvin] +!< rTref=288.15 (15 degC): Reference temperature for Arrhenius equation [1/Kelvin] +!< See Figure A1 +!< Other functions can be used for temperature dependency (Eppley 1972; Li 1980; Ahlgren 1987) + + rTloc = real(one)/(Temp(k) + C2K) + arrFunc = exp(-Ae * ( rTloc - rTref)) +#if defined (__coccos) + CoccoTFunc = max(0.1419d0 * Temp(k)**0.8151d0,tiny) ! Function from Fielding 2013; is based on observational GR, but range fits best to ours +#endif + +#if defined (__3Zoo2Det) + arrFuncZoo2 = exp(t1_zoo2/t2_zoo2 - t1_zoo2*rTloc)/(1 + exp(t3_zoo2/t4_zoo2 - t3_zoo2*rTloc)) ! 2Zoo + q10_mes = 1.0242**(Temp(k)) ! 3Zoo + q10_mic = 1.04**(Temp(k)) ! 3Zoo + q10_mes_res = 1.0887**(Temp(k)) ! 3Zoo + q10_mic_res = 1.0897**(Temp(k)) ! 3Zoo +#endif + +!< Silicate temperature dependence +! reminSiT = min(1.32e16 * exp(-11200.d0 * rTloc),reminSi) !! arrFunc control, reminSi=0.02d0 ! Kamatani (1982) +! reminSiT = reminSi + reminSiT = max(0.023d0 * 2.6d0**((Temp(k)-10.)/10.),reminSi) + +!------------------------------------------------------------------------------- +!> O2 dependence of rates +!------------------------------------------------------------------------------- +!! O2 dependency of organic matter remineralization +!! O2Func [0.0, 1.0] +!! k_o2_remin = 15.d0 mmol m-3; Table 1 in Cram 2018 cites +!! DeVries & Weber 2017 for a range of 0-30 mmol m-3 + + O2Func = 1.d0 ! in this case, remin. rates only depend on temperature + if (O2dep_remin) O2Func = O2/(k_o2_remin + O2) ! O2remin + +!< *** Light *** +!< ************* +!! Has to be calculated here already to use the 1%PAR depth. + if (k==1) then + PARave = max(tiny,SurfSR) + PAR(k) = PARave + + chl_upper = (PhyChl + DiaChl) +#if defined (__coccos) + chl_upper = chl_upper + CoccoChl +#endif + else + chl_lower = PhyChl + DiaChl +#if defined (__coccos) + chl_lower = chl_lower + CoccoChl +#endif + Chlave = (chl_upper+chl_lower)*0.5 + + kappa = k_w + a_chl * (Chlave) + kappastar = kappa / cosAI(n) + kdzLower = kdzUpper + kappastar * thick(k-1) + Lowerlight = SurfSR * exp(-kdzLower) + Lowerlight = max(tiny,Lowerlight) + PARave = Lowerlight + PAR(k) = PARave + chl_upper = chl_lower + kdzUpper = kdzLower + end if + +!------------------------------------------------------------------------------- +! Depth component of Mocsy (see http://ocmip5.ipsl.jussieu.fr/mocsy/pyth.html) +!------------------------------------------------------------------------------- + +! Calculate the carbonate system for the very first time step of the first year of the run + !if (mocsy_restart==.false. .and. recom_istep==1) then ! r_restart is defined in gen_modules_clock in fesom_cpl. + dpos(1) = -zF(k) + if (mstep==1) then + call vars_sprac(ph_depth, pco2_depth, fco2_depth, co2_depth, hco3_depth, co3_depth, OmegaA_depth, OmegaC_depth, kspc_depth, BetaD_depth, & + rhoSW_depth, p_depth, tempis_depth, & + REcoM_T_depth, REcoM_S_depth, REcoM_Alk_depth, REcoM_DIC_depth, REcoM_Si_depth, REcoM_Phos_depth, Patm_depth, dpos, Latd, Nmocsy, & + optCON='mol/m3', optT='Tpot ', optP='m ', optB='u74', optK1K2='l ', optKf='dg', optGAS='Pinsitu', optS='Sprc') + CO2_watercolumn(k) = co2_depth(1) + pH_watercolumn(k) = ph_depth(1) + pCO2_watercolumn(k) = pco2_depth(1) + HCO3_watercolumn(k) = hco3_depth(1) + CO3_watercolumn(k) = co3_depth(1) + OmegaC_watercolumn(k) = OmegaC_depth(1) + kspc_watercolumn(k) = kspc_depth(1) + rhoSW_watercolumn(k) = rhoSW_depth(1) + endif + +!! Calculate carbonate system every 7 days for depths < 1%PAR, and every 30 days for the depths below. + mocsy_step_per_day = 1/dt_b ! NEW ms: time steps per day in recom -> is that correct? Not necessary to define in namelist? + logfile_outfreq_7 = mocsy_step_per_day*7 + logfile_outfreq_30 = mocsy_step_per_day*30 + + if (PARave > 0.01*SurfSR .and. mod(mstep,logfile_outfreq_7)==0) then + call vars_sprac(ph_depth, pco2_depth, fco2_depth, co2_depth, hco3_depth, co3_depth, OmegaA_depth, OmegaC_depth, kspc_depth, BetaD_depth, & + rhoSW_depth, p_depth, tempis_depth, & + REcoM_T_depth, REcoM_S_depth, REcoM_Alk_depth, REcoM_DIC_depth, REcoM_Si_depth, REcoM_Phos_depth, Patm_depth, dpos, Latd, Nmocsy, & + optCON='mol/m3', optT='Tpot ', optP='m ', optB='u74', optK1K2='l ', optKf='dg', optGAS='Pinsitu', optS='Sprc') + CO2_watercolumn(k) = co2_depth(1) + pH_watercolumn(k) = ph_depth(1) + pCO2_watercolumn(k) = pco2_depth(1) + HCO3_watercolumn(k) = hco3_depth(1) + CO3_watercolumn(k) = co3_depth(1) + OmegaC_watercolumn(k) = OmegaC_depth(1) + kspc_watercolumn(k) = kspc_depth(1) + rhoSW_watercolumn(k) = rhoSW_depth(1) + + elseif (PARave < 0.01*SurfSR .and. mod(mstep,logfile_outfreq_30)==0) then + call vars_sprac(ph_depth, pco2_depth, fco2_depth, co2_depth, hco3_depth, co3_depth, OmegaA_depth, OmegaC_depth, kspc_depth, BetaD_depth, & + rhoSW_depth, p_depth, tempis_depth, & + REcoM_T_depth, REcoM_S_depth, REcoM_Alk_depth, REcoM_DIC_depth, REcoM_Si_depth, REcoM_Phos_depth, Patm_depth, dpos, Latd, Nmocsy, & + optCON='mol/m3', optT='Tpot ', optP='m ', optB='u74', optK1K2='l ', optKf='dg', optGAS='Pinsitu', optS='Sprc') + CO2_watercolumn(k) = co2_depth(1) + pH_watercolumn(k) = ph_depth(1) + pCO2_watercolumn(k) = pco2_depth(1) + HCO3_watercolumn(k) = hco3_depth(1) + CO3_watercolumn(k) = co3_depth(1) + OmegaC_watercolumn(k) = OmegaC_depth(1) + kspc_watercolumn(k) = kspc_depth(1) + rhoSW_watercolumn(k) = rhoSW_depth(1) + endif + +!------------------------------------------------------------------------------- +! CO2 dependence of rates ! NEW CO2 +!------------------------------------------------------------------------------- +! Convert pH to proton concentration + h_depth(1) = 10.**(-ph_depth(1)) +! Conversion factor Cunits not needed for [H], because in model and function derived from pH and therefore in [mol/L] + +! Small phytoplankton + PhyCO2 = a_co2_phy * HCO3_watercolumn(k) * Cunits / (b_co2_phy + HCO3_watercolumn(k) * Cunits) & + - exp(-c_co2_phy * CO2_watercolumn(k) * Cunits) - d_co2_phy * 10.**(-pH_watercolumn(k)) + PhyCO2 = min(PhyCO2,3.d0) ! April 2022: limitation to 3 + PhyCO2 = max(0.d0,PhyCO2) ! July 2022: limitation to zero + +! Diatoms + DiaCO2 = a_co2_dia * HCO3_watercolumn(k) * Cunits / (b_co2_dia + HCO3_watercolumn(k) * Cunits) & + - exp(-c_co2_dia * CO2_watercolumn(k) * Cunits) - d_co2_dia * 10.**(-pH_watercolumn(k)) + DiaCO2 = min(DiaCO2,3.d0) ! April 2022: limitation to 3 + DiaCO2 = max(0.d0,DiaCO2) ! July 2022: limitation to zero + +#if defined (__coccos) +! Coccolithophores + CoccoCO2 = a_co2_cocco * HCO3_watercolumn(k) * Cunits / (b_co2_cocco + HCO3_watercolumn(k) * Cunits) & + - exp(-c_co2_cocco * CO2_watercolumn(k) * Cunits) - d_co2_cocco * 10.**(-pH_watercolumn(k)) + CoccoCO2 = min(CoccoCO2,3.d0) ! April 2022: limitation to 3 + CoccoCO2 = max(0.d0,CoccoCO2) ! July 2022: limitation to zero +#endif + + +!------------------------------------------------------------------------------ +! Calcite dissolution dependent on OmegaC ! DISS +!------------------------------------------------------------------------------ +!Ying 26.12.2025: calcite dissolution applied a different depth dependence relative to sinking + Sink_Vel = Vcalc * abs(zF(k)) + Vdet +! Sink_Vel = Vdet_a* abs(zF(k)) + Vdet + + if (OmegaC_diss) then ! Calcdiss dependent on carbonate saturation + Ca = (0.02128d0/40.078d0) * Sali_depth(k)/1.80655d0 ! Calcium ion concentration [mol/kg], function from varsolver.f90 + CO3_sat = (kspc_watercolumn(k) / Ca) * rhoSW_watercolumn(k) ! Saturated carbonate ion concentration, converted to [mol/m3] + calc_diss = calc_diss_omegac * max(zero,(1-(CO3_watercolumn(k)/CO3_sat)))**(calc_diss_exp) ! Dissolution rate scaled by carbonate ratio, after Aumont et al. 2015 +#if defined (__3Zoo2Det) + calc_diss2 = calc_diss +#endif + calc_diss_ben = calc_diss + else ! Calcdiss dependent on depth + + calc_diss = calc_diss_rate * Sink_Vel/20.d0 ! Dissolution rate of CaCO3 scaled by the sinking velocity at the current depth +#if defined (__3Zoo2Det) +! calc_diss2 = calc_diss_rate2 ! Dissolution rate of CaCO3 scaled by the sinking velocity at the current depth seczoo + calc_diss2 = calc_diss_rate2* Sink_Vel/20.d0 +#endif + calc_diss_ben = calc_diss_rate * Sink_Vel/20.d0 ! DISS added the variable calc_diss_ben to keep the calcite dissolution in the benthos with the old formulation + endif +!------------------------------------------------------------------------------- +!> Photosynthesis section, light parameters and rates +!------------------------------------------------------------------------------- +!< Schourup 2013 Appendix A6.2 +!< Intracellular regulation of C uptake +!< qlimitFac, qlimitFacTmp: Factor that regulates photosynthesis +!< NMinSlope: 50.d0 +!< NCmin: 0.04d0 +!< quota: PhyN/PhyC +!< qlimitFac [0.0, 1.0] +!< if quota < NCmin qlimitFac=0 +!< if quota > ≈ 9 * NCmin qlimitFac=1 +!< P_cm: 3.0d0 [1/day], Rate of C-specific photosynthesis + +!< pMax = The carbon-specific, light-saturated rate of photosynthesis [day^-1] +!< Nutrient limited environment +!< Small pyhtoplankton is limited by iron and nitrogen +!< Diatoms are additionally limited by silicon + +!< *** Small phytoplankton *** +!< *************************** + qlimitFac = recom_limiter(NMinSlope, NCmin, quota) ! Eqn A55 + feLimitFac = Fe/(k_Fe + Fe) ! Use Michaelis–Menten kinetics + qlimitFac = min(qlimitFac, feLimitFac) ! Liebig law of the minimum + pMax = P_cm * qlimitFac * arrFunc ! Maximum value of C-specific rate of photosynthesis + +!< *** Diatoms *** +!< *************** + qlimitFac = recom_limiter(NMinSlope, NCmin_d, quota_dia) + qlimitFacTmp = recom_limiter(SiMinSlope, SiCmin, qSiC) + qlimitFac = min(qLimitFac, qlimitFacTmp) + feLimitFac = Fe/(k_Fe_d + Fe) + qlimitFac = min(qlimitFac, feLimitFac) + pMax_dia = P_cm_d * qlimitFac * arrFunc + +!< *** Coccolithophores *** +!< ************************ +#if defined (__coccos) + qlimitFac = recom_limiter(NMinSlope, NCmin_c, quota_cocco) + feLimitFac = Fe/(k_Fe_c + Fe) + qlimitFac = min(qlimitFac, feLimitFac) + pMax_cocco = P_cm_c * qlimitFac * CoccoTFunc ! Here the T dependency is changed +#endif +!------------------------------------------------------------------------------- +!< *** Small phytoplankton photosynthesis rate *** +!< *********************************************** + if (pMax .lt. tiny .OR. PARave /= PARave .OR. CHL2C /= CHL2C) then ! OG in case of only respiration, i.e. darkness?? + Cphot = zero + else + Cphot = pMax*(real(one) - exp(-alfa * Chl2C * PARave / pMax)) + if (CO2lim) Cphot = Cphot * PhyCO2 ! Added the CO2 dependence + end if + if (Cphot .lt. tiny) Cphot = zero + +!< *** Diatom photosynthesis rate *** +!< ********************************** + if ( pMax_dia .lt. tiny .OR. PARave /= PARave .OR. CHL2C_dia /= CHL2C_dia) then + Cphot_dia = zero + else + Cphot_dia = pMax_dia * (real(one) - exp(-alfa_d * Chl2C_dia * PARave / pMax_dia)) + if (CO2lim) Cphot_dia = Cphot_dia * DiaCO2 ! Added the CO2 dependence + end if + if (Cphot_dia .lt. tiny) Cphot_dia = zero + +!< *** Coccolithophore photosynthesis rate *** +!< ******************************************* +#if defined (__coccos) + if ( pMax_cocco .lt. tiny .OR. Parave /= Parave .OR. CHL2C_cocco /= CHL2C_cocco) then + Cphot_cocco = zero + else + Cphot_cocco = pMax_cocco * (real(one) - exp( -alfa_c * Chl2C_cocco * PARave / pMax_cocco)) + if (CO2lim) Cphot_cocco = Cphot_cocco * CoccoCO2 ! Added the CO2 dependence + end if + if (Cphot_cocco .lt. tiny) Cphot_cocco = zero +#endif +!------------------------------------------------------------------------------- +!< chlorophyll degradation +!------------------------------------------------------------------------------- + KOchl = deg_Chl + KOchl_dia = deg_Chl_d +#if defined (__coccos) + KOchl_cocco = deg_Chl_c +#endif + + if (use_photodamage) then +!< add a minimum value for photodamage +!< *** Phytoplankton Chla loss *** +!< ******************************* + if (pMax .lt. tiny .OR. PARave /= PARave .OR. CHL2C_plast /= CHL2C_plast) then + KOchl = deg_Chl*0.1d0 + else + KOchl = deg_Chl*(real(one) - exp(-alfa * CHL2C_plast * PARave / pMax)) + KOchl = max((deg_Chl*0.1d0), KOchl) + end if +!< *** Diatoms Chla loss *** +!< ************************* + if (pMax_dia .lt. tiny .OR. PARave /= PARave .OR. CHL2C_plast_dia /= CHL2C_plast_dia) then + KOchl_dia = deg_Chl_d*0.1d0 + else + KOchl_dia = deg_Chl_d * (real(one) - exp(-alfa_d * CHL2C_plast_dia * PARave / pMax_dia )) + KOchl_dia = max((deg_Chl_d*0.1d0), KOchl_dia) + end if +!< *** Coccolithophores chla loss *** +!< ********************************** +#if defined (__coccos) + if (pMax_cocco .lt. tiny .OR. PARave /= Parave .OR. CHL2C_plast_cocco /= CHL2C_plast_cocco) then + KOchl_cocco = deg_Chl_c*0.1d0 + else + KOchl_cocco = deg_Chl_c * (real(one) - exp( -alfa_c * CHL2C_plast_cocco * PARave / pMax_cocco )) + KOchl_cocco = max((deg_Chl_c*0.1d0), KOchl_cocco) + end if +#endif + if (KOchl /= KOchl) then + print*,' KOchl is ', KOchl + print*,' deg_Chl is ', deg_Chl + print*,' alfa is ', alfa + print*,' CHL2C is ', CHL2C_plast + print*,' PARave is ', PARave + print*,' pMax is ', pMax + stop + end if + if (KOchl_dia /= KOchl_dia) then + print*,' KOchl_dia is ', KOchl_dia + print*,' deg_Chl_d is ', deg_Chl_d + print*,' alfa_d is ', alfa_d + print*,' CHL2C_d is ', CHL2C_plast_dia + print*,' PARave is ', PARave + print*,' pMax_d is ', pMax_dia + stop + end if +#if defined (__coccos) + if (KOchl_cocco /= KOchl_cocco) then + print*,' KOchl_cocco is ', KOchl_cocco + print*,' deg_Chl_c is ', deg_Chl_c + print*,' alfa_c is ', alfa_c + print*,' CHL2C_c is ', CHL2C_plast_cocco + print*,' PARave is ', PARave + print*,' pMax_c is ', pMax_cocco + stop + end if +#endif + end if ! photodamage + +!------------------------------------------------------------------------------- +!> Assimilation section +!------------------------------------------------------------------------------- + +!< Nitrogen and silicon part +!< Compute assimilation from Geider et al 1998 +!< V_cm: Scaling factor for C-specific N uptake, dimensionless +!< NCmax: Maximum cell quota of nitrogen (N:C) [mmol N/mmol C] +!< NMaxSlope: Max slope for limiting function +!< NCuptakeRatio: Maximum uptake ratio N:C [mmol N mmol C−1] +!< SiCUptakeRatio: Maximum uptake ratio Si : C [mmol Si mmol C−1 ] +!< The N:C ratio is taken into account, as a +!! too high ratio indicates that the intracellular +!! concentration of energy rich carbon molecules becomes too low to +!! use energy on silicon uptake. + + V_cm = V_cm_fact + limitFacN = recom_limiter(NMaxSlope, quota, NCmax) + N_assim = V_cm * pMax * NCuptakeRatio & ! [mmol N / (mmol C * day)] + * limitFacN * (DIN/(DIN + k_din)) ! Michaelis–Menten kinetics + + V_cm = V_cm_fact_d + limitFacN_dia = recom_limiter(NMaxSlope, quota_dia, NCmax_d) + N_assim_dia = V_cm * pMax_dia * NCUptakeRatio_d & + * limitFacN_dia * DIN/(DIN + k_din_d) + +#if defined (__coccos) + V_cm = V_cm_fact_c + limitFacN_cocco = recom_limiter(NMaxSlope, quota_cocco, NCmax_c) + N_assim_cocco = V_cm * pMax_cocco * NCUptakeRatio_c & + * limitFacN_cocco * DIN/(DIN + k_din_c) +#endif + + limitFacSi = recom_limiter(SiMaxSlope, qSiC, SiCmax) & + * limitFacN_dia + Si_assim = V_cm_fact_d * P_cm_d * arrFunc * SiCUptakeRatio & + * limitFacSi * Si/(Si + k_si) + +!------------------------------------------------------------------------------- +!< *** Iron chemistry *** +!< ********************** +! select the method to calculate freeFe + if (fe_2ligands) then + if (fe_compl_nica) then + logK1 = max(tiny, 24.36 - 1.67 * pH_watercolumn(k) & + + EOC * (-2.e-4 * EOC + 0.034)) + logK2 = logK1 + 2.67 + Klig1 = 10 ** (logK1 - 9) + Klig2 = 10 ** (logK2 - 9) + freeFe = iron_chemistry_2ligands(Fe,1.7,0.6,Klig1,Klig2) + endif + else + freeFe = iron_chemistry(Fe,totalligand,ligandStabConst) + endif + +!------------------------------------------------------------------------------- +!< *** Chlorophyll synthesis *** +!< ***************************** + +!< Coupled to N uptake +!< Converted to chlorophyll units with a maximum Chl:N ratio, Chl2N_max +!< Chl2N_max: Maximum Chl:N ratio for phytoplankton [mg Chl mmol N−1 ] + + chlSynth = zero + if (PARave .ge. tiny .AND. PARave .eq. PARave) then + chlSynth = N_assim * Chl2N_max & + * min(real(one),Cphot/(alfa * Chl2C * PARave)) + end if + ChlSynth_dia = zero + if (PARave .ge. tiny .AND. PARave .eq. PARave) then + ChlSynth_dia = N_assim_dia * Chl2N_max_d & + * min(real(one),Cphot_dia /(alfa_d * Chl2C_dia * PARave)) + end if + ChlSynth_cocco = zero +#if defined (__coccos) + if (PARave .ge. tiny .AND. PARave .eq. PARave) then + ChlSynth_cocco = N_assim_cocco * Chl2N_max_c & + * min(real(one),Cphot_cocco /(alfa_c * Chl2C_cocco * PARave)) + end if +#endif +!------------------------------------------------------------------------------- +!< *** Phytoplankton respiraion rate *** +!< ************************************* + +!< res_phy: Maintenance respiration rate constant [day−1 ] +!< biosynth: The cost of biosynthesis of N [mmol C mmol N−1 ] + + phyRespRate = res_phy * limitFacN + biosynth * N_assim + phyRespRate_dia = res_phy_d * limitFacN_dia + biosynth * N_assim_dia + biosynthSi * Si_assim +#if defined (__coccos) + phyRespRate_cocco = res_phy_c * limitFacN_cocco + biosynth * N_assim_cocco +#endif + +!------------------------------------------------------------------------------- +! Mesozooplankton +!------------------------------------------------------------------------------- +!< Grazing on small phytoplankton, diatoms, coccolithophore (optional), +!< microzooplankton (optional), slow- and fast-sinking detritus + +!< *** Food availability *** +!< ************************* +!< pzPhy: Maximum nanophytoplankton preference +!< pzDia: Maximum diatom preference +!< pzCocco: Maximum coccolithophore preference +!< pzDet: Maximum slow-sinking detritus prefence by first zooplankton +!< pzDetZ2: Maximum fast-sinking detritus preference by first zooplankton +!< pzMicZoo: Maximum microzooplankton preference by first zooplankton + + if (REcoM_Grazing_Variable_Preference) then ! CHECK ONUR + aux = pzPhy*PhyN + pzDia*DiaN + if (Grazing_detritus) aux = aux + PzDet*DetN +#if defined (__3Zoo2Det) + if (Grazing_detritus) aux = aux + pzDetZ2*DetZ2N ! 2Det + aux = aux + pzMicZoo*MicZooN ! 3Zoo +#endif +#if defined (__coccos) + aux = aux + pzCocco*CoccoN +#endif +! ****************************************************************************** + varpzPhy = (pzPhy*PhyN)/aux + varpzDia = (pzDia*DiaN)/aux + if (Grazing_detritus) varpzDet = (pzDet*DetN)/aux +#if defined (__3Zoo2Det) + if (Grazing_detritus) varpzDetZ2 = (pzDetZ2*DetZ2N)/aux ! 2Det + varpzMicZoo = (pzMicZoo*MicZooN)/aux ! 3Zoo +#endif +#if defined (__coccos) + varpzCocco = (pzCocco*CoccoN)/aux +#endif +! ****************************************************************************** + fDiaN = varpzDia * DiaN + fPhyN = varpzPhy * PhyN + if (Grazing_detritus) fDetN = varpzDet * DetN +#if defined (__3Zoo2Det) + if (Grazing_detritus) fDetZ2N = varpzDetZ2 * DetZ2N ! 2Det + fMicZooN = varpzMicZoo * MicZooN ! 3Zoo +#endif +#if defined (__coccos) + fCoccoN = varpzCocco * CoccoN +#endif + else ! REcoM_Grazing_Variable_Preference = .false. + fPhyN = pzPhy * PhyN + fDiaN = pzDia * DiaN + if (Grazing_detritus) fDetN = pzDet * DetN +#if defined (__3Zoo2Det) + if (Grazing_detritus) fDetZ2N = pzDetZ2 * DetZ2N ! 2Det + fMicZooN = pzMicZoo * MicZooN ! 3Zoo +#endif +#if defined (__coccos) + fCoccoN = pzCocco * CoccoN +#endif + end if ! REcoM_Grazing_Variable_Preference + +!< *** Grazing fluxes *** +!< ********************** + food = fPhyN + fDiaN + if (Grazing_detritus) food = food + fDetN +#if defined (__3Zoo2Det) + if (Grazing_detritus) food = food + fDetZ2N + food = food + fMicZooN ! 3Zoo +#endif +#if defined (__coccos) + food = food + fCoccoN +#endif +! ****************************************************************************** + foodsq = food**2 + grazingFlux = (Graz_max * foodsq)/(epsilonr + foodsq) * HetN * arrFunc +#if defined (__3Zoo2Det) + grazingFlux = (Graz_max * foodsq)/(epsilonr + foodsq) * HetN * q10_mes +#endif + grazingFlux_phy = grazingFlux * fphyN / food + grazingFlux_Dia = grazingFlux * fDiaN / food + if (Grazing_detritus) grazingFlux_Det = grazingFlux * fDetN / food +#if defined (__3Zoo2Det) + if (Grazing_detritus) grazingFlux_DetZ2 = grazingFlux * fDetZ2N / food + grazingFlux_miczoo = grazingFlux * fMicZooN / food ! 3Zoo +#endif +#if defined (__coccos) + grazingFlux_Cocco = grazingFlux * fCoccoN / food +#endif + +!< *** Grazing efficiency *** +!< ************************** + grazEff = gfin + 1/(0.2*food + 2) + + grazingFluxcarbon_mes = (grazingFlux_phy * recipQuota * grazEff) & + + (grazingFlux_Dia * recipQuota_Dia * grazEff) + + if (Grazing_detritus) grazingFluxcarbon_mes = grazingFluxcarbon_mes & + + (grazingFlux_Det * recipDet * grazEff) +#if defined (__3Zoo2Det) + if (Grazing_detritus) grazingFluxcarbon_mes = grazingFluxcarbon_mes & + + (grazingFlux_DetZ2 * recipDet2 * grazEff) + grazingFluxcarbon_mes = grazingFluxcarbon_mes & + + (grazingFlux_miczoo * recipQZoo3 * grazEff) ! 3Zoo +#endif +#if defined (__coccos) + grazingFluxcarbon_mes = grazingFluxcarbon_mes & + + (grazingFlux_Cocco * recipQuota_Cocco * grazEff) +#endif + +!------------------------------------------------------------------------------- +! Second Zooplankton +!------------------------------------------------------------------------------- +!< Grazing on small phytoplankton, diatoms, coccolithophore (optional), +!< heterotrophs, slow- and fast-sinking detritus + +!< *** Food availability *** +!< ************************* +!< pzPhy2: Maximum nanophytoplankton preference +!< pzDia2: Maximum diatom preference +!< pzCocco2: Maximum coccolithophore preference +!< pzDet2: Maximum slow-sinking detritus prefence +!< pzDetZ22: Maximum fast-sinking detritus preference +!< pzHet: Maximum mesozooplankton preference +!< pzMicZoo2: Maximum microzooplankton preference + +#if defined (__3Zoo2Det) + if (REcoM_Grazing_Variable_Preference) then + aux = pzPhy2 * PhyN + PzDia2 * DiaN + pzHet * HetN + if (Grazing_detritus) aux = aux + pzDet2 * DetN + pzDetZ22 * DetZ2N + aux = aux + pzMicZoo2 * MicZooN ! 3Zoo +#if defined (__coccos) + aux = aux + pzCocco2 * CoccoN +#endif +! ****************************************************************************** + varpzPhy2 = (pzPhy2 * PhyN)/aux + varpzDia2 = (pzDia2 * DiaN)/aux + varpzMicZoo2 = (pzMicZoo2 * MicZooN)/aux ! 3Zoo + +#if defined (__coccos) + varpzCocco2 = (pzCocco2 * CoccoN)/aux +#endif + varpzHet = (pzHet * HetN)/aux + if (Grazing_detritus) then + varpzDet2 = (pzDet2 * DetN)/aux + varpzDetZ22 = (pzDetZ22 * DetZ2N)/aux + end if +! ****************************************************************************** + fDiaN2 = varpzDia2 * DiaN + fPhyN2 = varpzPhy2 * PhyN + fMicZooN2 = varpzMicZoo2 * MicZooN ! 3Zoo +#if defined (__coccos) + fCoccoN2 = varpzCocco2 * CoccoN +#endif + fHetN = varpzHet * HetN + if (Grazing_detritus) then + fDetN2 = varpzDet2 * DetN + fDetZ2N2 = varpzDetZ22 * DetZ2N + end if + else ! REcoM_Grazing_Variable_Preference = .false. + + fDiaN2 = pzDia2 * DiaN + fPhyN2 = pzPhy2 * PhyN + fMicZooN2 = pzMicZoo2 * MicZooN ! 3Zoo +#if defined (__coccos) + fCoccoN2 = pzCocco2 * CoccoN +#endif + fHetN = pzHet * HetN + if (Grazing_detritus) then + fDetN2 = pzDet2 * DetN + fDetZ2N2 = pzDetZ22 * DetZ2N + end if + end if ! REcoM_Grazing_Variable_Preference + +!< *** Grazing fluxes *** +!< ********************** + food2 = fPhyN2 + fDiaN2 + fHetN + if (Grazing_detritus) food2 = food2 + fDetN2 + fDetZ2N2 + food2 = food2 + fMicZooN2 ! 3Zoo +#if defined (__coccos) + food2 = food2 + fCoccoN2 +#endif +! ****************************************************************************** + foodsq2 = food2**2 + grazingFlux2 = (Graz_max2 * foodsq2)/(epsilon2 + foodsq2) * Zoo2N * arrFuncZoo2 + + grazingFlux_phy2 = (grazingFlux2 * fphyN2)/food2 + grazingFlux_Dia2 = (grazingFlux2 * fDiaN2)/food2 + grazingFlux_miczoo2 = (grazingFlux2 * fMicZooN2)/food2 ! 3Zoo + +#if defined (__coccos) + grazingFlux_Cocco2 = (grazingFlux2 * fCoccoN2)/food2 +#endif + grazingFlux_het2 = (grazingFlux2 * fHetN)/food2 + if (Grazing_detritus) then + grazingFlux_Det2 = (grazingFlux2 * fDetN2)/food2 + grazingFlux_DetZ22 = (grazingFlux2 * fDetZ2N2)/food2 + end if + + grazingFluxcarbonzoo2 = (grazingFlux_phy2 * recipQuota * grazEff2) & + + (grazingFlux_Dia2 * recipQuota_Dia * grazEff2) & + + (grazingFlux_het2 * recipQZoo * grazEff2) + if (Grazing_detritus) then + grazingFluxcarbonzoo2 = grazingFluxcarbonzoo2 + & + + (grazingFlux_Det2 * recipDet * grazEff2) & + + (grazingFlux_DetZ22 * recipDet2 * grazEff2) + end if + grazingFluxcarbonzoo2 = grazingFluxcarbonzoo2 + & + + (grazingFlux_miczoo2 * recipQZoo3 * grazEff2) ! 3Zoo +#if defined (__coccos) + grazingFluxcarbonzoo2 = grazingFluxcarbonzoo2 + & + + (grazingFlux_Cocco2 * recipQuota_Cocco * grazEff2) +#endif + +!------------------------------------------------------------------------------- +! Third Zooplankton (Microzooplankton) +!------------------------------------------------------------------------------- +!< Grazing on small phytoplankton, diatoms and coccolithophore (optional) + +!< *** Food availability *** +!< ************************* +!< pzPhy3: Maximum nanophytoplankton preference +!< pzDia3: Maximum diatom preference +!< pzCocco3: Maximum coccolithophore preference + + if (REcoM_Grazing_Variable_Preference) then + aux = pzPhy3 * PhyN + pzDia3 * DiaN +#if defined (__coccos) + aux = aux + pzCocco3 * CoccoN +#endif +! ****************************************************************************** + varpzPhy3 = (pzPhy3 * PhyN)/aux + varpzDia3 = (pzDia3 * DiaN)/aux +#if defined (__coccos) + varpzCocco3 = (pzCocco3 * CoccoN)/aux +#endif +! ****************************************************************************** + fPhyN3 = varpzPhy3 * PhyN + fDiaN3 = varpzDia3 * DiaN +#if defined (__coccos) + fCoccoN3 = varpzCocco3 * CoccoN +#endif + else ! REcoM_Grazing_Variable_Preference = .false. + + fPhyN3 = pzPhy3 * PhyN + fDiaN3 = pzDia3 * DiaN +#if defined (__coccos) + fCoccoN3 = pzCocco3 * CoccoN +#endif + endif !REcoM_Grazing_Variable_Preference + +!< *** Grazing fluxes *** +!< ********************** + food3 = fPhyN3 + fDiaN3 +#if defined (__coccos) + food3 = food3 + fCoccoN3 +#endif +! ****************************************************************************** + foodsq3 = food3**2 + grazingFlux3 = (Graz_max3 * foodsq3)/(epsilon3 + foodsq3) * MicZooN * q10_mic + grazingFlux_phy3 = (grazingFlux3 * fphyN3)/food3 + grazingFlux_Dia3 = (grazingFlux3 * fDiaN3)/food3 +#if defined (__coccos) + grazingFlux_Cocco3 = (grazingFlux3 * fCoccoN3)/food3 +#endif +#endif + +!------------------------------------------------------------------------------- +!< Heterotrophic respiration is assumed to drive zooplankton back to +!< Redfield C:N if their C:N becomes higher than Redfield +!< res_het: Timescale for zooplankton respiration [day−1 ] + + if (het_resp_noredfield) then +#if defined (__3Zoo2Det) + HetRespFlux = res_het * q10_mes_res * HetC ! 3Zoo +#else + HetRespFlux = res_het * arrFunc * HetC ! tau * f_T [HetC] +#endif + else + HetRespFlux = recip_res_het * arrFunc * (hetC * recip_hetN_plus - redfield) * HetC + HetRespFlux = max(zero, HetRespFlux) !!!!!!!! CHECK Judith Valid for het_resp_noredfield case as well ???????? Then move it below + endif + + if (ciso) then +!MB set HetRespFlux_plus = .true. in namelist.recom +! HetRespFlux_13 = max(zero, recip_res_het * arrFunc * (hetC_13 * recip_hetN_plus - redfield) * HetC_13) +! Numerically safer parametrization avoiding instable results which may result from different cutoff values -- CHECK + HetRespFlux_13 = HetRespFlux * HetC_13 / HetC +!! HetRespFlux_13 = HetRespFlux * (HetC_13 / HetC) **2 + if (ciso_14 .and. ciso_organic_14) then +! HetRespFlux_14 = max(zero, recip_res_het * arrFunc * (hetC_14 * recip_hetN_plus - redfield) * HetC_14) + HetRespFlux_14 = HetRespFlux * HetC_14 / HetC +!! HetRespFlux_14 = HetRespFlux * (HetC_14 / HetC) **2 + end if + end if + +!------------------------------------------------------------------------------- +!< Zooplanton mortality (Quadratic) + + hetLossFlux = loss_het * HetN * HetN + +#if defined (__3Zoo2Det) +!------------------------------------------------------------------------------- +!< Second zooplankton respiration + + call krill_resp(n, partit, mesh) + + if((grazingFluxcarbonzoo2/Zoo2C) <= 0.1)then + res_zoo2_f = 0.1*(grazingFluxcarbonzoo2/Zoo2C*100) + else + res_zoo2_f = 1. + end if + recip_res_zoo22 = res_zoo2*(1.+ res_zoo2_f + res_zoo2_a) + Zoo2RespFlux = recip_res_zoo22 * Zoo2C +!------------------------------------------------------------------------------- +!< Second zooplankton mortality (Quadratic) + + Zoo2LossFlux = loss_zoo2 * zoo2N * zoo2N + +!------------------------------------------------------------------------------- +!< Second zooplankton fecal pellets + + Zoo2fecalloss_n = fecal_rate_n * grazingFlux2 + Zoo2fecalloss_c = fecal_rate_c * grazingFluxcarbonzoo2 + +!------------------------------------------------------------------------------- +!< Mesozooplankton fecal pellets + + mesfecalloss_n = fecal_rate_n_mes * grazingFlux + mesfecalloss_c = fecal_rate_c_mes * grazingFluxcarbon_mes + +!------------------------------------------------------------------------------- +! Third zooplankton, microzooplankton, respiration ! 3Zoo + + MicZooRespFlux = res_miczoo * q10_mic_res * MicZooC +!------------------------------------------------------------------------------- +! Third zooplankton, microzooplankton, mortality (Quadratic) ! 3Zoo + + MicZooLossFlux = loss_miczoo * MicZooN * MicZooN +#endif + +!------------------------------------------------------------------------------- +! Phytoplankton and detritus aggregation +!------------------------------------------------------------------------------- + if (diatom_mucus) then + qlimitFac = recom_limiter(NMinSlope, NCmin_d, quota_dia) + qlimitFacTmp = recom_limiter(SiMinSlope, SiCmin, qSiC) + qlimitFac = min(qLimitFac, qlimitFacTmp) + feLimitFac= Fe/(k_Fe_d + Fe) + qlimitFac = min(qlimitFac, feLimitFac) + aggregationrate = agg_PP * (1 - qlimitFac) * DiaN + else + aggregationrate = agg_PP * DiaN + endif + + aggregationrate = aggregationrate + agg_PD * DetN + agg_PP * PhyN + +#if defined (__3Zoo2Det) + aggregationrate = aggregationrate + agg_PD * DetZ2N ! 2Det +#endif +#if defined (__coccos) + aggregationrate = aggregationrate + agg_PP * CoccoN +#endif + +!------------------------------------------------------------------------------- +! Calcification +!------------------------------------------------------------------------------- +! Terms required for the formation and dissolution of CaCO3 +! Without this, calcification is performed by a fraction of small phytoplankton + +#if defined (__coccos) + if (Temp(k) < 10.6) then ! (PICPOC definition after Krumhardt et al. 2017, 2019; Temp(k) because we need degC here) + PICPOCtemp = 0.104d0 * Temp(k) - 0.108d0 + else + PICPOCtemp = 1.0d0 + end if + PICPOCtemp = max(tiny,PICPOCtemp) + + PICPOCCO2 = a_co2_calc * HCO3_watercolumn(k) * Cunits / (b_co2_calc + HCO3_watercolumn(k) * Cunits) - exp(-c_co2_calc * CO2_watercolumn(k) * Cunits) - d_co2_calc * 10.**(-pH_watercolumn(k)) + PICPOCCO2 = min(PICPOCCO2,3.d0) ! April 2022: limitation to 3 + PICPOCCO2 = max(0.d0,PICPOCCO2) ! July 2022: limitation to zero + + PICPOCN = -0.31 * (DIN/(DIN + k_din_c)) + 1.31 + PICPOCN = max(tiny,PICPOCN) + + calcification = 1.d0 * Cphot_cocco * CoccoC * PICPOCtemp * PICPOCN + if (CO2lim) calcification = calcification * PICPOCCO2 + +#else +!< calc_prod_ratio: Calcite production ratio, dimensionless + calcification = calc_prod_ratio * Cphot * PhyC ! Z in equations +#endif + + calc_loss_agg = aggregationrate * PhyCalc + +#if defined (__coccos) +!< *** Coccolithophores *** +!< ************************ + aux = recipQuota_Cocco/(CoccoC + tiny) * PhyCalc + calc_loss_gra = grazingFlux_Cocco * aux +#if defined (__3Zoo2Det) + calc_loss_gra2 = grazingFlux_Cocco2 * aux + calc_loss_gra3 = grazingFlux_Cocco3 * aux ! 3Zoo +#endif + +#else +!< *** Small phytoplankton *** +!< *************************** + aux = recipQuota/(PhyC + tiny) * PhyCalc + calc_loss_gra = grazingFlux_phy * aux +#if defined (__3Zoo2Det) + calc_loss_gra2 = grazingFlux_phy2 * aux + calc_loss_gra3 = grazingFlux_phy3 * aux ! 3Zoo +#endif +#endif + + if (ciso) then + calcification_13 = calc_prod_ratio * Cphot * PhyC_13 * alpha_calc_13 + calcification_13 = calcification * alpha_calc_13 + calc_loss_agg_13 = aggregationRate * PhyCalc_13 + calc_loss_gra_13 = grazingFlux_phy * recipQuota_13/(PhyC_13 + tiny) * PhyCalc_13 + if (ciso_14 .and. ciso_organic_14) then + calcification_14 = calc_prod_ratio * Cphot * PhyC_14 * alpha_calc_14 + calc_loss_agg_14 = aggregationRate * PhyCalc_14 + calc_loss_gra_14 = grazingFlux_phy * recipQuota_14/(PhyC_14 + tiny) * PhyCalc_14 + end if + end if + +!------------------------------------------------------------------------------- +! Sources minus sinks (SMS) +!------------------------------------------------------------------------------- + +!< *** DIN *** +!< *********** + +!< N_assim: N assimilation rate for nanophytoplankton [mmolN mmolC-1 day-1] +!< PhyC: Intracellular carbon concentration in nanophytoplankton [mmolC m-3] +!< N_assim_Dia: N assimilation rate for diatoms [mmolN mmolC-1 day-1] +!< DiaC: Intracellular carbon concentration in diatoms [mmolC m-3] +!< N_assim_Cocco: N assimilation rate for coccolithophore [mmolN mmolC-1 day-1] +!< CoccoC: Intracellular carbon concentration in coccolithophore [mmolC m-3] +!< rho_N*arrFunc: Remineralization rate and temperature dependency which is calculated with arrFunc [day^-1] +!< O2Func: O2 dependency of organic matter remineralization +!< DON: Extracellular dissolved organic nitrogen [mmolN m-3] +!< dt_b: REcoM time step [day] + +!! Schourup 2013 Eq. A2 + + sms(k,idin) = ( & + - N_assim * PhyC & ! --> N assimilation Nanophytoplankton, [mmol N/(mmol C * day)] C specific N utilization rate + - N_assim_Dia * DiaC & ! --> N assimilation Diatoms +#if defined (__coccos) + - N_assim_Cocco * CoccoC & ! --> N assimilation Coccolithophore +#endif + + rho_N * arrFunc * O2Func * DON & ! --> DON remineralization, temperature dependent [day^-1 * mmol/m3] ! O2remin + ) * dt_b + sms(k,idin) + +!< *** DIC *** +!< *********** + +!< rho_C1: Temperature dependent C degradation of extracellular organic C (EOC) [day^-1] + + sms(k,idic) = ( & + - Cphot * PhyC & ! --> Small pyhtoplankton photosynthesis + + phyRespRate * PhyC & ! --> Small pyhtoplankton respiration + - Cphot_Dia * DiaC & ! --> Diatom photosynthesis + + phyRespRate_Dia * DiaC & ! --> Diatom respiration +#if defined (__coccos) + - Cphot_Cocco * CoccoC & ! --> Coccolithophore photosynthesis + + phyRespRate_Cocco * CoccoC & ! --> Coccolithophore respiration +#endif + + rho_C1 * arrFunc * O2Func * EOC & ! --> Remineralization of DOC ! NEW O2remin + + HetRespFlux & ! --> Mesozooplankton respiration +#if defined (__3Zoo2Det) + + Zoo2RespFlux & ! --> Macrozooplankton respiration + + MicZooRespFlux & ! --> Microzooplankton respiration +#endif + + calc_diss * DetCalc & ! --> Calcite dissolution from slow-sinking detritus + + calc_loss_gra * calc_diss_guts & ! --> Additional dissolution in mesozooplankton guts +#if defined (__3Zoo2Det) + + calc_loss_gra2 * calc_diss_guts & ! --> Additional dissolution in macrozooplankton guts + + calc_loss_gra3 * calc_diss_guts & ! --> Additional dissolution in microzooplankton guts + + calc_diss2 * DetZ2Calc & ! --> Calcite dissolution from fast-sinking detritus +#endif + - calcification & ! --> Calcification + ) * dt_b + sms(k,idic) + +! if((Latd(1)<-45.0) .and. ((state(k,idic)+sms(k,idic))>2500)) then +! !co2flux(1)=0.0 +! print*,'ERROR: strange dic !' +! print*,'state(k,idic): ', state(k,idic) +! print*,'sms Cphot: ', -Cphot*PhyC +! print*,'sms resp: ', phyRespRate*PhyC +! print*,'sms Cphot dia: ', -Cphot_Dia*DiaC +! print*,'sms resp dia: ', phyRespRate_Dia * DiaC +! print*,'sms eoc: ', rho_C1* arrFunc *EOC +! print*,'sms het resp: ', HetRespFlux +! print*, 'sms co2: ', dflux(1) * recipdzF(k) * max( 2-k, 0 ) +! print*, 'sms calcdiss: ', calc_diss * DetCalc +! print*, 'sms calc_loss: ', calc_loss_gra * calc_diss_guts +! print*, 'sms calcification: ', -calcification +! stop +! endif + +!< *** Alk *** +!< *********** + +!< Alkalinity (Assumes that N:P follows a constant Redfield ratio +!< N_assimC: 1.0625 = 1/16 + 1 + + sms(k,ialk) = ( & + + 1.0625 * N_assim * PhyC & + + 1.0625 * N_assim_Dia * DiaC & +#if defined (__coccos) + + 1.0625 * N_assim_Cocco * CoccoC & +#endif + - 1.0625 * rho_N * arrFunc * O2Func * DON & ! O2remin + + 2.d0 * calc_diss * DetCalc & + + 2.d0 * calc_loss_gra * calc_diss_guts & +#if defined (__3Zoo2Det) + + 2.d0 * calc_loss_gra2 * calc_diss_guts & + + 2.d0 * calc_loss_gra3 * calc_diss_guts & ! 3Zoo + + 2.d0 * calc_diss2 * DetZ2Calc & +#endif + - 2.d0 * calcification & + ) * dt_b + sms(k,ialk) +!< *** Small Phytoplankton *** +!< *************************** + +!____________________________________________________________ +!< Small phytoplankton N + +!< lossN: Phytoplankton loss of organic N compounds [day^-1] + + sms(k,iphyn) = ( & + + N_assim * PhyC & ! --> N assimilation + - lossN * limitFacN * PhyN & ! --> DON excretion + - aggregationRate * PhyN & ! --> Aggregation loss + - grazingFlux_phy & ! --> Grazing loss +#if defined (__3Zoo2Det) + - grazingFlux_phy2 & + - grazingFlux_phy3 & ! 3Zoo +#endif + ) * dt_b + sms(k,iphyn) +!____________________________________________________________ +!< Small phytoplankton C + +!< lossC: Phytoplankton loss of carbon [day^-1] +!< When N : C ratio becomes too high, excretion of DOC is downregulated +!< by the limiter function limitFacN +!< aggregationRate transfers C to the detritus pool + + sms(k,iphyc) = ( & + + Cphot * PhyC & ! --> Photosynthesis ---->/ + - lossC * limitFacN * PhyC & ! --> Excretion of DOC / Net photosynthesis + - phyRespRate * PhyC & ! --> Respiration ----->/ + - aggregationRate * PhyC & ! --> Aggregation loss + - grazingFlux_phy * recipQuota & ! --> Grazing loss +#if defined (__3Zoo2Det) + - grazingFlux_phy2 * recipQuota & + - grazingFlux_phy3 * recipQuota & ! 3Zoo +#endif + ) * dt_b + sms(k,iphyc) +!____________________________________________________________ +! Phytoplankton ChlA + +!< Chl2N: Conversion factor from mmolN to mgChla +!< Chl2N = PhyChl/PhyN + + sms(k,ipchl) = ( & + + chlSynth * PhyC & ! --> Chl-a synthesis + - KOchl * PhyChl & ! --> Degradation loss + - aggregationRate * PhyChl & ! --> Aggregation loss + - grazingFlux_phy * Chl2N & ! --> Grazing loss +#if defined (__3Zoo2Det) + - grazingFlux_phy2 * Chl2N & + - grazingFlux_phy3 * Chl2N & ! 3Zoo +#endif + ) * dt_b + sms(k,ipchl) + +!< *** Slow-sinking Detritus *** +!< ***************************** + +!____________________________________________________________ +! Detritus N + if (Grazing_detritus) then +#if defined (__3Zoo2Det) + sms(k,idetn) = ( & + + grazingFlux_phy3 & ! --> grazing on small phytoplankton by third zooplankton + - grazingFlux_phy3 * grazEff3 & ! --> fraction of grazingFlux_phy3 into microzooplankton pool + + grazingFlux_dia3 & ! --> grazing on diatoms by third zooplankton + - grazingFlux_dia3 * grazEff3 & ! --> fraction of grazingFlux_dia3 into microzooplankton pool +#if defined (__coccos) + + grazingFlux_Cocco3 & ! --> grazing on coccolithophores by third zooplankton + - grazingFlux_Cocco3 * grazEff3 & ! --> fraction of grazingFlux_Cocco3 into microzooplankton pool + + aggregationRate * CoccoN & +#endif + - grazingFlux_Det * grazEff & ! --> grazing of first zoo (meso) on first detritus class + - grazingFlux_Det2 * grazEff2 & ! --> grazing of second zoo (macro) on first detritus class + + aggregationRate * PhyN & + + aggregationRate * DiaN & + + miczooLossFlux & ! --> microzooplankton, mortality + - reminN * arrFunc * O2Func * DetN & ! --> O2remin + ) * dt_b + sms(k,idetn) +#else + sms(k,idetn) = ( & + + grazingFlux_phy & ! Technically it is mesooooooooooooooooo + - grazingFlux_phy * grazEff & + + grazingFlux_dia & + - grazingFlux_dia * grazEff & +#if defined (__coccos) + + grazingFlux_Cocco & + - grazingFlux_Cocco * grazEff & + + aggregationRate * CoccoN & +#endif + - grazingFlux_Det * grazEff & ! Sloppy feeding is thought because of grazing flux multiplied with grazeff + - grazingFlux_Det2 * grazEff2 & !!!!!!!!!!CHECK + + aggregationRate * PhyN & + + aggregationRate * DiaN & + + hetLossFlux & + - reminN * arrFunc * O2Func * DetN & ! O2remin + ) * dt_b + sms(k,idetn) +#endif + else +#if defined (__3Zoo2Det) + sms(k,idetn) = ( & + + grazingFlux_phy3 & + + grazingFlux_dia3 & +#if defined (__coccos) + + grazingFlux_Cocco3 & + + aggregationRate * CoccoN & +#endif + - grazingFlux * grazEff3 & + + aggregationRate * PhyN & + + aggregationRate * DiaN & + + miczooLossFlux & + - reminN * arrFunc * O2Func * DetN & ! O2remin + ) * dt_b + sms(k,idetn) +#else + sms(k,idetn) = ( & + + grazingFlux_phy & + + grazingFlux_dia & +#if defined (__coccos) + + grazingFlux_Cocco & + + aggregationRate * CoccoN & +#endif + - grazingFlux * grazEff & + + aggregationRate * PhyN & + + aggregationRate * DiaN & + + hetLossFlux & + - reminN * arrFunc * O2Func * DetN & ! O2remin + ) * dt_b + sms(k,idetn) +#endif + end if + +!____________________________________________________________ +! Detritus C + if (Grazing_detritus) then +#if defined (__3Zoo2Det) + sms(k,idetc) = ( & + + grazingFlux_phy3 * recipQuota & + - grazingFlux_phy3 * recipQuota * grazEff3 & + + grazingFlux_Dia3 * recipQuota_Dia & + - grazingFlux_Dia3 * recipQuota_Dia * grazEff3 & +#if defined (__coccos) + + grazingFlux_Cocco3 * recipQuota_Cocco & + - grazingFlux_Cocco3 * recipQuota_Cocco * grazEff3 & + + aggregationRate * CoccoC & +#endif + - grazingFlux_Det * recipDet * grazEff & + - grazingFlux_Det2 * recipDet * grazEff2 & ! corrected recipDet2 -> recipDet + + aggregationRate * PhyC & + + aggregationRate * DiaC & + + miczooLossFlux * recipQZoo3 & + - reminC * arrFunc * O2Func * DetC & ! O2remin + ) * dt_b + sms(k,idetc) +#else + sms(k,idetc) = ( & + + grazingFlux_phy * recipQuota & + - grazingFlux_phy * recipQuota * grazEff & + + grazingFlux_Dia * recipQuota_Dia & + - grazingFlux_Dia * recipQuota_Dia * grazEff & +#if defined (__coccos) + + grazingFlux_Cocco * recipQuota_Cocco & + - grazingFlux_Cocco * recipQuota_Cocco * grazEff & + + aggregationRate * CoccoC & +#endif + - grazingFlux_Det * recipDet * grazEff & + ! - grazingFlux_Det2 * recipDet2 * grazEff & !!!!!! CHECK + + aggregationRate * phyC & + + aggregationRate * DiaC & + + hetLossFlux * recipQZoo & + - reminC * arrFunc * O2Func * DetC & ! O2remin + ) * dt_b + sms(k,idetc) +#endif + else +#if defined (__3Zoo2Det) + sms(k,idetc) = ( & + + grazingFlux_phy3 * recipQuota & + - grazingFlux_phy3 * recipQuota * grazEff3 & + + grazingFlux_Dia3 * recipQuota_Dia & + - grazingFlux_Dia3 * recipQuota_Dia * grazEff3 & +#if defined (__coccos) + + grazingFlux_Cocco3 * recipQuota_Cocco & + - grazingFlux_Cocco3 * recipQuota_Cocco * grazEff3 & + + aggregationRate * CoccoC & +#endif + + aggregationRate * PhyC & + + aggregationRate * DiaC & + + miczooLossFlux * recipQZoo3 & + - reminC * arrFunc * O2Func * DetC & ! O2remin + ) * dt_b + sms(k,idetc) +#else + sms(k,idetc) = ( & + + grazingFlux_phy * recipQuota & + - grazingFlux_phy * recipQuota * grazEff & + + grazingFlux_Dia * recipQuota_Dia & + - grazingFlux_Dia * recipQuota_Dia * grazEff & +#if defined (__coccos) + + grazingFlux_Cocco * recipQuota_Cocco & + - grazingFlux_Cocco * recipQuota_Cocco * grazEff & + + aggregationRate * CoccoC & +#endif + + aggregationRate * phyC & + + aggregationRate * DiaC & + + hetLossFlux * recipQZoo & + - reminC * arrFunc * O2Func * DetC & ! O2remin + ) * dt_b + sms(k,idetc) +#endif + end if + +!< *** Mesozooplankton *** +!< *********************** + +!____________________________________________________________ +!< Heterotrophic N + sms(k,ihetn) = ( & + + grazingFlux * grazEff & ! --> Grazing on phytoplankton -> okay, because of recipQuota +#if defined (__3Zoo2Det) + - grazingFlux_het2 & + - Mesfecalloss_n & ! 3Zoo +#endif + - hetLossFlux & ! --> Mortality + - lossN_z * HetN & ! --> Excretion of DON + ) * dt_b + sms(k,ihetn) +!____________________________________________________________ +!< Heterotrophic C + if (Grazing_detritus) then + sms(k,ihetc) = ( & + + grazingFlux_phy * recipQuota * grazEff & ! --> Grazing on small phytoplankton + + grazingFlux_Dia * recipQuota_Dia * grazEff & ! --> Grazing on diatom +#if defined (__coccos) + + grazingFlux_Cocco * recipQuota_Cocco * grazEff & +#endif +#if defined (__3Zoo2Det) + + grazingFlux_miczoo * recipQZoo3 * grazEff & ! 3Zoo + + grazingFlux_DetZ2 * recipDet2 * grazEff & + - grazingFlux_het2 * recipQZoo & + - Mesfecalloss_c & ! 3Zoo +#endif + + grazingFlux_Det * recipDet * grazEff & ! --> Grazing on detritus + - hetLossFlux * recipQZoo & ! --> Mortality loss + - lossC_z * HetC & ! --> Excretion loss + - hetRespFlux & ! --> REspiration loss + ) * dt_b + sms(k,ihetc) + else + sms(k,ihetc) = ( & + + grazingFlux_phy * recipQuota * grazEff & + + grazingFlux_Dia * recipQuota_Dia * grazEff & +#if defined (__coccos) + + grazingFlux_Cocco * recipQuota_Cocco * grazEff & +#endif +#if defined (__3Zoo2Det) + + grazingFlux_miczoo * recipQZoo3 * grazEff & ! 3Zoo + - grazingFlux_het2 * recipQZoo & + - Mesfecalloss_c & ! 3Zoo +#endif + - hetLossFlux * recipQZoo & + - lossC_z * HetC & + - hetRespFlux & + ) * dt_b + sms(k,ihetc) + endif + +!< *** Macrozooplankton *** +!< ************************ + +#if defined (__3Zoo2Det) +!____________________________________________________________ +!< Second Zooplankton N + sms(k,izoo2n) = ( & + + grazingFlux2 * grazEff2 & + - Zoo2LossFlux & + - lossN_z2 * Zoo2N & + - Zoo2fecalloss_n & + ) * dt_b + sms(k,izoo2n) + +!____________________________________________________________ +!< Second Zooplankton C + if (Grazing_detritus) then + + sms(k,izoo2c) = ( & + + grazingFlux_phy2 * recipQuota * grazEff2 & + + grazingFlux_Dia2 * recipQuota_Dia * grazEff2 & +#if defined (__coccos) + + grazingFlux_Cocco2 * recipQuota_Cocco * grazEff2 & +#endif + + grazingFlux_het2 * recipQZoo * grazEff2 & + + grazingFlux_miczoo2* recipQZoo3 * grazEff2 & ! 3Zoo + + grazingFlux_Det2 * recipDet * grazEff2 & + + grazingFlux_DetZ22 * recipDet2 * grazEff2 & + - zoo2LossFlux * recipQZoo2 & + - lossC_z2 * Zoo2C & + - Zoo2RespFlux & + - Zoo2fecalloss_c & + ) * dt_b + sms(k,izoo2c) + else + sms(k,izoo2c) = ( & + + grazingFlux_phy2 * recipQuota * grazEff2 & + + grazingFlux_Dia2 * recipQuota_Dia * grazEff2 & +#if defined (__coccos) + + grazingFlux_Cocco2 * recipQuota_Cocco * grazEff2 & +#endif + + grazingFlux_het2 * recipQZoo * grazEff2 & + + grazingFlux_miczoo2* recipQZoo3 * grazEff2 & ! 3Zoo + - zoo2LossFlux * recipQZoo2 & + - lossC_z2 * Zoo2C & + - Zoo2RespFlux & + - Zoo2fecalloss_c & + ) * dt_b + sms(k,izoo2c) + end if + +!< *** Microzooplankton *** +!< ************************ + +!____________________________________________________________ +!< Third Zooplankton N + sms(k,imiczoon) = ( & + + grazingFlux3 * grazEff3 & + - grazingFlux_miczoo & + - grazingFlux_miczoo2 & + - MicZooLossFlux & + - lossN_z3 * MicZooN & + ) * dt_b + sms(k,imiczoon) + +!____________________________________________________________ +!< Third Zooplankton C + sms(k,imiczooc) = ( & + + grazingFlux_phy3 * recipQuota * grazEff3 & + + grazingFlux_Dia3 * recipQuota_Dia * grazEff3 & +#if defined (__coccos) + + grazingFlux_Cocco3 * recipQuota_Cocco * grazEff3 & +#endif + - MicZooLossFlux * recipQZoo3 & + - grazingFlux_miczoo * recipQZoo3 & + - grazingFlux_miczoo2 * recipQZoo3 & + - lossC_z3 * MicZooC & + - MicZooRespFlux & + ) * dt_b + sms(k,imiczooc) + +!< *** Fast-sinking Detritus *** +!< ***************************** + +!____________________________________________________________ +!< Second Zooplankton Detritus N + if (Grazing_detritus) then + sms(k,idetz2n) = ( & + + grazingFlux_phy2 & + - grazingFlux_phy2 * grazEff2 & + + grazingFlux_dia2 & + - grazingFlux_dia2 * grazEff2 & +#if defined (__coccos) + + grazingFlux_Cocco & + - grazingFlux_Cocco * grazEff & + + grazingFlux_Cocco2 & + - grazingFlux_Cocco2 * grazEff2 & +#endif + + grazingFlux_het2 & + - grazingFlux_het2 * grazEff2 & + + grazingFlux_miczoo2 & + - grazingFlux_miczoo2 * grazEff2 & + + grazingFlux_phy & + - grazingFlux_phy * grazEff & + + grazingFlux_dia & + - grazingFlux_dia * grazEff & + + grazingFlux_miczoo & + - grazingFlux_miczoo * grazEff & + - grazingFlux_DetZ2 * grazEff & + - grazingFlux_DetZ22 * grazEff2 & + + Zoo2LossFlux & + + hetLossFlux & + + Zoo2fecalloss_n & + + Mesfecalloss_n & + - reminN * arrFunc * O2Func * DetZ2N & ! O2remin + ) * dt_b + sms(k,idetz2n) + else + sms(k,idetz2n) = ( & + + grazingFlux_phy2 & + + grazingFlux_dia2 & +#if defined (__coccos) + + grazingFlux_Cocco & + + grazingFlux_Cocco2 & +#endif + + grazingFlux_het2 & + + grazingFlux_miczoo2 & + - grazingFlux2 * grazEff2 & + + grazingFlux_phy & + + grazingFlux_dia & + + grazingFlux_miczoo & + - grazingFlux * grazEff & + + Zoo2LossFlux & + + hetLossFlux & + + Zoo2fecalloss_n & + + Mesfecalloss_n & + - reminN * arrFunc * O2Func * DetZ2N & ! O2remin + ) * dt_b + sms(k,idetz2n) + end if + +!____________________________________________________________ +!< Second Zooplankton Detritus C + if (Grazing_detritus) then + sms(k,idetz2c) = ( & + + grazingFlux_phy2 * recipQuota & + - grazingFlux_phy2 * recipQuota * grazEff2 & + + grazingFlux_Dia2 * recipQuota_Dia & + - grazingFlux_Dia2 * recipQuota_Dia * grazEff2 & +#if defined (__coccos) + + grazingFlux_Cocco * recipQuota_Cocco & + - grazingFlux_Cocco * recipQuota_Cocco * grazEff & + + grazingFlux_Cocco2 * recipQuota_Cocco & + - grazingFlux_Cocco2 * recipQuota_Cocco * grazEff2 & +#endif + + grazingFlux_het2 * recipQZoo & + - grazingFlux_het2 * recipQZoo * grazEff2 & + + grazingFlux_miczoo2 * recipQZoo3 & + - grazingFlux_miczoo2 * recipQZoo3 * grazEff2 & + + grazingFlux_phy * recipQuota & + - grazingFlux_phy * recipQuota * grazEff & + + grazingFlux_Dia * recipQuota_Dia & + - grazingFlux_Dia * recipQuota_Dia * grazEff & + + grazingFlux_miczoo * recipQZoo3 & + - grazingFlux_miczoo * recipQZoo3 * grazEff & + - grazingFlux_DetZ2 * recipDet2 * grazEff & + - grazingFlux_DetZ22 * recipDet2 * grazEff2 & + + Zoo2LossFlux * recipQZoo2 & + + hetLossFlux * recipQZoo & + + Zoo2fecalloss_c & + + Mesfecalloss_c & + - reminC * arrFunc * O2Func * DetZ2C & ! O2remin + ) * dt_b + sms(k,idetz2c) + else + sms(k,idetz2c) = ( & + + grazingFlux_phy2 * recipQuota & + - grazingFlux_phy2 * recipQuota * grazEff2 & + + grazingFlux_Dia2 * recipQuota_Dia & + - grazingFlux_Dia2 * recipQuota_Dia * grazEff2 & +#if defined (__coccos) + + grazingFlux_Cocco * recipQuota_Cocco & + - grazingFlux_Cocco * recipQuota_Cocco * grazEff & + + grazingFlux_Cocco2 * recipQuota_Cocco & + - grazingFlux_Cocco2 * recipQuota_Cocco * grazEff2 & +#endif + + grazingFlux_het2 * recipQZoo & + - grazingFlux_het2 * recipQZoo * grazEff2 & + + grazingFlux_miczoo2 * recipQZoo3 & + - grazingFlux_miczoo2 * recipQZoo3 * grazEff2 & + + grazingFlux_phy * recipQuota & + - grazingFlux_phy * recipQuota * grazEff & + + grazingFlux_Dia * recipQuota_Dia & + - grazingFlux_Dia * recipQuota_Dia * grazEff & + + grazingFlux_miczoo * recipQZoo3 & + - grazingFlux_miczoo * recipQZoo3 * grazEff & + + Zoo2LossFlux * recipQZoo2 & + + hetLossFlux * recipQZoo & + + Zoo2fecalloss_c & + + Mesfecalloss_c & + - reminC * arrFunc * O2Func * DetZ2C & ! O2remin + ) * dt_b + sms(k,idetz2c) + end if + +!____________________________________________________________ +!< Second Zooplankton Detritus Si + sms(k,idetz2si) = ( & + + grazingFlux_dia2 * qSiN & ! --> qSin convert N to Si + + grazingFlux_dia * qSiN & + - reminSiT * DetZ2Si & + ) * dt_b + sms(k,idetz2si) + +!____________________________________________________________ +!< Second Zooplankton Detritus calcite + sms(k,idetz2calc) = ( & + + calc_loss_gra2 & + - calc_loss_gra2 * calc_diss_guts & + + calc_loss_gra & + - calc_loss_gra * calc_diss_guts & + - calc_diss2 * DetZ2Calc & + ) * dt_b + sms(k,idetz2calc) +#endif + +!< *** DOM *** +!< *********** + +!____________________________________________________________ +!< DON (Extracellular organic N) + + sms(k,idon) = ( & + + lossN * limitFacN * phyN & + + lossN_d * limitFacN_Dia * DiaN & +#if defined (__coccos) + + lossN_c * limitFacN_Cocco * CoccoN & +#endif + + reminN * arrFunc * O2Func * DetN & + + lossN_z * HetN & +#if defined (__3Zoo2Det) + + reminN * arrFunc * O2Func * DetZ2N & + + lossN_z2 * Zoo2N & + + lossN_z3 * MicZooN & ! 3Zoo +#endif + - rho_N * arrFunc * O2Func * DON & ! O2remin + ) * dt_b + sms(k,idon) + +!____________________________________________________________ +!< EOC + + sms(k,idoc) = ( & + + lossC * limitFacN * phyC & + + lossC_d * limitFacN_dia * DiaC & +#if defined (__coccos) + + lossC_c * limitFacN_cocco * CoccoC & +#endif + + reminC * arrFunc * O2Func * DetC & + + lossC_z * HetC & +#if defined (__3Zoo2Det) + + reminC * arrFunc * O2Func * DetZ2C & + + lossC_z2 * Zoo2C & + + lossC_z3 * MicZooC & ! 3Zoo +#endif + - rho_c1 * arrFunc * O2Func * EOC & ! O2remin + ) * dt_b + sms(k,idoc) + +!< *** Diatoms *** +!< *************** + +!____________________________________________________________ +!< Diatom N + +!< lossN: Diatom loss of organic N compounds [day^-1] +!< When N : C ratio becomes too high, excretion of DON is downregulated +!< by the limiter function limitFacN_dia +!< aggregationRate transfers N to the detritus pool + + sms(k,idian) = ( & + + N_assim_dia * DiaC & ! --> N assimilation + - lossN_d * limitFacN_dia * DiaN & ! --> DON excretion + - aggregationRate * DiaN & ! --> Aggregation loss + - grazingFlux_Dia & ! --> Grazing loss +#if defined (__3Zoo2Det) + - grazingFlux_Dia2 & + - grazingFlux_Dia3 & ! 3Zoo +#endif + ) * dt_b + sms(k,idian) + +!____________________________________________________________ +!< Diatom C + +!< lossC_d: Diatom loss of carbon [day^-1] +!< When N : C ratio becomes too high, excretion of DOC is downregulated +!< by the limiter function limitFacN_dia +!< aggregationRate transfers C to the detritus pool + + sms(k,idiac) = ( & + + Cphot_dia * DiaC & ! -- Photosynthesis ---->/ + - lossC_d * limitFacN_dia * DiaC & ! -- Excretion of DOC --/ Net Photosynthesis + - phyRespRate_dia * DiaC & ! -- Respiration ----->/ + - aggregationRate * DiaC & + - grazingFlux_dia * recipQuota_dia & +#if defined (__3Zoo2Det) + - grazingFlux_dia2 * recipQuota_dia & + - grazingFlux_dia3 * recipQuota_dia & ! 3Zoo +#endif + ) * dt_b + sms(k,idiac) + +!____________________________________________________________ +!< Diatom Chl + + sms(k,idchl) = ( & + + chlSynth_dia * DiaC & ! --> Chl a synthesis + - KOchl_dia * DiaChl & ! --> Degradation loss + - aggregationRate * DiaChl & ! --> Aggregation loss + - grazingFlux_dia * Chl2N_dia & ! --> Grazing loss +#if defined (__3Zoo2Det) + - grazingFlux_dia2 * Chl2N_dia & + - grazingFlux_dia3 * Chl2N_dia & ! 3Zoo +#endif + ) * dt_b + sms(k,idchl) + +!____________________________________________________________ +!< Diatom Si + +!< lossN_d: Diatom loss of organic nitrogen compunds [day^-1] +!< When N : C ratio becomes too high, excretion is downregulated +!< by the limiter function limitFacN_dia +!< aggregationRate transfers Si to the detritus pool + + sms(k,idiasi) = ( & + + Si_assim * DiaC & ! -- Diatom silicon assimilation + - lossN_d * limitFacN_dia * DiaSi & ! -- Excretion to detritus + - aggregationRate * DiaSi & ! -- Aggregation loss + - grazingFlux_dia * qSiN & ! -- Grazing loss +#if defined (__3Zoo2Det) + - grazingFlux_dia2 * qSiN & + - grazingFlux_dia3 * qSiN & ! 3Zoo +#endif + ) * dt_b + sms(k,idiasi) + +!< *** Coccolithophore *** +!< *********************** + +#if defined (__coccos) +!____________________________________________________________ +!< Coccolithophore N + sms(k,icocn) = ( & + + N_assim_cocco * CoccoC & + - lossN_c * limitFacN_cocco * CoccoN & + - aggregationRate * CoccoN & + - grazingFlux_Cocco & +#if defined (__3Zoo2Det) + - grazingFlux_Cocco2 & + - grazingFlux_Cocco3 & ! 3Zoo +#endif + ) * dt_b + sms(k,icocn) + +!____________________________________________________________ +!< Coccolithophore C + + sms(k,icocc) = ( & + + Cphot_cocco * CoccoC & + - lossC_c * limitFacN_cocco * CoccoC & + - phyRespRate_cocco * CoccoC & + - aggregationRate * CoccoC & + - grazingFlux_cocco * recipQuota_cocco & +#if defined (__3Zoo2Det) + - grazingFlux_Cocco2 * recipQuota_cocco & + - grazingFlux_Cocco3 * recipQuota_cocco & ! 3Zoo +#endif + ) * dt_b + sms(k,icocc) + + if(sms(k,icocc)>100) then + print*,'ERROR: strange CoccoC !' + print*,'k= ', k + print*,'dt= ', dt + print*,'dt_b= ', dt_b + print*,'state(k,icocc): ', state(k,icocc) + print*,'sms CoccoC: ', CoccoC + print*,'sms CoccoN: ', CoccoN + print*,'sms Cphot cocco: ', Cphot_cocco*CoccoC + print*,'sms lossC_c: ', lossC_c + print*,'sms limitFacN_cocco: ', limitFacN_cocco + print*,'sms phyRespRate_cocco: ', phyRespRate_cocco + print*,'sms grazingFlux_cocco: ', grazingFlux_cocco + print*,'sms grazingFlux_cocco2: ', grazingFlux_Cocco2 + print*,'sms grazingFlux_cocco3: ', grazingFlux_Cocco3 + print*,'sms recipQuota_cocco: ', recipQuota_cocco + + print*,'sms recipQuota_cocco: ', recipQuota_cocco + call par_ex(partit%MPI_COMM_FESOM, partit%mype) + stop + endif + +!____________________________________________________________ +!< Coccolithophore Chl + + sms(k,icchl) = ( & + + ChlSynth_cocco * CoccoC & + - KOchl_cocco * CoccoChl & + - aggregationRate * CoccoChl & + - grazingFlux_cocco * Chl2N_cocco & +#if defined (__3Zoo2Det) + - grazingFlux_Cocco2 * Chl2N_cocco & + - grazingFlux_Cocco3 * Chl2N_cocco & ! 3Zoo +#endif + ) * dt_b + sms(k,icchl) +#endif + +!< *** Silicate *** +!< **************** + +!____________________________________________________________ +!< Detritus Si +#if defined (__3Zoo2Det) + sms(k,idetsi) = ( & + + aggregationRate * DiaSi & + + lossN_d * limitFacN_dia * DiaSi & + + grazingFlux_dia3 * qSiN & + - reminSiT * DetSi & + ) * dt_b + sms(k,idetsi) +#else + sms(k,idetsi) = ( & + + aggregationRate * DiaSi & + + lossN_d * limitFacN_dia * DiaSi & + + grazingFlux_dia * qSiN & + - reminSiT * DetSi & + ) * dt_b + sms(k,idetsi) +#endif +!____________________________________________________________ +!< DSi, Silicate + +!< DiaC: Intracellular carbon concentration in diatoms [mmolC m-3] +!< DetSi: Detritus silicon concentration [mmolSi m-3] +!< Si_assim: Si assimilation rate for diatoms [mmolSi mmolC-1 day-1] +!< reminSiT: Remineralization rate of silicon, temperature dependency [day-1] +!< dt_b: REcoM time step [day] + +!! Schourup 2013 Eq. A3 + + sms(k,isi) = ( & + - Si_assim * DiaC & ! --> Si assimilation of diatoms + + reminSiT * DetSi & ! --> Remineralization of detritus, temperature dependent +#if defined (__3Zoo2Det) + + reminSiT * DetZ2Si & +#endif + ) * dt_b + sms(k,isi) +!< *** Iron *** +!< ************ + +!____________________________________________________________ +!< Fe + +!< Fe2N: Intracellular Fe : N ratio [μmol Fe mmol N^-1] Fe2N = Fe2C * 6.625 +!< PhyC: Intracellular carbon concentration in nanophytoplankton [mmolCm^-3] +!< Cphot: C-specific actual rate of photosynthesis for nanopyhtoplankton [day^-1] +!< DiaC: Intracellular carbon concentration in diatoms [mmol C m^-3 ] +!< Cphot_dia: C-specific actual rate of photosynthesis for diatom [day^-1] +!< phyRespRate: Nanopyhtoplankton respiration rate [day^-1] +!< phyRespRate_dia: Diatom respiration rate [day^-1] +!< lossC: Nanopyhtoplankton excretion of organic C [day^-1] +!< limitFacN: limiting factor +!< lossC_d: Diatom excretion of organic C [day^-1] +!< limitFacN_dia: limiting factor +!< detC: Detritus carbon concentration [mmol C m^-3] +!< reminC: Temperature dependent remineralisation rate of detritus [day^-1] +!< arrFunc: Arrhenius function +!< hetC: Zooplankton carbon concentration [mmol C m^-3 ] +!< lossC_z: Zooplankton excretion of organic C [day^-1 ] +!< hetRespFlux: Zooplankton respiration rate [day^-1] +!< kScavFe: Scavenging rate of iron [m3 mmol C^-1 day^-1] + + sms(k,ife) = ( Fe2N * ( & + - N_assim * PhyC & ! --> N assimilation Nanophytoplankton, [mmol N/(mmol C * day)] C specific N utilization rate + - N_assim_dia * DiaC & ! --> N assimilation Diatom +#if defined (__coccos) + - N_assim_cocco * CoccoC & + + lossN_c * limitFacN_cocco * CoccoN & +#endif + + lossN * limitFacN * PhyN & ! --> Excretion from small pythoplankton + + lossN_d * limitFacN_dia * DiaN & ! --> Excretion from diatom + + reminN * arrFunc * O2Func * DetN & ! --> Remineralization of detritus ! NEW O2remin + + lossN_z * HetN & ! --> Excretion from zooplankton +#if defined (__3Zoo2Det) + + reminN * arrFunc * O2Func * DetZ2N & ! O2remin + + lossN_z2 * Zoo2N & + + lossN_z3 * MicZooN & ! 3Zoo +#endif + ) & + - kScavFe * DetC * FreeFe & +#if defined (__3Zoo2Det) + - kScavFe * DetZ2C * FreeFe & +#endif + ) * dt_b + sms(k,ife) + +!< *** Calcification *** +!< ********************* + +!____________________________________________________________ +!< Small phytoplankton calcite + +#if defined (__coccos) + sms(k,iphycal) = ( & + + calcification & ! --> Calcification + - lossC_c * limitFacN_cocco * PhyCalc & ! --> Excretion loss + - phyRespRate_cocco * PhyCalc & ! --> Respiration + - calc_loss_agg & ! --> Aggregation loss + - calc_loss_gra & ! --> Grazing loss +#if defined (__3Zoo2Det) + - calc_loss_gra2 & + - calc_loss_gra3 & ! 3Zoo +#endif + ) * dt_b + sms(k,iphycal) +#else + sms(k,iphycal) = ( & + + calcification & ! --> Calcification + - lossC * limitFacN * PhyCalc & ! --> Excretion loss + - phyRespRate * PhyCalc & ! --> Respiration + - calc_loss_agg & ! --> Aggregation loss + - calc_loss_gra & ! --> Grazing loss +#if defined (__3Zoo2Det) + - calc_loss_gra2 & + - calc_loss_gra3 & ! 3Zoo +#endif + ) * dt_b + sms(k,iphycal) +#endif + +!____________________________________________________________ +! Detritus calcite +#if defined (__coccos) + +#if defined (__3Zoo2Det) + sms(k,idetcal) = ( & + + lossC_c * limitFacN_cocco * PhyCalc & + + phyRespRate_cocco * PhyCalc & + + calc_loss_agg & + + calc_loss_gra3 & + - calc_loss_gra3 * calc_diss_guts & + - calc_diss * DetCalc & + ) * dt_b + sms(k,idetcal) + +#else + sms(k,idetcal) = ( & + + lossC_c * limitFacN_cocco * PhyCalc & + + phyRespRate_cocco * PhyCalc & + + calc_loss_agg & + + calc_loss_gra & + - calc_loss_gra * calc_diss_guts & + - calc_diss * DetCalc & + ) * dt_b + sms(k,idetcal) + +#endif + +#else + +#if defined (__3Zoo2Det) + sms(k,idetcal) = ( & + + lossC * limitFacN * PhyCalc & + + phyRespRate * PhyCalc & + + calc_loss_agg & + + calc_loss_gra3 & + - calc_loss_gra3 * calc_diss_guts & + - calc_diss * DetCalc & + ) * dt_b + sms(k,idetcal) +#else + sms(k,idetcal) = ( & + + lossC * limitFacN * PhyCalc & + + phyRespRate * PhyCalc & + + calc_loss_agg & + + calc_loss_gra & + - calc_loss_gra * calc_diss_guts & + - calc_diss * DetCalc & + ) * dt_b + sms(k,idetcal) +#endif +#endif + +!____________________________________________________________ +! Oxygen + + sms(k,ioxy) = ( & + + Cphot * phyC & + - phyRespRate * phyC & + + Cphot_dia * diaC & + - phyRespRate_dia * diaC & +#if defined (__coccos) + + Cphot_cocco * CoccoC & + - phyRespRate_cocco * CoccoC & +#endif + - rho_C1 * arrFunc * O2Func * EOC & ! O2remin + - hetRespFlux & +#if defined (__3Zoo2Det) + - Zoo2RespFlux & + - MicZooRespFlux & ! 3Zoo +#endif + ) * redO2C * dt_b + sms(k,ioxy) +! + if (ciso) then +!------------------------------------------------------------------------------- +! DIC_13 + sms(k,idic_13) = ( & +! - Cphot * PhyC_13 & + - Cphot * r_phyc_13 * PhyC & + + phyRespRate * PhyC_13 & +! - Cphot_Dia * DiaC_13 & + - Cphot_Dia * r_diac_13 * DiaC & + + phyRespRate_Dia * DiaC_13 & + + rho_C1 * arrFunc * EOC_13 & + + HetRespFlux_13 & + + calc_diss_13 * DetCalc_13 & + + calc_loss_gra_13 * calc_diss_guts & + - calcification_13 & + ) * dt_b + sms(k,idic_13) +!------------------------------------------------------------------------------- +! Phytoplankton C_13 + sms(k,iphyc_13) = ( & +! + Cphot * PhyC_13 & + + Cphot * r_phyc_13 * PhyC & + - lossC * limitFacN * PhyC_13 & + - phyRespRate * PhyC_13 & + - aggregationRate * PhyC_13 & + - grazingFlux_phy * recipQuota_13 & + ) * dt_b + sms(k,iphyc_13) +!------------------------------------------------------------------------------- +! Detritus C_13 + sms(k,idetc_13) = ( & + + grazingFlux_phy * recipQuota_13 & + - grazingFlux_phy * recipQuota_13 * grazEff & + + grazingFlux_Dia * recipQuota_dia_13 & + - grazingFlux_Dia * recipQuota_dia_13 * grazEff & + + aggregationRate * phyC_13 & + + aggregationRate * DiaC_13 & + + hetLossFlux * recipQZoo_13 & + - reminC * arrFunc * DetC_13 & + ) * dt_b + sms(k,idetc_13) +!------------------------------------------------------------------------------- +! Heterotrophic C_13 + sms(k,ihetc_13) = ( & + + grazingFlux_phy * recipQuota_13 * grazEff & + + grazingFlux_Dia * recipQuota_dia_13 * grazEff & + - hetLossFlux * recipQZoo_13 & + - lossC_z * HetC_13 & + - hetRespFlux_13 & + ) * dt_b + sms(k,ihetc_13) +!------------------------------------------------------------------------------- +! EOC_13 + sms(k,idoc_13) = ( & + + lossC * limitFacN * phyC_13 & + + lossC_d * limitFacN_dia * DiaC_13 & + + reminC * arrFunc * DetC_13 & + + lossC_z * HetC_13 & + - rho_c1 * arrFunc * EOC_13 & + + LocRiverDOC * r_iorg_13 & + ) * dt_b + sms(k,idoc_13) +!------------------------------------------------------------------------------- +! Diatom C_13 + sms(k,idiac_13) = ( & +! + Cphot_dia * DiaC_13 & + + Cphot_dia * r_diac_13 * DiaC & + - lossC_d * limitFacN_dia * DiaC_13 & + - phyRespRate_dia * DiaC_13 & + - aggregationRate * DiaC_13 & + - grazingFlux_dia * recipQuota_dia_13 & + ) * dt_b + sms(k,idiac_13) +!------------------------------------------------------------------------------- +! Small phytoplankton calcite_13 + sms(k,iphycal_13) = ( & + + calcification_13 & + - lossC * limitFacN * phyCalc_13 & + - phyRespRate * phyCalc_13 & + - calc_loss_agg_13 & + - calc_loss_gra_13 & + ) * dt_b + sms(k,iphycal_13) +!------------------------------------------------------------------------------- +! Detritus calcite_13 + sms(k,idetcal_13) = ( & + + lossC * limitFacN * phyCalc_13 & + + phyRespRate * phyCalc_13 & + + calc_loss_agg_13 & + + calc_loss_gra_13 & + - calc_loss_gra_13 * calc_diss_guts & + - calc_diss_13 * DetCalc_13 & + ) * dt_b + sms(k,idetcal_13) +!------------------------------------------------------------------------------- + if (ciso_14) then +!------------------------------------------------------------------------------- + if (ciso_organic_14) then +! DIC_14 + sms(k,idic_14) = ( & +! - Cphot * PhyC_14 & + - Cphot * r_phyc_14 * PhyC & + + phyRespRate * PhyC_14 & +! - Cphot_Dia * DiaC_14 & + - Cphot_Dia * r_diac_14 * DiaC & + + phyRespRate_Dia * DiaC_14 & + + rho_C1 * arrFunc * EOC_14 & + + HetRespFlux_14 & + + calc_diss_14 * DetCalc_14 & + + calc_loss_gra_14 * calc_diss_guts & + - calcification_14 & + ) * dt_b + sms(k,idic_14) +!------------------------------------------------------------------------------- +! Phytoplankton C_14 + sms(k,iphyc_14) = ( & +! + Cphot * PhyC_14 & + + Cphot * r_phyc_14 * PhyC & + - lossC * limitFacN * PhyC_14 & + - phyRespRate * PhyC_14 & + - aggregationRate * PhyC_14 & + - grazingFlux_phy * recipQuota_14 & + ) * dt_b + sms(k,iphyc_14) +!------------------------------------------------------------------------------- +! Detritus C_14 + sms(k,idetc_14) = ( & + + grazingFlux_phy * recipQuota_14 & + - grazingFlux_phy * recipQuota_14 * grazEff & + + grazingFlux_Dia * recipQuota_dia_14 & + - grazingFlux_Dia * recipQuota_dia_14 * grazEff & + + aggregationRate * phyC_14 & + + aggregationRate * DiaC_14 & + + hetLossFlux * recipQZoo_14 & + - reminC * arrFunc * DetC_14 & + ) * dt_b + sms(k,idetc_14) +!------------------------------------------------------------------------------- +! Heterotrophic C_14 + sms(k,ihetc_14) = ( & + + grazingFlux_phy * recipQuota_14 * grazEff & + + grazingFlux_Dia * recipQuota_dia_14 * grazEff & + - hetLossFlux * recipQZoo_14 & + - lossC_z * HetC_14 & + - hetRespFlux_14 & + ) * dt_b + sms(k,ihetc_14) +!------------------------------------------------------------------------------- +! EOC_14 + sms(k,idoc_14) = ( & + + lossC * limitFacN * phyC_14 & + + lossC_d * limitFacN_dia * DiaC_14 & + + reminC * arrFunc * DetC_14 & + + lossC_z * HetC_14 & + - rho_c1 * arrFunc * EOC_14 & + + LocRiverDOC * r_iorg_14 & + ) * dt_b + sms(k,idoc_14) +!------------------------------------------------------------------------------- +! Diatom C_14 + sms(k,idiac_14) = ( & +! + Cphot_dia * DiaC_14 & + + Cphot_dia * r_diac_14 * DiaC & + - lossC_d * limitFacN_dia * DiaC_14 & + - phyRespRate_dia * DiaC_14 & + - aggregationRate * DiaC_14 & + - grazingFlux_dia * recipQuota_dia_14 & + ) * dt_b + sms(k,idiac_14) +!------------------------------------------------------------------------------- +! Small phytoplankton calcite_14 + sms(k,iphycal_14) = ( & + + calcification_14 & + - lossC * limitFacN * phyCalc_14 & + - phyRespRate * phyCalc_14 & + - calc_loss_agg_14 & + - calc_loss_gra_14 & + ) * dt_b + sms(k,iphycal_14) +!------------------------------------------------------------------------------- +! Detritus calcite_14 + sms(k,idetcal_14) = ( & + + lossC * limitFacN * phyCalc_14 & + + phyRespRate * phyCalc_14 & + + calc_loss_agg_14 & + + calc_loss_gra_14 & + - calc_loss_gra_14 * calc_diss_guts & + - calc_diss_14 * DetCalc_14 & + ) * dt_b + sms(k,idetcal_14) +!------------------------------------------------------------------------------- + else +! "Abiotic" DIC_14, identical to DIC except for radioactive decay (-> +! recom_forcing) +!YY: change of DIC14 equal to that of DIC, why? + sms(k,idic_14) = sms(k,idic) + end if ! ciso_organic_14 + end if ! ciso_14 + end if ! ciso +!------------------------------------------------------------------------------- +! Diagnostics: Averaged rates + + recipbiostep = 1.d0/real(biostep) +if (Diags) then +!*** Net primary production [mmol C /(m3 * day)] + vertNPPn(k) = vertNPPn(k) + ( & + + Cphot * PhyC & + - PhyRespRate * PhyC & + ) * recipbiostep + + vertNPPd(k) = vertNPPd(k) + ( & + + Cphot_dia * DiaC & + - PhyRespRate_dia * DiaC & + ) * recipbiostep + +#if defined (__coccos) + vertNPPc(k) = vertNPPc(k) + ( & + + Cphot_cocco * CoccoC & + - PhyRespRate_cocco * CoccoC & + ) * recipbiostep +#endif + +!*** Gross primary production [mmol C /(m3 * day)] + vertGPPn(k) = vertGPPn(k) + ( & + + Cphot * PhyC & + ) * recipbiostep + + vertGPPd(k) = vertGPPd(k) + ( & + + Cphot_dia * DiaC & + ) * recipbiostep + +#if defined (__coccos) + vertGPPc(k) = vertGPPc(k) + ( & + + Cphot_cocco * CoccoC & + ) * recipbiostep +#endif + +!*** Net N-assimilation [mmol N/(m3 * day)] + vertNNAn(k) = vertNNAn(k) + ( & + + N_assim * PhyC & + - lossN * limitFacN * PhyN & + ) * recipbiostep + + vertNNAd(k) = vertNNAd(k) + ( & + + N_assim_dia * DiaC & + - lossN * limitFacN_dia * DiaN & + ) * recipbiostep + +#if defined (__coccos) + vertNNAc(k) = vertNNAc(k) + ( & + + N_assim_cocco * CoccoC & + - lossN * limitFacN_cocco * CoccoN & + ) * recipbiostep +#endif + +!*** Changed to chlorophyll degradation (commented out gross N-assimilation below) + vertChldegn(k) = vertChldegn(k) + ( & + + KOchl & + ) * recipbiostep + + vertChldegd(k) = vertChldegd(k) + ( & + + KOchl_dia & + ) * recipbiostep + +#if defined (__coccos) + vertChldegc(k) = vertChldegc(k) + ( & + + KOchl_cocco & + ) * recipbiostep +#endif + +!*** zooplankton1 respiration + vertrespmeso(k) = vertrespmeso(k) + ( & + + HetRespFlux & + ) * recipbiostep +#if defined (__3Zoo2Det) +!*** zooplankton2 respiration + vertrespmacro(k) = vertrespmacro(k) + ( & + + Zoo2RespFlux & + ) * recipbiostep + +!*** zooplankton3 respiration + vertrespmicro(k) = vertrespmicro(k) + ( & + + MicZooRespFlux & + ) * recipbiostep +#endif +!*** calc_diss + vertcalcdiss(k) = vertcalcdiss(k) + ( & + + calc_diss * DetCalc & + ) * recipbiostep + +!*** aggregation by small phytoplankton + vertaggn(k) = vertaggn(k) + ( & + + aggregationrate * PhyC & + ) * recipbiostep + +!*** aggregation by diatoms + vertaggd(k) = vertaggd(k) + ( & + + aggregationrate * DiaC & + ) * recipbiostep + +#if defined (__coccos) +!*** aggregation by coccolithophores + vertaggc(k) = vertaggc(k) + ( & + + aggregationrate * CoccoC & + ) * recipbiostep +#endif + +!*** excrection of DOC by phytoplankton + vertdocexn(k) = vertdocexn(k) + ( & + + lossC * limitFacN * phyC & + ) * recipbiostep + +!*** excrection of DOC by diatoms + vertdocexd(k) = vertdocexd(k) + ( & + + lossC_d * limitFacN_dia * DiaC & + ) * recipbiostep + +#if defined (__coccos) +!*** excretion of DOC by coccolithophores + vertdocexc(k) = vertdocexc(k) + ( & + + lossC_c * limitFacN_cocco * CoccoC & + ) * recipbiostep +#endif + +!*** calcification + vertcalcif(k) = vertcalcif(k) + ( & + + calcification & + ) * recipbiostep + +! phy respiration + vertrespn(k) = vertrespn(k) + ( & + + PhyRespRate * PhyC & + ) * recipbiostep + +! dia respiration + vertrespd(k) = vertrespd(k) + ( & + + PhyRespRate_dia * DiaC & + ) * recipbiostep + +#if defined (__coccos) +! cocco resipration + vertrespc(k) = vertrespc(k) + ( & + + PhyRespRate_cocco * CoccoC & + ) * recipbiostep + +#endif +endif + end do ! Main vertikal loop ends + +!------------------------------------------------------------------------------- +! Remineralization from the sediments into the bottom layer + + if (use_MEDUSA .and. (sedflx_num .ne. 0)) then + if (mype==0) then !OG + write(*,*) ' --> Sedimentary input of nutrients through MEDUSA' + endif + + else ! not use_MEDUSA or sedflx_num = 0 +!*** DIN *** +!< decayRateBenN: Remineralization rate for benthic N [day^-1] +!< LocBenthos(1): Vertically integrated N concentration in benthos (1 layer) [mmolN/m^2] + decayBenthos(1) = decayRateBenN * LocBenthos(1) + LocBenthos(1) = LocBenthos(1) - decaybenthos(1) * dt_b ! remove from benthos (flux) + +!*** DIC *** +!< decayRateBenC: Remineralization rate for benthic C [day^-1] +!< LocBenthos(2): Vertically integrated C concentration in benthos (1 layer) [mmolC/m^2] + decayBenthos(2) = decayRateBenC * LocBenthos(2) + LocBenthos(2) = LocBenthos(2) - decaybenthos(2) * dt_b + +!*** Si *** +!< decayRateBenSi: Remineralization rate for benthic Si [day^-1] +!< LocBenthos(3) : Vertically integrated N concentration in benthos (1 layer) [mmolSi/m^2] + decayBenthos(3) = decayRateBenSi * LocBenthos(3) ! [1/day] * [mmolSi/m2] -> [mmolSi/m2/day] + LocBenthos(3) = LocBenthos(3) - decaybenthos(3) * dt_b + +!*** Calc: DIC, Alk *** ! OG calc_diss_ben is taken from the deepest level + decayBenthos(4) = calc_diss_ben * LocBenthos(4) ! NEW DISS changed calc_diss to calc_diss_ben to not make the dissolution omega dependent when using the switch OmegaC_diss + LocBenthos(4) = LocBenthos(4) - decayBenthos(4) * dt_b + + if (ciso) then +!*** DIC_13 *** We ignore isotopic fractionation during remineralization. + decayBenthos(5) = alpha_dcal_13 * decayRateBenC * LocBenthos(5) + LocBenthos(5) = LocBenthos(5) - decayBenthos(5) * dt_b +!*** Calc: DIC_13 *** + decayBenthos(6) = calc_diss_13 * LocBenthos(6) + LocBenthos(6) = LocBenthos(6) - decayBenthos(6) * dt_b ! / depth of benthos + if (ciso_14) then + if (ciso_organic_14) then +!*** DIC_14 *** We ignore isotopic fractionation during remineralization. + decayBenthos(7) = alpha_dcal_14 * decayRateBenC * LocBenthos(7) + LocBenthos(7) = LocBenthos(7) - decayBenthos(7) * dt_b +!*** Calc: DIC_14 *** + decayBenthos(8) = calc_diss_14 * LocBenthos(8) + LocBenthos(8) = LocBenthos(8) - decayBenthos(8) * dt_b ! / depth of benthos + else +! Do nothing here because sms(idic_14) is defined as sms(idic) further +! above + end if ! ciso_organic_14 + end if ! ciso_14 + end if ! ciso + endif ! use_MEDUSA + + end do ! Main time loop ends + + +end subroutine REcoM_sms + +!------------------------------------------------------------------------------- +! Function for calculating limiter +!------------------------------------------------------------------------------- + +function recom_limiter(slope,qa,qb) + use recom_config + Implicit None + Real(kind=8) :: recom_limiter + Real(kind=8) :: slope, qa, qb + Real(kind=8) :: dq + + dq = qa - qb + if (REcoM_Geider_limiter) then + recom_limiter = max(min( -slope*dq, 1.d0),0.d0) + else + recom_limiter = 1.d0 - exp( -slope*( abs(dq)-dq )**2) + endif + return + end + +!------------------------------------------------------------------------------- +! Function for iron chemistry +!------------------------------------------------------------------------------- +function iron_chemistry_2ligands(fet,l1t,l2t,k1,k2) + implicit none + + Real(kind=8) :: iron_chemistry_2ligands + Real(kind=8) :: l1t,l2t,fet,k1,k2 + Real(kind=8) :: a3,a2,a1,a0,a,b,c,p,q,discr,rho,phi,amp,pi + Real(kind=8) :: one3rd, one27th + Real(kind=8) :: fe1,fe2,fe3 + +! coefficients of the 4th-order polynomial + a3 = k1*k2 + a2 = ( k1*k2*(l1t + l2t - fet) + k1 + k2 ) + a1 = ( 1 - (k1 + k2)*fet + k1*l1t + k2*l2t ) + a0 = -fet + +! coefficients of the normalized polynomial + a = a2/a3 + b = a1/a3 + c = a0/a3 + +! some numbers that are used several times + one3rd = 1.0/3.0 + one27th = 1.0/27.0 + +! now solve the polynomial stepwise + p = b - a*a*one3rd + q = c - a*b*one3rd + 2.0*a*a*a*one27th + discr = q*q/4.0 + p*p*p*one27th + + rho = sqrt(-(p*p*p*one27th)) + phi = acos(-q/(2.0*rho)) + amp = 2.0*rho**one3rd + pi = 3.1415926535897931 + +! the equation has three real roots + fe1 = amp*cos(phi*one3rd) - a*one3rd + fe2 = amp*cos((phi + 2.0*pi)*one3rd) - a*one3rd + fe3 = amp*cos((phi + 4.0*pi)*one3rd) - a*one3rd + + iron_chemistry_2ligands = max(fe1,fe2,fe3) + +end function iron_chemistry_2ligands +!------------------------------------------------------------------------------- +function iron_chemistry(Fe, totalLigand, ligandStabConst) + implicit none + + Real(kind=8) :: iron_chemistry + Real(kind=8) :: Fe, totalLigand, ligandStabConst ! Input + Real(kind=8) :: FreeFe ! Output + Real(kind=8) :: ligand,FeL,a,b,c,discrim + +! Abbrevations + a = ligandstabConst + b = ligandstabConst * (Fe - totalLigand) + 1.d0 + c = -totalLigand + discrim = b*b - 4.d0 * a * c + + if (a .ne. 0.d0 .and. discrim .ge. 0.d0) then + ligand = ( -b + sqrt(discrim) ) / (2.d0 * a) + FeL = totalLigand - ligand + freeFe = Fe - FeL + else ! No free iron + freeFe = 0.d0 + end if + + iron_chemistry = freeFe + + return + end function iron_chemistry + diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 7d02fd6ab..b07dfa69e 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -704,6 +704,97 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) if (use_REcoM) then call def_stream(nod2D, myDim_nod2D, 'benCalc','Benthos calcite','mmol', Benthos(:,4), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if +! ciso +CASE ('benC_13 ') + if (use_REcoM) then + if (ciso) then + call def_stream(nod2D, myDim_nod2D, 'benC_13','Benthos Carbon-13','mmol/m2', Benthos(:,5), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if +CASE ('benC_14 ') + if (use_REcoM) then + if (ciso) then + call def_stream(nod2D, myDim_nod2D, 'benC_14','Benthos Carbon-14','mmol/m2', Benthos(:,6), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if +CASE ('benCalc_13') + if (use_REcoM) then + if (ciso) then + call def_stream(nod2D, myDim_nod2D, 'benCalc_13','Benthos calcite-13','mmol/m2', Benthos(:,7), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if +CASE ('benCalc_14') + if (use_REcoM) then + if (ciso) then + call def_stream(nod2D, myDim_nod2D, 'benCalc_14','Benthos calcite-14','mmol/m2', Benthos(:,8), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if +!ciso +! output of sinking fluxes for MEDUSA +CASE ('sinkPON ') + if (use_REcoM) then + if (use_MEDUSA) then + call def_stream(nod2D, myDim_nod2D, 'sinkPON','sinking flux of particulate organic nitrogen','mmolN/(m2*s)', SinkFlx(:,1), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit,mesh) + end if + end if + +CASE ('sinkPOC ') + if (use_REcoM) then + if (use_MEDUSA) then + call def_stream(nod2D, myDim_nod2D, 'sinkPOC','sinking flux of particulate organic carbon','mmolC/(m2*s)', SinkFlx(:,2), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if + +CASE ('sinkOpal ') + if (use_REcoM) then + if (use_MEDUSA) then + call def_stream(nod2D, myDim_nod2D, 'sinkOpal','sinking flux of opal','mmol/(m2*s)', SinkFlx(:,3), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if + +CASE ('sinkCalc ') + if (use_REcoM) then + if (use_MEDUSA) then + call def_stream(nod2D, myDim_nod2D, 'sinkCalc','sinking flux of CaCO3','mmol/(m2*s)', SinkFlx(:,4), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if + +CASE ('sinkC13 ') + if (use_REcoM) then + if (use_MEDUSA) then + if (ciso) then + call def_stream(nod2D, myDim_nod2D, 'sinkC13','sinking flux of particulate organic carbon-13','mmol/(m2*s)', SinkFlx(:,5), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if + end if + +CASE ('sinkCal13') + if (use_REcoM) then + if (use_MEDUSA) then + if (ciso) then + call def_stream(nod2D, myDim_nod2D, 'sinkCal13','sinking flux of CaCO3-13','mmol/(m2*s)', SinkFlx(:,6), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if + end if + +CASE ('sinkC14 ') + if (use_REcoM) then + if (use_MEDUSA) then + if (ciso .and. ciso_14) then + call def_stream(nod2D, myDim_nod2D, 'sinkC14','sinking flux of particulate organic carbon-14','mmol/(m2*s)', SinkFlx(:,7), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if + end if + +CASE ('sinkCal14') + if (use_REcoM) then + if (use_MEDUSA) then + if (ciso .and. ciso_14) then + call def_stream(nod2D, myDim_nod2D, 'sinkCal14','sinking flux of CaCO3-14','mmol/(m2*s)', SinkFlx(:,8), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + end if + end if + CASE ('NPPn ') if (use_REcoM) then call def_stream(nod2D, myDim_nod2D, 'NPPn','Mean NPP nanophytoplankton','mmolC/m2/d', NPPn, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -888,6 +979,32 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) else if (tracers%data(j)%ID==1002) then if (use_REcoM) then call def_stream((/nl-1, nod2D/), (/nl-1, myDim_nod2D/), 'DIC', 'Dissolved Inorganic C', '[mmol/m3]', tracers%data(j)%values(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + if (tracers%data(j)%ltra_diag) then ! OG - tra_diag + ! horizontal advection + call def_stream((/nl-1, nod2D/), (/nl-1, myDim_nod2D/), 'DIC_hor_adv', 'Horizontal advection part of dissolved Inorganic C', '[mmol/m3]', tracers%work%tra_advhoriz(:,:,j), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + ! vertical advection + call def_stream((/nl-1, nod2D/), (/nl-1, myDim_nod2D/), 'DIC_ver_adv', 'Vertical advection part of dissolved Inorganic C', '[mmol/m3]', tracers%work%tra_advvert(:,:,j), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + ! horizontal diffusion + call def_stream((/nl-1, nod2D/), (/nl-1, myDim_nod2D/), 'DIC_tra_diff_part_hor_redi', 'Horizontal diffusion of dissolved Inorganic C (includes Redi diffusivity if Redi=.true.)', '[mmol/m3]', tracers%work%tra_diff_part_hor_redi(:,:,j), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + if (.not. tracers%data(j)%i_vert_diff) then + ! vertical diffusion (Explicit) + call def_stream((/nl-1, nod2D/), (/nl-1, myDim_nod2D/), 'DIC_tra_diff_part_ver_expl', 'Vertical diffusion of dissolved Inorganic C (Explicit)', '[mmol/m3]', tracers%work%tra_diff_part_ver_expl(:,:,j), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + + ! projection of horizontal Redi diffussivity onto vertical + call def_stream((/nl-1, nod2D/), (/nl-1, myDim_nod2D/), 'DIC_tra_diff_part_ver_redi_expl', 'Projection of horizontal Redi diffussivity onto vertical for dissolved Inorganic C (Explicit)', '[mmol/m3]', tracers%work%tra_diff_part_ver_redi_expl(:,:,j), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + ! vertical diffusion (Implicit) + call def_stream((/nl-1, nod2D/), (/nl-1, myDim_nod2D/), 'DIC_tra_diff_part_ver_impl', 'Vertical diffusion of dissolved Inorganic C (Implicit)', '[mmol/m3]', tracers%work%tra_diff_part_ver_impl(:,:,j), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + ! recom_sms + call def_stream((/nl-1, nod2D/), (/nl-1, myDim_nod2D/), 'DIC_recom_sms', 'Recom SMS', '[mmol/m3]', tracers%work%tra_recom_sms(:,:,j), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + endif else if (tracers%data(j)%ID==1003) then diff --git a/src/io_restart.F90 b/src/io_restart.F90 index 0fe2667cb..1cad57a52 100644 --- a/src/io_restart.F90 +++ b/src/io_restart.F90 @@ -297,6 +297,24 @@ subroutine ini_bio_io(tracers, partit, mesh) call bio_files%def_node_var('BenSi', 'Benthos Silicate', 'mmol/m3', Benthos(:,3), mesh, partit); call bio_files%def_node_var('BenCalc', 'Benthos Calcite', 'mmol/m3', Benthos(:,4), mesh, partit); call bio_files%def_node_var('HPlus', 'Conc. of H-plus ions in the surface water', 'mol/kg', GloHplus, mesh, partit); + if (ciso) then + call bio_files%def_node_var('BenC_13', 'Benthos Carbon-13', 'mmol/m3', Benthos(:,5), mesh, partit); + call bio_files%def_node_var('BenCalc_13', 'Benthos Calcite-13', 'mmol/m3', Benthos(:,6), mesh, partit); + if (ciso_14 .and. ciso_organic_14) then + call bio_files%def_node_var('BenC_14', 'Benthos Carbon-14', 'mmol/m3', Benthos(:,7), mesh, partit); + call bio_files%def_node_var('BenCalc_14', 'Benthos Calcite-14', 'mmol/m3', Benthos(:,8), mesh, partit); + end if ! ciso_14 + end if ! ciso + if (use_atbox) then + call bio_files%def_node_var('xCO2', 'Atm. CO2 mixing ratio', 'mol / mol', x_co2atm(:), mesh, partit); + if (ciso) then + call bio_files%def_node_var('xCO2_13', 'Atm. 13CO2 mixing ratio', 'mol / mol', x_co2atm_13(:), mesh, partit); + if (ciso_14) then + call bio_files%def_node_var('xCO2_14', 'Atm. 14CO2 mixing ratio', 'mol / mol', x_co2atm_14(:), mesh, partit); + call bio_files%def_node_var('cosmic_14', 'Cosmic 14C production', 'mol / s', cosmic_14(:), mesh, partit); + end if + end if + end if ! use_atbox end subroutine ini_bio_io #endif @@ -426,19 +444,38 @@ subroutine write_initial_conditions(istep, nstart, ntotal, which_readr, ice, dyn type(t_dyn) , intent(inout), target :: dynamics type(t_ice) , intent(inout), target :: ice integer, intent(in) :: which_readr - + ! Local variables logical :: is_portable_restart_write, is_raw_restart_write, is_bin_restart_write logical, save :: initialized_raw = .false. logical, save :: initialized_bin = .false. logical, save :: initialized_io = .false. - integer :: mpierr character(:), allocatable :: write_raw_dirpath, write_raw_infopath character(:), allocatable :: write_bin_dirpath, write_bin_infopath character(:), allocatable :: write_oce_path, write_ice_path character(:), allocatable :: write_icepack_path, write_bio_path + +#if defined(__recom) && defined(__usetp) + integer :: tr_arr_slice_count_fix_1 + integer :: group_i + integer :: tr_num_start + integer :: tr_num_end + integer :: tr_num_in_group + logical :: has_one_added_tracer + integer :: num_tracers + integer :: tr_num +#endif +#if defined(__recom) && defined(__usetp) +#include "associate_part_def.h" +#include "associate_mesh_def.h" +#include "associate_part_ass.h" +#include "associate_mesh_ass.h" + num_tracers = tracers%num_tracers +#else + integer :: mpierr +#endif ! Build paths for reading using RestartInPath write_raw_dirpath = build_raw_restart_dirpath(RestartOutPath)//"/np"//int_to_txt(partit%npes) @@ -455,22 +492,36 @@ subroutine write_initial_conditions(istep, nstart, ntotal, which_readr, ice, dyn if(.not. initialized_raw) then initialized_raw = .true. if(raw_restart_length_unit /= "off") then - if(partit%mype == RAW_RESTART_METADATA_RANK) then - call mkdir(build_raw_restart_dirpath(RestartOutPath)) - call mkdir(write_raw_dirpath) + +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then ! master rank creates the folder +#endif + if(partit%mype == RAW_RESTART_METADATA_RANK) then + call mkdir(build_raw_restart_dirpath(RestartOutPath)) + call mkdir(write_raw_dirpath) + end if +#if defined(__recom) && defined(__usetp) end if - call MPI_Barrier(partit%MPI_COMM_FESOM, mpierr) +#endif + call MPI_Barrier(partit%MPI_COMM_FESOM, mpierr) end if end if if(.not. initialized_bin) then initialized_bin = .true. if(bin_restart_length_unit /= "off") then - if(partit%mype == RAW_RESTART_METADATA_RANK) then - call mkdir(build_bin_restart_dirpath(RestartOutPath)) - call mkdir(write_bin_dirpath) - end if - call MPI_Barrier(partit%MPI_COMM_FESOM, mpierr) + +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif + if(partit%mype == RAW_RESTART_METADATA_RANK) then + call mkdir(build_bin_restart_dirpath(RestartOutPath)) + call mkdir(write_bin_dirpath) + end if +#if defined(__recom) && defined(__usetp) + end if +#endif + call MPI_Barrier(partit%MPI_COMM_FESOM, mpierr) end if end if @@ -488,8 +539,8 @@ subroutine write_initial_conditions(istep, nstart, ntotal, which_readr, ice, dyn #if defined(__recom) if (use_REcoM) call ini_bio_io(tracers, partit, mesh) #endif - end if - + end if + ! Skip writing on step 0 if (istep==0) return @@ -516,40 +567,92 @@ subroutine write_initial_conditions(istep, nstart, ntotal, which_readr, ice, dyn else is_bin_restart_write = is_due(trim(bin_restart_length_unit), bin_restart_length, istep) end if + + ! --> synchronizes tracer data within fesom groups + +! kh 09.01.26 merging of valuesold and valuesAB between all fesom groups is only necessary here, immediately before writing the corresponding restart files +! this will give better performance than merging valuesold and valuesAB in each simulation step in the main loop over all tracers in solve_tracers_ale in oce_ale_tracers.F90 + +#if defined(__recom) && defined(__usetp) + if(num_fesom_groups > 1) then + tr_arr_slice_count_fix_1 = 1 * (nl - 1) * (myDim_nod2D + eDim_nod2D) + + do group_i = 0, num_fesom_groups - 1 + call calc_slice(num_tracers, num_fesom_groups, group_i, tr_num_start, tr_num_end, tr_num_in_group, has_one_added_tracer) + +! kh 09.01.26 tracers%data(:)%valuesold(:,:,:) is not contigous in memory, so an explicit inner loop over the tracers of each group is required + do tr_num = tr_num_start, tr_num_end + +! kh 09.01.26 also handle additional dimension of valuesold for AB_order + call MPI_Bcast(tracers%data(tr_num)%valuesold(:,:,:), tr_arr_slice_count_fix_1 * (tracers%data(tr_num)%AB_order - 1), MPI_DOUBLE_PRECISION, group_i, partit%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, partit%mpierr) + + call MPI_Bcast(tracers%data(tr_num)%valuesAB(:,:), tr_arr_slice_count_fix_1, MPI_DOUBLE_PRECISION, group_i, partit%MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, partit%mpierr) + end do + end do + end if +#endif ! Write restart files if(is_portable_restart_write) then - ! Write OCEAN restart - if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: ocean'//achar(27)//'[0m' - call write_netcdf_restarts(write_oce_path, oce_files, istep) - - ! Write ICE/ICEPACK restart + ! write OCEAN restart +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif + if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: ocean'//achar(27)//'[0m' + call write_netcdf_restarts(write_oce_path, oce_files, istep) +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group == 0) then +#endif + + ! write ICE/ICEPACK restart if(use_ice) then +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif #if defined(__icepack) - if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: icepack'//achar(27)//'[0m' - call write_netcdf_restarts(write_icepack_path, icepack_files, istep) + if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: icepack'//achar(27)//'[0m' + call write_netcdf_restarts(write_icepack_path, icepack_files, istep) #else - if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: ice'//achar(27)//'[0m' - call write_netcdf_restarts(write_ice_path, ice_files, istep) -#endif + if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: ice'//achar(27)//'[0m' + call write_netcdf_restarts(write_ice_path, ice_files, istep) +#endif +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group == 0) then +#endif end if - + + ! write RECOM restart #if defined(__recom) - ! Write RECOM restart - if (REcoM_restart .or. use_REcoM) then - if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: bio'//achar(27)//'[0m' - call write_netcdf_restarts(write_bio_path, bio_files, istep) - end if + if (REcoM_restart .or. use_REcoM) then +#if defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif + if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: bio'//achar(27)//'[0m' + call write_netcdf_restarts(write_bio_path, bio_files, istep) +#if defined(__usetp) + endif +#endif + end if #endif - end if + + end if !is_portable_restart_write ! Write core dump if(is_raw_restart_write) then +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif call write_all_raw_restarts(write_raw_dirpath, write_raw_infopath, istep, partit%MPI_COMM_FESOM, partit%mype) +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group == 0) then +#endif end if ! Write derived type binary if(is_bin_restart_write) then +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif call write_all_bin_restarts((/globalstep+istep, int(ctime), yearnew/), & write_bin_dirpath, & write_bin_infopath, & @@ -558,13 +661,23 @@ subroutine write_initial_conditions(istep, nstart, ntotal, which_readr, ice, dyn ice, & dynamics, & tracers ) + +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group == 0) then +#endif end if ! Update clock file to latest restart point if (partit%mype==0) then if(is_portable_restart_write .or. is_raw_restart_write .or. is_bin_restart_write) then - write(*,*) ' --> actualize clock file to latest restart point' - call clock_finish +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif + write(*,*) ' --> actualize clock file to latest restart point' + call clock_finish +#if defined(__recom) && defined(__usetp) + end if +#endif end if end if diff --git a/src/io_restart_file_group.F90 b/src/io_restart_file_group.F90 index 31c9263f5..b69e11d95 100644 --- a/src/io_restart_file_group.F90 +++ b/src/io_restart_file_group.F90 @@ -17,7 +17,7 @@ module restart_file_group_module type restart_file_group private - type(restart_file_type), public :: files(112) + type(restart_file_type), public :: files(200) ! .OG. 112 Before integer, public :: nfiles = 0 ! todo: allow dynamically allocated size without messing with shallow copied pointers contains diff --git a/src/oce_adv_tra_driver.F90 b/src/oce_adv_tra_driver.F90 index 9b9606ea8..fa0cd7c65 100644 --- a/src/oce_adv_tra_driver.F90 +++ b/src/oce_adv_tra_driver.F90 @@ -209,6 +209,27 @@ subroutine do_oce_adv_tra(dt, vel, w, wi, we, tr_num, dynamics, tracers, partit, #endif #endif + +! O:G - tra_diag +! LO solution +! fct_LO is zero before adv_flux_hor +! Up to now only horizontal +! contribution + + +!#if defined (__recom) + if (tracers%data(tr_num)%ltra_diag) then + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ! Horizontal advection part for LO (FCT is .TRUE.) + tracers%work%tra_advhoriz(nz,n,tr_num) = fct_LO(nz,n) * dt/areasvol(nz,n)/hnode_new(nz,n) + end do + end do + end if +!#endif + ! compute the low order upwind vertical flux (explicit part only) ! zero the input/output flux before computation call adv_tra_ver_upw1(we, ttf, partit, mesh, adv_flux_ver, o_init_zero=.true.) @@ -277,6 +298,24 @@ subroutine do_oce_adv_tra(dt, vel, w, wi, we, tr_num, dynamics, tracers, partit, end if +! O:G - tra_diag +! LO solution +! fct_LO is zero before adv_flux_ver +! vertical contribution + +!#if defined (__recom) + if (tracers%data(tr_num)%ltra_diag) then + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ! Vertical advection part for LO (FCT is .TRUE.) + tracers%work%tra_advvert (nz,n,tr_num) = (adv_flux_ver(nz, n)-adv_flux_ver(nz+1, n))*dt/areasvol(nz,n)/hnode_new(nz,n) + end do + end do + end if +!#endif + !_______________________________________________________________________ if (dynamics%use_wsplit) then !wvel/=wvel_e @@ -301,7 +340,7 @@ subroutine do_oce_adv_tra(dt, vel, w, wi, we, tr_num, dynamics, tracers, partit, ! do horizontal tracer advection, in case of FCT high order solution SELECT CASE(trim(tracers%data(tr_num)%tra_adv_hor)) CASE('MUSCL') - ! compute the untidiffusive horizontal flux (o_init_zero=.false.: input is the LO horizontal flux computed above) + ! compute the antidiffusive horizontal flux (o_init_zero=.false.: input is the LO horizontal flux computed above) call adv_tra_hor_muscl(vel, ttfAB, partit, mesh, opth, adv_flux_hor, edge_up_dn_grad, nboundary_lay, o_init_zero=do_zero_flux) CASE('MFCT') call adv_tra_hor_mfct(vel, ttfAB, partit, mesh, opth, adv_flux_hor, edge_up_dn_grad, o_init_zero=do_zero_flux) @@ -416,6 +455,36 @@ subroutine do_oce_adv_tra(dt, vel, w, wi, we, tr_num, dynamics, tracers, partit, end if end if !-->if ((ldiag_DVD) .and. (tr_num<=2)) then + + +! O:G - tra_diag +!#if defined (__recom) + if (tracers%data(tr_num)%ltra_diag) then + !_______________________________________________________________________ + if (trim(tracers%data(tr_num)%tra_adv_lim)=='FCT') then + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ! part for LO + antidiffusive (FCT is .TRUE.) + tracers%work%tra_advhoriz(nz,n,tr_num) = tracers%work%tra_advhoriz(nz,n,tr_num) + dttf_h(nz,n)/hnode_new(nz,n) + tracers%work%tra_advvert(nz,n,tr_num) = tracers%work%tra_advvert(nz,n,tr_num) + dttf_v(nz,n)/hnode_new(nz,n) + end do + end do + else + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ! (FCT .FALSE.) + tracers%work%tra_advhoriz(nz,n,tr_num) = dttf_h(nz,n)/hnode_new(nz,n) + tracers%work%tra_advvert (nz,n,tr_num) = dttf_v(nz,n)/hnode_new(nz,n) + end do + end do + end if + end if +!#endif + end subroutine do_oce_adv_tra ! ! diff --git a/src/oce_ale.F90 b/src/oce_ale.F90 index 0f8e93b57..6fc4df37b 100644 --- a/src/oce_ale.F90 +++ b/src/oce_ale.F90 @@ -3819,6 +3819,10 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) !___________________________________________________________________________ ! write out global fields for debugging +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif + if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call write_step_info'//achar(27)//'[0m' call write_step_info(n,logfile_outfreq, ice, dynamics, tracers, partit, mesh) @@ -3832,6 +3836,11 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! togeather around 2.5% of model runtime if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call check_blowup'//achar(27)//'[0m' call check_blowup(n, ice, dynamics, tracers, partit, mesh) + +#if defined(__recom) && defined(__usetp) + endif +#endif + t10=MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_end("oce_blowup_check") @@ -3847,6 +3856,10 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) rtime_oce_GMRedi = rtime_oce_GMRedi + (t6-t5) rtime_oce_solvetra = rtime_oce_solvetra + (t8-t7) rtime_tot = rtime_tot + (t10-t0)-(t10-t9) + +#if defined(__recom) && defined(__usetp) + if(partit%my_fesom_group == 0) then +#endif if(mod(n,logfile_outfreq)==0 .and. mype==0) then write(*,*) '___ALE OCEAN STEP EXECUTION TIMES______________________' write(*,"(A, ES10.3)") ' Oce. Mix,Press.. :', t1-t0 @@ -3865,6 +3878,10 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) write(*,"(A, ES10.3)") ' Oce. TOTAL :', t10-t0 write(*,*) write(*,*) - end if + end if +#if defined(__recom) && defined(__usetp) + endif +#endif + end subroutine oce_timestep_ale diff --git a/src/oce_ale_tracer.F90 b/src/oce_ale_tracer.F90 index dd4ce9101..8d61a7a72 100644 --- a/src/oce_ale_tracer.F90 +++ b/src/oce_ale_tracer.F90 @@ -153,6 +153,8 @@ subroutine solve_tracers_ale(ice, dynamics, tracers, partit, mesh) #if defined(__recom) use recom_glovar use recom_config + use recom_ciso + use o_arrays #endif use diagnostics, only: ldiag_DVD use g_forcing_param, only: use_age_tracer !---age-code @@ -163,8 +165,38 @@ subroutine solve_tracers_ale(ice, dynamics, tracers, partit, mesh) type(t_tracer), intent(inout), target :: tracers type(t_partit), intent(inout), target :: partit type(t_mesh) , intent(in) , target :: mesh + +#if defined(__recom) && defined(__usetp) +! multi FESOM group loop parallelization + integer :: num_tracers + integer :: tr_num_start_memo + + integer :: group_i + integer :: tr_num_start + + logical :: has_one_added_tracer + logical :: has_one_added_tracer_local_dummy + logical :: tr_num_end_local_dummy + logical :: tr_num_in_group_local_dummy + integer :: tr_num_end + logical :: tr_num_in_group_dummy + integer :: tr_arr_slice_count_fix_1 + + integer :: Sinkflx_tr_slice_count_fix_1 + integer :: Benthos_tr_slice_count_fix_1 + + integer :: tr_num_start_local + integer :: tr_num_to_send + + logical :: completed + + logical :: bBreak +#endif + !___________________________________________________________________________ integer :: i, tr_num, node, elem, nzmax, nzmin + real(kind=WP) :: ttf_rhs_bak (mesh%nl-1, partit%myDim_nod2D+partit%eDim_elem2D) ! local variable ! OG - tra_diag + integer :: nz, n, nu1, nl1 ! OG - tra_diag !___________________________________________________________________________ ! pointer on necessary derived types real(kind=WP), dimension(:,:,:), pointer :: UV, fer_UV @@ -184,6 +216,10 @@ subroutine solve_tracers_ale(ice, dynamics, tracers, partit, mesh) end if del_ttf => tracers%work%del_ttf +#if defined(__recom) && defined(__usetp) + num_tracers=tracers%num_tracers +#endif + !___________________________________________________________________________ if (SPP) then if (flag_debug .and. mype==0) print *, achar(27)//'[37m'//' --> call cal_rejected_salt'//achar(27)//'[0m' @@ -210,12 +246,51 @@ subroutine solve_tracers_ale(ice, dynamics, tracers, partit, mesh) !$OMP END PARALLEL DO end if + ! Set advective and diffusive components of total tracer fluxes to zero + ! Before tr_num loop +!#if defined (__recom) ! not necessarily should belong to recom case +! tracers%work%tra_advhoriz = 0.0 ! O:G - tra_diag +! tracers%work%tra_advvert = 0.0 + ttf_rhs_bak = 0.0 +!#endif + !___________________________________________________________________________ ! loop over all tracers !$ACC UPDATE DEVICE(dynamics%w, dynamics%w_e, dynamics%uv) !!! async(1) !!! !$ACC UPDATE DEVICE(tracers%work%fct_ttf_min, tracers%work%fct_ttf_max, tracers%work%fct_plus, tracers%work%fct_minus) !$ACC UPDATE DEVICE (mesh%helem, mesh%hnode, mesh%hnode_new, mesh%zbar_3d_n, mesh%z_3d_n) + +#if defined(__recom) && defined(__usetp) + call calc_slice(num_tracers, num_fesom_groups, partit%my_fesom_group, tr_num_start, tr_num_end, tr_num_in_group_dummy, has_one_added_tracer) + + tr_arr_slice_count_fix_1 = 1 * (nl - 1) * (myDim_nod2D + eDim_nod2D) + + Sinkflx_tr_slice_count_fix_1 = 1 * (myDim_nod2D + eDim_nod2D) * bottflx_num + Benthos_tr_slice_count_fix_1 = 1 * (myDim_nod2D + eDim_nod2D) * benthos_num + + tr_num_start_memo = tr_num_start + + request_count = 0 +#endif + +#if defined(__recom) && defined(__usetp) + do tr_num = tr_num_start, tr_num_end +#else do tr_num=1, tracers%num_tracers +#endif + +#if defined(__recom) + if(use_MEDUSA) then + SinkFlx = 0.0d0 +#if defined(__usetp) + SinkFlx_tr(:, :, tr_num) = 0.0d0 +#endif !__usetp + endif +#if defined(__usetp) + Benthos_tr(:, :, tr_num) = 0.0d0 +#endif !__usetp +#endif !__recom + ! do tracer AB (Adams-Bashfort) interpolation only for advectiv part ! needed @@ -240,16 +315,54 @@ subroutine solve_tracers_ale(ice, dynamics, tracers, partit, mesh) tracers%work%del_ttf(:, node)=tracers%work%del_ttf(:, node)+tracers%work%del_ttf_advhoriz(:, node)+tracers%work%del_ttf_advvert(:, node) end do !$OMP END PARALLEL DO - + +! O:G +! Save horizontal and vertical advective fluxes. +! We have the values on the nodes +! We do not know how much each edge contributes +! to the nodes it connects +! Notes from Patrick: del_ttf includes +! Low-order solution. But, del_ttf_advhoriz and +! del_ttf_advvert contain antidiffusive fluxes +! from the FCT scheme + +!if (.FALSE.) then +! O:G - tra_diag +!#if defined (__recom) +! if (tracers%data(tr_num)%ltra_diag) then +! do n=1, myDim_nod2D+eDim_nod2D +! nu1 = ulevels_nod2D(n) +! nl1 = nlevels_nod2D(n) +! do nz = nu1, nl1-1 + ! Horizontal advection part +! tracers%work%tra_advhoriz(nz,n,tr_num) = tracers%work%del_ttf_advhoriz(nz,n) + ! Vertical advection part +! tracers%work%tra_advvert (nz,n,tr_num) = tracers%work%del_ttf_advvert(nz,n) +! end do +! end do +! end if +!#endif +!endif + !___________________________________________________________________________ ! diffuse tracers if (flag_debug .and. mype==0) print *, achar(27)//'[37m'//' --> call diff_tracers_ale'//achar(27)//'[0m' call diff_tracers_ale(tr_num, dynamics, tracers, ice, partit, mesh) + !___________________________________________________________________________ ! Radioactive decay of 14C and 39Ar if (tracers%data(tr_num)%ID == 14) tracers%data(tr_num)%values(:,:) = tracers%data(tr_num)%values(:,:) * exp(-decay14 * dt) if (tracers%data(tr_num)%ID == 39) tracers%data(tr_num)%values(:,:) = tracers%data(tr_num)%values(:,:) * exp(-decay39 * dt) - + +!YY: C14 seems to be calculated both in fesom and recom +!YY: decay differently calculated??? +#if defined(__recom) + ! radioactive decay of 14C + if (ciso_14 .and. any(c14_tracer_id == tracers%data(tr_num)%ID)) then + tracers%data(tr_num)%values(:,:) = tracers%data(tr_num)%values(:,:) * (1 - lambda_14 * dt) + end if ! ciso & ciso_14 +#endif + !___________________________________________________________________________ ! relax to salt and temp climatology if (flag_debug .and. mype==0) print *, achar(27)//'[37m'//' --> call relax_to_clim'//achar(27)//'[0m' @@ -268,10 +381,92 @@ subroutine solve_tracers_ale(ice, dynamics, tracers, partit, mesh) call exchange_nod(tracers%data(tr_num)%values(:,:), partit) !$OMP BARRIER - end do !!! !$ACC UPDATE HOST (tracers%work%fct_ttf_min, tracers%work%fct_ttf_max, tracers%work%fct_plus, tracers%work%fct_minus) & !!! !$ACC HOST (tracers%work%edge_up_dn_grad) +#if defined(__recom) && defined(__usetp) +! broadcast tracer results to fesom groups + if(num_fesom_groups > 1) then + + do group_i = 0, num_fesom_groups - 1 + call calc_slice(num_tracers, num_fesom_groups, group_i, tr_num_start_local, tr_num_end_local_dummy, tr_num_in_group_local_dummy, has_one_added_tracer_local_dummy) + + tr_num_to_send = tr_num_start_local + (tr_num - tr_num_start_memo) + + if((tr_num == tr_num_end) .and. has_one_added_tracer) then + ! skip: if last tracer in group was added to compensate for fragementation it is skipped here and handled after the loop + else + request_count = request_count + 1 + +! non-blocking communication overlapped with computation in loop + call MPI_IBcast(tracers%data(tr_num_to_send)%values(:, :), tr_arr_slice_count_fix_1, MPI_DOUBLE_PRECISION, & + group_i, MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, tr_arr_requests(request_count), MPIerr) + + if(use_MEDUSA) then + call MPI_IBcast(Sinkflx_tr (:, :, tr_num_to_send), Sinkflx_tr_slice_count_fix_1, MPI_DOUBLE_PRECISION, & + group_i, MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, SinkFlx_tr_requests(request_count), MPIerr) + endif + call MPI_IBcast(Benthos_tr (:, :, tr_num_to_send), Benthos_tr_slice_count_fix_1, MPI_DOUBLE_PRECISION, & + group_i, MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, Benthos_tr_requests(request_count), MPIerr) + end if + end do + end if ! (num_fesom_groups > 1) then +#endif + end do ! EITHER: tr_num = tr_num_start, tr_num_end OR 1, tracers%num_tracers, depending on __usetp + +#if defined(__recom) && defined(__usetp) +! if tracer in group was added to compensate for fragmentation its broadcast of the last index is handled here + if(num_fesom_groups > 1) then + do group_i = 0, num_fesom_groups - 1 + call calc_slice(num_tracers, num_fesom_groups, group_i, tr_num_start, tr_num_end, tr_num_in_group_dummy, has_one_added_tracer) + + if(has_one_added_tracer) then + + request_count = request_count + 1 + + call MPI_IBcast(tracers%data(tr_num_end)%values(:, :), tr_arr_slice_count_fix_1, MPI_DOUBLE_PRECISION, & + group_i, MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, tr_arr_requests(request_count), MPIerr) + if(use_MEDUSA) then + call MPI_IBcast(Sinkflx_tr (:, :, tr_num_end), Sinkflx_tr_slice_count_fix_1, MPI_DOUBLE_PRECISION, & + group_i, MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, SinkFlx_tr_requests(request_count), MPIerr) + endif + call MPI_IBcast(Benthos_tr (:, :, tr_num_end), Benthos_tr_slice_count_fix_1, MPI_DOUBLE_PRECISION, & + group_i, MPI_COMM_FESOM_SAME_RANK_IN_GROUPS, Benthos_tr_requests(request_count), MPIerr) + end if + end do + end if !(num_fesom_groups > 1) then + + if(num_fesom_groups > 1) then + completed = .false. + do while (.not. completed) + call MPI_TESTALL(request_count, tr_arr_requests(:), completed, MPI_STATUSES_IGNORE, MPIerr) + end do + + if(use_MEDUSA) then + completed = .false. + do while (.not. completed) + call MPI_TESTALL(request_count, SinkFlx_tr_requests(:), completed, MPI_STATUSES_IGNORE, MPIerr) + end do + endif ! (use_MEDUSA) then + + completed = .false. + do while (.not. completed) + call MPI_TESTALL(request_count, Benthos_tr_requests(:), completed, MPI_STATUSES_IGNORE, MPIerr) + end do + end if ! (num_fesom_groups > 1) then +#endif + +#if defined(__recom) && defined(__usetp) +! SinkFlx and Benthos values are buffered per tracer index in the loop above and now summed up to +! avoid non bit identical results regarding global sums when running the tracer loop in parallel + do tr_num = 1, num_tracers + if(use_MEDUSA) then + SinkFlx = SinkFlx + SinkFlx_tr(:, :, tr_num) + endif + Benthos = Benthos + Benthos_tr(:, :, tr_num) + end do +#endif + !___________________________________________________________________________ ! 3D restoring for "passive" tracers !!!$OMPTODO: add OpenMP later, not needed right now! @@ -364,6 +559,8 @@ subroutine diff_tracers_ale(tr_num, dynamics, tracers, ice, partit, mesh) type(t_mesh) , intent(in) , target :: mesh !___________________________________________________________________________ integer :: n, nzmax, nzmin + real(kind=WP) :: ttf_rhs_bak (mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D) ! OG - tra_diag + integer :: nz, nu1, nl1 ! OG - tra_diag !___________________________________________________________________________ ! pointer on necessary derived types real(kind=WP), pointer :: del_ttf(:,:) @@ -378,21 +575,91 @@ subroutine diff_tracers_ale(tr_num, dynamics, tracers, ice, partit, mesh) vert_sink = 0.0_WP #endif + ttf_rhs_bak = 0.0 ! OG - tra_diag + + if (tracers%data(tr_num)%ltra_diag) then ! OG - tra_diag + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ttf_rhs_bak(nz,n) = del_ttf(nz,n) + end do + end do + end if + !___________________________________________________________________________ - ! do horizontal diffusiion + ! do horizontal diffusion ! write there also horizontal diffusion rhs to del_ttf which is equal the R_T^n ! in danilovs srcipt ! includes Redi diffusivity if Redi=.true. call diff_part_hor_redi(tracers, partit, mesh) ! seems to be ~9% faster than diff_part_hor - + + if (tracers%data(tr_num)%ltra_diag) then ! OG - tra_diag + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ! horizontal diffusion (w/out Redi) + tracers%work%tra_diff_part_hor_redi(nz,n,tr_num) = (del_ttf(nz,n) - ttf_rhs_bak(nz,n)) / hnode_new(nz,n) ! Unit [Conc] + !if (mype==0) print *, tracers%work%tra_diff_part_hor_redi(nz,n,tr_num) + end do + end do + end if + + if ((.not. tracers%data(tr_num)%i_vert_diff) .and. tracers%data(tr_num)%ltra_diag) then ! OG - tra_diag + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ttf_rhs_bak(nz,n) = del_ttf(nz,n) + end do + end do + end if !___________________________________________________________________________ ! do vertical diffusion: explicit if (.not. tracers%data(tr_num)%i_vert_diff) call diff_ver_part_expl_ale(tr_num, tracers, partit, mesh) - + + ! OG i_vert_diff = TRUE so, we dont call explicit scheme + ! If we use this, check surface forcing for recom variables (They are not updated) + if ((.not. tracers%data(tr_num)%i_vert_diff) .and. tracers%data(tr_num)%ltra_diag) then ! OG - tra_diag + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ! vertical diffusion: explicit + tracers%work%tra_diff_part_ver_expl(nz,n,tr_num) = (del_ttf(nz,n) - ttf_rhs_bak(nz,n)) / hnode_new(nz,n) ! Unit [Conc] + !if (mype==0) print *, tra_diff_part_ver_expl(:,:,tr_num) + end do + end do + end if + ! A projection of horizontal Redi diffussivity onto vertical. This par contains horizontal ! derivatives and has to be computed explicitly! + + if (tracers%data(tr_num)%ltra_diag .and. Redi) then ! OG - tra_diag + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ttf_rhs_bak(nz,n) = del_ttf(nz,n) + end do + end do + end if + if (Redi) call diff_ver_part_redi_expl(tracers, partit, mesh) + if (tracers%data(tr_num)%ltra_diag .and. Redi) then ! OG - tra_diag + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ! Redi diffussivity onto vertical: explicit + tracers%work%tra_diff_part_ver_redi_expl(nz,n,tr_num) = (del_ttf(nz,n) - ttf_rhs_bak(nz,n)) / hnode_new(nz,n) ! Unit [Conc] + !if (mype==0) print *, tra_diff_part_ver_redi_expl(:,:,tr_num) + end do + end do + end if + ! if (recom_debug .and. mype==0) print *, tracers%data(tr_num)%ID #if defined(__recom) @@ -479,7 +746,32 @@ subroutine diff_tracers_ale(tr_num, dynamics, tracers, ice, partit, mesh) !___________________________________________________________________________ if (tracers%data(tr_num)%i_vert_diff) then ! do vertical diffusion: implicite + + if (tracers%data(tr_num)%ltra_diag) then ! OG - tra_diag + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + ttf_rhs_bak(nz,n) = tracers%data(tr_num)%values(nz,n) + end do + end do + end if + + ! (w/out Redi) call diff_ver_part_impl_ale(tr_num, dynamics, tracers, ice, partit, mesh) + + ! vertical diffusion: implicit + if (tracers%data(tr_num)%ltra_diag) then ! OG - tra_diag + do n=1, myDim_nod2D+eDim_nod2D + nu1 = ulevels_nod2D(n) + nl1 = nlevels_nod2D(n) + do nz = nu1, nl1-1 + tracers%work%tra_diff_part_ver_impl(nz,n,tr_num) = tracers%data(tr_num)%values(nz,n) - ttf_rhs_bak(nz,n) + !if (mype==0) print *, tra_diff_part_ver_impl(:,:,tr_num) + end do + end do + end if + end if !We DO not set del_ttf to zero because it will not be used in this timestep anymore @@ -1482,6 +1774,8 @@ FUNCTION bc_surface(n, id, sval, nzmin, partit, mesh, sst, sss, aice) #if defined (__recom) use recoM_declarations use recom_glovar + use recom_config + use recom_ciso #endif use mod_transit use g_clock @@ -1609,16 +1903,35 @@ FUNCTION bc_surface(n, id, sval, nzmin, partit, mesh, sst, sss, aice) !--- Done with boundary conditions for transient tracers. #if defined(__recom) CASE (1001) ! DIN + if (use_MEDUSA .and. add_loopback) then ! OG: add is_MEDUSA_loopback flag is_MEDUSA_loopback flag * lb_flux(n,1) + bc_surface= dt*(AtmNInput(n) + RiverDIN2D(n) * is_riverinput & + + ErosionTON2D(n) * is_erosioninput + lb_flux(n,1)) + else bc_surface= dt*(AtmNInput(n) + RiverDIN2D(n) * is_riverinput & + ErosionTON2D(n) * is_erosioninput) + end if + CASE (1002) ! DIC + if (use_MEDUSA .and. add_loopback) then + bc_surface= dt*(GloCO2flux_seaicemask(n) & + + RiverDIC2D(n) * is_riverinput & + + ErosionTOC2D(n) * is_erosioninput & + + lb_flux(n,2) + lb_flux(n,5)) + else bc_surface= dt*(GloCO2flux_seaicemask(n) & + RiverDIC2D(n) * is_riverinput & + ErosionTOC2D(n) * is_erosioninput) + end if + CASE (1003) ! Alk + if (use_MEDUSA .and. add_loopback) then + bc_surface= dt*(virtual_alk(n) + relax_alk(n) & + + RiverAlk2D(n) * is_riverinput & + + lb_flux(n,3) + lb_flux(n,5)*2) !CaCO3:Alk burial=1:2 + else bc_surface= dt*(virtual_alk(n) + relax_alk(n) & + RiverAlk2D(n) * is_riverinput) - !bc_surface=0.0_WP + end if CASE (1004:1010) bc_surface=0.0_WP CASE (1011) ! DON @@ -1628,16 +1941,53 @@ FUNCTION bc_surface(n, id, sval, nzmin, partit, mesh, sst, sss, aice) CASE (1013:1017) bc_surface=0.0_WP CASE (1018) ! DSi - bc_surface=dt*(RiverDSi2D(n) * is_riverinput + ErosionTSi2D(n) * is_erosioninput) + if (use_MEDUSA .and. add_loopback) then + bc_surface=dt*(RiverDSi2D(n) * is_riverinput & + + ErosionTSi2D(n) * is_erosioninput & + + lb_flux(n,4)) + else + bc_surface=dt*(RiverDSi2D(n) * is_riverinput + ErosionTSi2D(n) * is_erosioninput) + end if + CASE (1019) ! Fe + if (useRivFe) then + bc_surface= dt*(AtmFeInput(n) + RiverFe(n)) + else bc_surface= dt*AtmFeInput(n) + end if CASE (1020:1021) ! Cal bc_surface=0.0_WP CASE (1022) ! OXY bc_surface= dt*GloO2flux_seaicemask(n) ! bc_surface=0.0_WP - CASE (1023:1035) + CASE (1023:1033) bc_surface=0.0_WP ! OG added bc for recom fields + CASE (1302) + if (ciso) then + if (use_MEDUSA .and. add_loopback) then + bc_surface= dt*(GloCO2flux_seaicemask_13(n) & + + lb_flux(n,6) + lb_flux(n,7)) + else + bc_surface= dt*(GloCO2flux_seaicemask_13(n)) + end if + else + bc_surface=0.0_WP + end if + CASE (1305:1321) + bc_surface=0.0_WP ! organic 13C + CASE (1402) + if (ciso .and. ciso_14) then + if (use_MEDUSA .and. add_loopback .and. ciso_organic_14) then + bc_surface= dt*(GloCO2flux_seaicemask_14(n) & + + lb_flux(n,8) + lb_flux(n,9)) + else + bc_surface= dt*GloCO2flux_seaicemask_14(n) + end if + else + bc_surface=0.0_WP + end if + CASE (1405:1421) + bc_surface=0.0_WP ! organic 14C #endif CASE (101) ! apply boundary conditions to tracer ID=101 bc_surface= dt*(prec_rain(n))! - real_salt_flux(n)*is_nonlinfs) @@ -1676,5 +2026,176 @@ FUNCTION bc_surface(n, id, sval, nzmin, partit, mesh, sst, sss, aice) stop END SELECT RETURN +END FUNCTION + +!=============================================================================== +! This function returns a boundary conditions for a specified transient tracer ID and surface node. +! Different to function bc_surface, SST, SSS, and sea ice concentrations are always needed as +! auxiliary variable +FUNCTION transit_bc_surface(n, id, sst, sss, aice, sval, nzmin, partit, mesh) + use MOD_MESH + USE MOD_PARTIT + USE MOD_PARSUP + USE o_ARRAYS + USE g_forcing_arrays + USE g_config + use g_clock + use mod_transit + implicit none + + integer, intent(in) :: n, id, nzmin + real(kind=WP), intent(in) :: sst, sss, aice, sval + type(t_partit),intent(inout), target :: partit + type(t_mesh), intent(in), target :: mesh + REAL(kind=WP) :: transit_bc_surface + character(len=10) :: id_string + + + ! --> is_nonlinfs=1.0 for zelvel,zstar .... + ! --> is_nonlinfs=0.0 for linfs + +#if defined (__oasis) +! SLP and wind speed in coupled setups. This is a makeshift solution +! as long as the true values are not provided by the AGCM / OASIS. + press_a = mean_slp + wind_2 = speed_2(stress_atmoce_x(n), stress_atmoce_y(n)) +#else + press_a = press_air(n) + wind_2 = u_wind(n)**2 + v_wind(n)**2 +#endif + +! The atmospheric input of bomb 14C, CFC-12, and SF6 depends on latitude. To that effect specify + y_abc = mesh%geo_coord_nod2D(2,n) / rad ! latitude of atmospheric tracer input + yy_nh = (10. - y_abc) * 0.05 ! interpolation weight for tropical tracer values + + + SELECT CASE (id) + +! Boundary conditions for additional (transient) tracers (14C, 39Ar, CFC-12, and SF6) + CASE (14) ! Radiocarbon (more precisely, fractionation-corrected 14C/C): + if (anthro_transit) then +! Select atmospheric input values corresponding to the latitude + if (y_abc > 30.) then +! Northern Hemisphere + r14c_a = r14c_nh(ti_transit) + else if (y_abc <- 30.) then +! Southern Hemisphere + r14c_a = r14c_sh(ti_transit) + else +! Tropical zone + r14c_a = r14c_tz(ti_transit) + end if + xCO2_a = xCO2_ti(ti_transit) + else if (paleo_transit) then + r14c_a = r14c_ti(ti_transit) + xCO2_a = xCO2_ti(ti_transit) + else +! Constant (global-mean) namelist values are taken + end if +! Local isotopic 14CO2/CO2 air-sea exchange flux (in m / s), +! since F14C is normalized to atmospheric (water) values the isotopic flux has to be +! corrected for precipitation or evaporation fluxes with different isotopic signatures. + transit_bc_surface = dt * (iso_flux("co2", sst, sss, wind_2, aice, press_a, xco2_a, r14c_a, sval, dic_0) & + - sval * water_flux(n) * is_nonlinfs) + + CASE (39) ! Argon-39 (fractionationation-corrected 39Ar/Ar) +! Local isotopic 39Ar/Ar air-sea exchange flux (in m / s), +! since F39Ar is normalized to atmospheric (water) values the isotopic flux has to be +! corrected for precipitation or evaporation fluxes with different isotopic signatures. + transit_bc_surface = dt * (iso_flux("arg", sst, sss, wind_2, aice, press_a, xarg_a, r39ar_a, sval, arg_0) & + - sval * water_flux(n) * is_nonlinfs) + + CASE (12) ! CFC-12 + if (anthro_transit) then +! Select atmospheric input values corresponding to the latitude +! Annual values are interpolated to monthly values, this is omitted in the last simulation year + if (y_abc > 10.) then ! Northern Hemisphere +! Northern Hemisphere + xf12_a = xf12_nh(ti_transit) + if (ti_transit < length_transit) xf12_a = xf12_a + month * (xf12_nh(ti_transit + 1) - xf12_a) / 12. + else if (y_abc <- 10.) then +! Southern Hemisphere + xf12_a = xf12_sh(ti_transit) + if (ti_transit < length_transit) xf12_a = xf12_a + month * (xf12_sh(ti_transit + 1) - xf12_a) / 12. + else +! Tropical zone, interpolate between NH and SH + xf12_a = (1 - yy_nh) * xf12_nh(ti_transit) + yy_nh * xf12_sh(ti_transit) + if (ti_transit < length_transit) & + xf12_a = xf12_a + month * ((1 - yy_nh) * xf12_nh(ti_transit + 1) + yy_nh * xf12_sh(ti_transit + 1) - xf12_a) / 12. + end if + else +! Constant (global-mean) namelist values are taken + end if + +! Local air-sea exchange gas flux of CFC-12 (in m / s): + transit_bc_surface = dt * (gas_flux("f12", sst, sss, wind_2, aice, press_a, xf12_a, sval) & + - sval * water_flux(n) * is_nonlinfs) + + CASE (6) ! SF6 + if (anthro_transit) then +! Select atmospheric input values corresponding to the latitude +! Annual values are interpolated to monthly values, this is omitted in the last simulation year + if (y_abc > 10.) then ! Northern Hemisphere +! Northern Hemisphere + xsf6_a = xsf6_nh(ti_transit) + if (ti_transit < length_transit) xsf6_a = xsf6_a + month * (xsf6_nh(ti_transit + 1) - xsf6_a) / 12. + else if (y_abc <- 10.) then +! Southern Hemisphere + xsf6_a = xsf6_sh(ti_transit) + if (ti_transit < length_transit) xsf6_a = xsf6_a + month * (xsf6_sh(ti_transit + 1) - xsf6_a) / 12. + else +! Tropical zone, interpolate between NH and SH + xsf6_a = (1 - yy_nh) * xsf6_nh(ti_transit) + yy_nh * xsf6_sh(ti_transit) + if (ti_transit < length_transit) & + xsf6_a = xsf6_a + month * ((1 - yy_nh) * xsf6_nh(ti_transit + 1) + yy_nh * xsf6_sh(ti_transit + 1) - xsf6_a) / 12. + end if + else +! Constant (global-mean) namelist values are taken + end if + +! Local air-sea exchange gas flux of SF6 (in m / s): + transit_bc_surface = dt * (gas_flux("sf6", sst, sss, wind_2, aice, press_a, xsf6_a, sval) & + - sval * water_flux(n) * is_nonlinfs) + +! Done with boundary conditions for (transient) tracers. + END SELECT + RETURN + +END FUNCTION + +!=============================================================================== +! divide the range specified by indexcount into fesom_group_count equal slices and calculate +! the start_index and end_index for the given fesom_group_id. +! if necessary to compensate for fragmentation, the end index of the first n slices +! might be one higher than for the remaining slices. this is indicated by end_index_is_one_higher +subroutine calc_slice(index_count, fesom_group_count, fesom_group_id, start_index, end_index, index_count_in_group, end_index_is_one_higher) +! use g_config + + implicit none + integer, intent(in) :: index_count + integer, intent(in) :: fesom_group_count + integer, intent(in) :: fesom_group_id + integer, intent(out) :: start_index + integer, intent(out) :: end_index + integer, intent(out) :: index_count_in_group + logical, intent(out) :: end_index_is_one_higher + + integer :: group_id_limit_to_adjust_end_index + + index_count_in_group = index_count / fesom_group_count + group_id_limit_to_adjust_end_index = mod(index_count, fesom_group_count) + start_index = (fesom_group_id * index_count_in_group) + 1 + +! adjust loop start and number of loop iterations by 1 if necessary + if(fesom_group_id < group_id_limit_to_adjust_end_index) then + start_index = start_index + fesom_group_id + index_count_in_group = index_count_in_group + 1 + end_index_is_one_higher = .true. + else + start_index = start_index + group_id_limit_to_adjust_end_index + end_index_is_one_higher = .false. + end if + + end_index = start_index + index_count_in_group - 1 +end subroutine calc_slice -end function bc_surface diff --git a/src/oce_mesh.F90 b/src/oce_mesh.F90 index ab240626d..e3b51c7d7 100755 --- a/src/oce_mesh.F90 +++ b/src/oce_mesh.F90 @@ -341,7 +341,13 @@ SUBROUTINE read_mesh(partit, mesh) read(fileID,*) n ! nod2D, we know it already error_status=0 if (n/=mesh%nod2D) error_status=1 !set the error status for consistency between rpart and nod2D +#if defined(__recom) && defined(__usetp) + if (partit%my_fesom_group==0) then +#endif write(*,*) 'reading '// trim(file_name) +#if defined(__recom) && defined(__usetp) + end if +#endif end if ! check the error status call MPI_BCast(error_status, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) diff --git a/src/oce_modules.F90 b/src/oce_modules.F90 index a71f60758..798688a98 100755 --- a/src/oce_modules.F90 +++ b/src/oce_modules.F90 @@ -250,6 +250,13 @@ MODULE o_ARRAYS #if defined(__recom) real(kind=WP), allocatable :: dtr_bf(:,:), str_bf(:,:) real(kind=WP), allocatable :: vert_sink(:,:) +#if defined(__usetp) +integer :: request_count +integer, allocatable :: tr_arr_requests(:), tr_arr_old_requests(:) + +integer, allocatable :: SinkFlx_tr_requests(:) +integer, allocatable :: Benthos_tr_requests(:) +#endif #endif !Viscosity and diff coefs diff --git a/src/oce_setup_step.F90 b/src/oce_setup_step.F90 index 68c2b4f2e..a98d078c5 100755 --- a/src/oce_setup_step.F90 +++ b/src/oce_setup_step.F90 @@ -315,12 +315,12 @@ SUBROUTINE tracer_init(tracers, partit, mesh) !___________________________________________________________________________ ! define tracer namelist parameter integer :: num_tracers - logical :: i_vert_diff, smooth_bh_tra + logical :: i_vert_diff, smooth_bh_tra , ltra_diag ! OG - tra_diag real(kind=WP) :: gamma0_tra, gamma1_tra, gamma2_tra integer :: AB_order = 2 namelist /tracer_listsize/ num_tracers namelist /tracer_list / nml_tracer_list - namelist /tracer_general / smooth_bh_tra, gamma0_tra, gamma1_tra, gamma2_tra, i_vert_diff, AB_order + namelist /tracer_general / smooth_bh_tra, gamma0_tra, gamma1_tra, gamma2_tra, i_vert_diff, AB_order, ltra_diag ! OG - tra_diag !___________________________________________________________________________ ! pointer on necessary derived types #include "associate_part_def.h" @@ -478,6 +478,7 @@ SUBROUTINE tracer_init(tracers, partit, mesh) tracers%data(n)%valuesAB = 0. tracers%data(n)%valuesold = 0. tracers%data(n)%i_vert_diff = i_vert_diff + tracers%data(n)%ltra_diag = ltra_diag ! OG - tra_diag end do allocate(tracers%work%del_ttf(nl-1,node_size)) allocate(tracers%work%del_ttf_advhoriz(nl-1,node_size),tracers%work%del_ttf_advvert(nl-1,node_size)) @@ -490,6 +491,20 @@ SUBROUTINE tracer_init(tracers, partit, mesh) tracers%work%dvd_trflx_hor = 0.0_WP tracers%work%dvd_trflx_ver = 0.0_WP end if + if (ltra_diag) then ! OG - tra_diag + allocate(tracers%work%tra_advhoriz(nl-1,node_size,num_tracers),tracers%work%tra_advvert(nl-1,node_size,num_tracers)) + tracers%work%tra_advhoriz = 0.0_WP + tracers%work%tra_advvert = 0.0_WP + allocate(tracers%work%tra_diff_part_hor_redi(nl-1,node_size,num_tracers),tracers%work%tra_diff_part_ver_expl(nl-1,node_size,num_tracers)) + allocate(tracers%work%tra_diff_part_ver_redi_expl(nl-1,node_size,num_tracers),tracers%work%tra_diff_part_ver_impl(nl-1,node_size,num_tracers)) + allocate(tracers%work%tra_recom_sms(nl-1,node_size,num_tracers)) + tracers%work%tra_diff_part_hor_redi = 0.0_WP + tracers%work%tra_diff_part_ver_expl = 0.0_WP + tracers%work%tra_diff_part_ver_redi_expl = 0.0_WP + tracers%work%tra_diff_part_ver_impl = 0.0_WP + tracers%work%tra_recom_sms = 0.0_WP + + end if END SUBROUTINE tracer_init ! ! @@ -878,6 +893,11 @@ SUBROUTINE arrays_init(num_tracers, partit, mesh) allocate(str_bf ( nl-1, node_size )) allocate(vert_sink ( nl-1, node_size )) allocate(Alk_surf ( node_size )) +#if defined(__usetp) + allocate(tr_arr_requests(num_tracers), tr_arr_old_requests(num_tracers)) + allocate(SinkFlx_tr_requests(num_tracers)) + allocate(Benthos_tr_requests(num_tracers)) +#endif #endif ! ================= ! Visc and Diff coefs @@ -990,6 +1010,12 @@ SUBROUTINE arrays_init(num_tracers, partit, mesh) str_bf = 0.0_WP vert_sink = 0.0_WP Alk_surf = 0.0_WP +#if defined(__usetp) + tr_arr_requests = 0 + tr_arr_old_requests = 0 + SinkFlx_tr_requests = 0 + Benthos_tr_requests = 0 +#endif #endif ! init field for pressure force @@ -1085,6 +1111,9 @@ SUBROUTINE oce_initial_state(tracers, partit, mesh) end if if (mype==0) then +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif write(*,*) print *, achar(27)//'[36m'//'*************************'//achar(27)//'[0m' print *, achar(27)//'[36m'//' --> RECOM ON'//achar(27)//'[0m' @@ -1109,6 +1138,9 @@ SUBROUTINE oce_initial_state(tracers, partit, mesh) write(*,*) 'read Nitrate climatology from:', trim(filelist(6)) write(*,*) 'read Salt climatology from:', trim(filelist(7)) write(*,*) 'read Temperature climatology from:', trim(filelist(8)) +#if defined(__usetp) + end if ! (partit%my_fesom_group==0) then +#endif end if ! read ocean state ! this must be always done! First two tracers with IDs 0 and 1 are the temperature and salinity. @@ -1125,9 +1157,10 @@ SUBROUTINE oce_initial_state(tracers, partit, mesh) ! this must be always done! First two tracers with IDs 0 and 1 are the temperature and salinity. if(mype==0) write(*,*) 'read Temperature climatology from:', trim(filelist(1)) if(mype==0) write(*,*) 'read Salinity climatology from:', trim(filelist(2)) - #endif + if(any(idlist == 14) .and. mype==0) write(*,*) 'read radiocarbon climatology from:', trim(filelist(3)) + call do_ic3d(tracers, partit, mesh) Tclim=tracers%data(1)%values @@ -1145,9 +1178,17 @@ SUBROUTINE oce_initial_state(tracers, partit, mesh) #if defined(__recom) if (restore_alkalinity) then + +#if defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (mype==0) write(*,*) if (mype==0) print *, achar(27)//'[46;1m'//' --> Set surface field for alkalinity restoring'//achar(27)//'[0m' - if (mype==0) write(*,*) + if (mype==0) write(*,*) 'Alkalinity restoring = true. Field is read.' +#if defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + Alk_surf = tracers%data(5)%values(1,:) ! alkalinity is the 5th tracer endif @@ -1182,26 +1223,101 @@ SUBROUTINE oce_initial_state(tracers, partit, mesh) !_______________________________________________________________________ CASE (1004:1017) tracers%data(i)%values(:,:)=0.0_WP +#if defined(__recom) && defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (mype==0) then write (i_string, "(I4)") i write (id_string, "(I4)") id write(*,*) 'initializing '//trim(i_string)//'th tracer with ID='//trim(id_string) end if +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif CASE (1020:1021) tracers%data(i)%values(:,:)=0.0_WP +#if defined(__recom) && defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (mype==0) then write (i_string, "(I4)") i write (id_string, "(I4)") id write(*,*) 'initializing '//trim(i_string)//'th tracer with ID='//trim(id_string) end if +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif CASE (1023:1033) tracers%data(i)%values(:,:)=0.0_WP +#if defined(__recom) && defined(__usetp) + if (partit%my_fesom_group==0) then +#endif if (mype==0) then write (i_string, "(I4)") i write (id_string, "(I4)") id write(*,*) 'initializing '//trim(i_string)//'th tracer with ID='//trim(id_string) end if - !_______________________________________________________________________ +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif +!_______________________________________________________________________ +! Carbon isotopes +! Carbon-13 + CASE (1302) + tracers%data(i)%values(:,:)=0.0_WP +#if defined(__recom) && defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) then + write (i_string, "(I4)") i + write (id_string, "(I4)") id + write(*,*) 'initializing '//trim(i_string)//'th tracer with ID='//trim(id_string) + end if +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + CASE (1305:1321) + tracers%data(i)%values(:,:)=0.0_WP +#if defined(__recom) && defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) then + write (i_string, "(I4)") i + write (id_string, "(I4)") id + write(*,*) 'initializing '//trim(i_string)//'th tracer with ID='//trim(id_string) + end if +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif +! Radiocarbon + CASE (1402) + tracers%data(i)%values(:,:)=0.0_WP +#if defined(__recom) && defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) then + write (i_string, "(I4)") i + write (id_string, "(I4)") id + write(*,*) 'initializing '//trim(i_string)//'th tracer with ID='//trim(id_string) + end if +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif + CASE (1405:1421) + tracers%data(i)%values(:,:)=0.0_WP +#if defined(__recom) && defined(__usetp) + if (partit%my_fesom_group==0) then +#endif + if (mype==0) then + write (i_string, "(I4)") i + write (id_string, "(I4)") id + write(*,*) 'initializing '//trim(i_string)//'th tracer with ID='//trim(id_string) + end if +#if defined(__recom) && defined(__usetp) + endif !(partit%my_fesom_group==0) then +#endif +! End of carbon isotopes section +!_______________________________________________________________________ CASE (101) ! initialize tracer ID=101 tracers%data(i)%values(:,:)=0.0_WP if (mype==0) then