diff --git a/ROMS/External/sediment_estuary_test.in b/ROMS/External/sediment_estuary_test.in index 65d7cafa..c854cfde 100644 --- a/ROMS/External/sediment_estuary_test.in +++ b/ROMS/External/sediment_estuary_test.in @@ -142,33 +142,65 @@ ad_LBC(isTvar) == RadNud Clo Cla Clo ! idsed(:), compact BEDLOAD_COEFF == 0.05d0 -! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters -! into HISTORY output files, [1:Ngrids] values expected. - - Hout(ithck) == T ! bed_thickness sediment layer thickness - Hout(iaged) == T ! bed_age sediment layer age - Hout(iporo) == T ! bed_porosity sediment layer porosity - Hout(idiff) == F ! bed_biodiff biodiffusivity - -! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment -! parameters into HISTORY output files, [1:Ngrids] values expected. +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + +! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + +! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + +! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + +! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + +! Logical switches (TRUE/FALSE) to activate writing of bed layer +! parameters, [1:Ngrids] values expected. + + Hout(ithck) == T ! sediment layer thickness + Hout(iaged) == T ! sediment layer age + Hout(iporo) == T ! sediment layer porosity + Hout(idiff) == T ! biodiffusivity + +! Logical switches (TRUE/FALSE) to activate writing of bed +! bottom sediment parameters, [1:Ngrids] values expected. + + Hout(isd50) == T ! mean grain diameter + Hout(idens) == T ! mean grain density + Hout(iwsed) == T ! mean settling velocity + Hout(itauc) == T ! critical erosion stress + Hout(irlen) == T ! ripple length + Hout(irhgt) == T ! ripple height + Hout(ibwav) == T ! wave excursion amplitude + Hout(izdef) == T ! default bottom roughness + Hout(izapp) == T ! apparent bottom roughness + Hout(izNik) == F ! Nikuradse bottom roughness + Hout(izbio) == F ! biological bottom roughness + Hout(izbfm) == F ! bed form bottom roughness + Hout(izbld) == F ! bed load bottom roughness + Hout(izwbl) == F ! wave bottom roughness + Hout(iactv) == F ! active layer thickness + Hout(ishgt) == F ! saltation height + Hout(imaxD) == F ! maximum inundation depth + Hout(idnet) == F ! Erosion or deposition + Hout(idoff) == F ! dmix erodibility profile offset + Hout(idslp) == F ! dmix or erodibility slope + Hout(idtim) == F ! erodibility profile restore time + Hout(idbmx) == F ! Bed biodifusivity maximum + Hout(idbmm) == F ! Bed biodifusivity minimum + Hout(idbzs) == F ! Bed biodifusivity zs + Hout(idbzm) == F ! Bed biodifusivity zm + Hout(idbzp) == F ! Bed biodifusivity phi + Hout(idprp) == F ! cohesive behavior - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == T ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == F ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == F ! Zo_bio biological bottom roughness - Hout(izbfm) == F ! Zo_bedform bed form bottom roughness - Hout(izbld) == F ! Zo_bedload bed load bottom roughness - Hout(izwbl) == F ! Zo_wbl wave bottom roughness - Hout(iactv) == F ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +492,131 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 ! ! GLOSSARY: ! ========= @@ -638,6 +795,17 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! layer is created. ! ! BEDLOAD_COEFF Bed load transport rate coefficient. + +! +! DBMAX Maximum biodiffusivity +! +! DBMIN Minimum biodiffusivity +! +! DBZS Depth of maximum biodiffusivity +! +! DBZM Depth of end of exponential biodiffusivity +! +! DBZP Depth of minimum biodiffusivity ! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output HISTORY NetCDF file: @@ -685,6 +853,29 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1165,3 +1356,79 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + diff --git a/ROMS/External/sediment_inlet_test.in b/ROMS/External/sediment_inlet_test.in index 52bb4739..4f1934b1 100644 --- a/ROMS/External/sediment_inlet_test.in +++ b/ROMS/External/sediment_inlet_test.in @@ -142,6 +142,26 @@ ad_LBC(isTvar) == Gra Clo Gra Gra ! idsed(:), compact BEDLOAD_COEFF == 0.15d0 +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + +! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + +! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + +! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + +! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters, ! [1:Ngrids] values expected. @@ -153,22 +173,33 @@ ad_LBC(isTvar) == Gra Clo Gra Gra ! idsed(:), compact ! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment ! parameters, [1:Ngrids] values expected. - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == T ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == F ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == F ! Zo_bio biological bottom roughness - Hout(izbfm) == F ! Zo_bedform bed form bottom roughness - Hout(izbld) == F ! Zo_bedload bed load bottom roughness - Hout(izwbl) == F ! Zo_wbl wave bottom roughness - Hout(iactv) == F ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height + Hout(isd50) == T ! mean grain diameter + Hout(idens) == T ! mean grain density + Hout(iwsed) == T ! mean settling velocity + Hout(itauc) == T ! critical erosion stress + Hout(irlen) == T ! ripple length + Hout(irhgt) == T ! ripple height + Hout(ibwav) == T ! wave excursion amplitude + Hout(izdef) == T ! default bottom roughness + Hout(izapp) == T ! apparent bottom roughness + Hout(izNik) == T ! Nikuradse bottom roughness + Hout(izbio) == T ! biological bottom roughness + Hout(izbfm) == T ! bed form bottom roughness + Hout(izbld) == T ! bed load bottom roughness + Hout(izwbl) == T ! wave bottom roughness + Hout(iactv) == T ! active layer thickness + Hout(ishgt) == F ! saltation height + Hout(imaxD) == F ! maximum inundation depth + Hout(idnet) == F ! Erosion or deposition + Hout(idoff) == F ! dmix erodibility profile offset + Hout(idslp) == F ! dmix or erodibility slope + Hout(idtim) == F ! erodibility profile restore time + Hout(idbmx) == F ! Bed biodifusivity maximum + Hout(idbmm) == F ! Bed biodifusivity minimum + Hout(idbzs) == F ! Bed biodifusivity zs + Hout(idbzm) == F ! Bed biodifusivity zm + Hout(idbzp) == F ! Bed biodifusivity phi + Hout(idprp) == F ! cohesive behavior ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +491,133 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ + +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 +! ! ! GLOSSARY: ! ========= @@ -639,6 +797,16 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! BEDLOAD_COEFF Bed load transport rate coefficient. ! +! DBMAX Maximum biodiffusivity +! +! DBMIN Minimum biodiffusivity +! +! DBZS Depth of maximum biodiffusivity +! +! DBZM Depth of end of exponential biodiffusivity +! +! DBZP Depth of minimum biodiffusivity +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output HISTORY NetCDF file: ! @@ -685,6 +853,28 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1165,3 +1355,79 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + diff --git a/ROMS/External/sediment_lake_jersey.in b/ROMS/External/sediment_lake_jersey.in index ac5e1c6f..17b24fc7 100644 --- a/ROMS/External/sediment_lake_jersey.in +++ b/ROMS/External/sediment_lake_jersey.in @@ -142,6 +142,27 @@ ad_LBC(isTvar) == Clo Clo Clo Clo ! idsed(:), compact BEDLOAD_COEFF == 0.05d0 +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + +! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + +! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + +! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + +! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters, ! [1:Ngrids] values expected. @@ -153,22 +174,34 @@ ad_LBC(isTvar) == Clo Clo Clo Clo ! idsed(:), compact ! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment ! parameters, [1:Ngrids] values expected. - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == T ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == F ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == F ! Zo_bio biological bottom roughness - Hout(izbfm) == F ! Zo_bedform bed form bottom roughness - Hout(izbld) == F ! Zo_bedload bed load bottom roughness - Hout(izwbl) == F ! Zo_wbl wave bottom roughness - Hout(iactv) == F ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height + Hout(isd50) == T ! mean grain diameter + Hout(idens) == T ! mean grain density + Hout(iwsed) == T ! mean settling velocity + Hout(itauc) == T ! critical erosion stress + Hout(irlen) == T ! ripple length + Hout(irhgt) == T ! ripple height + Hout(ibwav) == T ! wave excursion amplitude + Hout(izdef) == T ! default bottom roughness + Hout(izapp) == T ! apparent bottom roughness + Hout(izNik) == T ! Nikuradse bottom roughness + Hout(izbio) == T ! biological bottom roughness + Hout(izbfm) == T ! bed form bottom roughness + Hout(izbld) == T ! bed load bottom roughness + Hout(izwbl) == T ! wave bottom roughness + Hout(iactv) == T ! active layer thickness + Hout(ishgt) == F ! saltation height + Hout(imaxD) == F ! maximum inundation depth + Hout(idnet) == F ! Erosion or deposition + Hout(idoff) == F ! dmix erodibility profile offset + Hout(idslp) == F ! dmix or erodibility slope + Hout(idtim) == F ! erodibility profile restore time + Hout(idbmx) == F ! Bed biodifusivity maximum + Hout(idbmm) == F ! Bed biodifusivity minimum + Hout(idbzs) == F ! Bed biodifusivity zs + Hout(idbzm) == F ! Bed biodifusivity zm + Hout(idbzp) == F ! Bed biodifusivity phi + Hout(idprp) == F ! cohesive behavior + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +493,132 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ + +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 + ! ! GLOSSARY: ! ========= @@ -640,6 +799,16 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! BEDLOAD_COEFF Bed load transport rate coefficient. ! +! DBMAX Maximum biodiffusivity +! +! DBMIN Minimum biodiffusivity +! +! DBZS Depth of maximum biodiffusivity +! +! DBZM Depth of end of exponential biodiffusivity +! +! DBZP Depth of minimum biodiffusivity +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output HISTORY NetCDF file: ! @@ -686,6 +855,28 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1166,3 +1357,79 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + diff --git a/ROMS/External/sediment_lake_signell.in b/ROMS/External/sediment_lake_signell.in index 49b85ad7..e3c37626 100644 --- a/ROMS/External/sediment_lake_signell.in +++ b/ROMS/External/sediment_lake_signell.in @@ -142,6 +142,26 @@ ad_LBC(isTvar) == Clo Clo Clo Clo ! idsed(:), compact BEDLOAD_COEFF == 0.05d0 +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + +! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + +! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + +! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + +! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters, ! [1:Ngrids] values expected. @@ -153,22 +173,33 @@ ad_LBC(isTvar) == Clo Clo Clo Clo ! idsed(:), compact ! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment ! parameters, [1:Ngrids] values expected. - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == T ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == T ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == T ! Zo_bio biological bottom roughness - Hout(izbfm) == T ! Zo_bedform bed form bottom roughness - Hout(izbld) == T ! Zo_bedload bed load bottom roughness - Hout(izwbl) == T ! Zo_wbl wave bottom roughness - Hout(iactv) == T ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height +Hout(isd50) == T ! mean grain diameter +Hout(idens) == T ! mean grain density +Hout(iwsed) == T ! mean settling velocity +Hout(itauc) == T ! critical erosion stress +Hout(irlen) == T ! ripple length +Hout(irhgt) == T ! ripple height +Hout(ibwav) == T ! wave excursion amplitude +Hout(izdef) == T ! default bottom roughness +Hout(izapp) == T ! apparent bottom roughness +Hout(izNik) == F ! Nikuradse bottom roughness +Hout(izbio) == F ! biological bottom roughness +Hout(izbfm) == F ! bed form bottom roughness +Hout(izbld) == F ! bed load bottom roughness +Hout(izwbl) == F ! wave bottom roughness +Hout(iactv) == F ! active layer thickness +Hout(ishgt) == F ! saltation height +Hout(imaxD) == F ! maximum inundation depth +Hout(idnet) == F ! Erosion or deposition +Hout(idoff) == F ! dmix erodibility profile offset +Hout(idslp) == F ! dmix or erodibility slope +Hout(idtim) == F ! erodibility profile restore time +Hout(idbmx) == F ! Bed biodifusivity maximum +Hout(idbmm) == F ! Bed biodifusivity minimum +Hout(idbzs) == F ! Bed biodifusivity zs +Hout(idbzm) == F ! Bed biodifusivity zm +Hout(idbzp) == F ! Bed biodifusivity phi +Hout(idprp) == F ! cohesive behavior ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +491,131 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ + +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 ! ! GLOSSARY: ! ========= @@ -639,6 +795,17 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! BEDLOAD_COEFF Bed load transport rate coefficient. ! +! DBMAX Maximum biodiffusivity +! +! DBMIN Minimum biodiffusivity +! +! DBZS Depth of maximum biodiffusivity +! +! DBZM Depth of end of exponential biodiffusivity +! +! DBZP Depth of minimum biodiffusivity +! +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output HISTORY NetCDF file: ! @@ -685,6 +852,29 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1165,3 +1355,79 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + diff --git a/ROMS/External/sediment_sed_test1.in b/ROMS/External/sediment_sed_test1.in index 754da6cd..e5fdc2e1 100644 --- a/ROMS/External/sediment_sed_test1.in +++ b/ROMS/External/sediment_sed_test1.in @@ -142,6 +142,26 @@ ad_LBC(isTvar) == Gra Clo Cla Clo ! idsed(:), compact BEDLOAD_COEFF == 0.05d0 +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + +! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + +! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + +! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + +! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters, ! [1:Ngrids] values expected. @@ -153,22 +173,33 @@ ad_LBC(isTvar) == Gra Clo Cla Clo ! idsed(:), compact ! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment ! parameters, [1:Ngrids] values expected. - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == T ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == F ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == F ! Zo_bio biological bottom roughness - Hout(izbfm) == F ! Zo_bedform bed form bottom roughness - Hout(izbld) == F ! Zo_bedload bed load bottom roughness - Hout(izwbl) == F ! Zo_wbl wave bottom roughness - Hout(iactv) == F ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height +Hout(isd50) == T ! mean grain diameter +Hout(idens) == T ! mean grain density +Hout(iwsed) == T ! mean settling velocity +Hout(itauc) == T ! critical erosion stress +Hout(irlen) == T ! ripple length +Hout(irhgt) == T ! ripple height +Hout(ibwav) == T ! wave excursion amplitude +Hout(izdef) == T ! default bottom roughness +Hout(izapp) == T ! apparent bottom roughness +Hout(izNik) == T ! Nikuradse bottom roughness +Hout(izbio) == T ! biological bottom roughness +Hout(izbfm) == T ! bed form bottom roughness +Hout(izbld) == T ! bed load bottom roughness +Hout(izwbl) == T ! wave bottom roughness +Hout(iactv) == T ! active layer thickness +Hout(ishgt) == F ! saltation height +Hout(imaxD) == F ! maximum inundation depth +Hout(idnet) == F ! Erosion or deposition +Hout(idoff) == F ! dmix erodibility profile offset +Hout(idslp) == F ! dmix or erodibility slope +Hout(idtim) == F ! erodibility profile restore time +Hout(idbmx) == F ! Bed biodifusivity maximum +Hout(idbmm) == F ! Bed biodifusivity minimum +Hout(idbzs) == F ! Bed biodifusivity zs +Hout(idbzm) == F ! Bed biodifusivity zm +Hout(idbzp) == F ! Bed biodifusivity phi +Hout(idprp) == F ! cohesive behavior ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +491,131 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ + +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 ! ! GLOSSARY: ! ========= @@ -685,6 +841,28 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1165,3 +1343,79 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + diff --git a/ROMS/External/sediment_sed_toy.in b/ROMS/External/sediment_sed_toy.in index abdfc5f9..59d20bb6 100644 --- a/ROMS/External/sediment_sed_toy.in +++ b/ROMS/External/sediment_sed_toy.in @@ -142,6 +142,26 @@ ad_LBC(isTvar) == Per Per Per Per ! idsed(:), compact BEDLOAD_COEFF == 0.05d0 +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + +! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + +! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + +! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + +! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters, ! [1:Ngrids] values expected. @@ -153,22 +173,33 @@ ad_LBC(isTvar) == Per Per Per Per ! idsed(:), compact ! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment ! parameters, [1:Ngrids] values expected. - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == F ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == T ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == T ! Zo_bio biological bottom roughness - Hout(izbfm) == F ! Zo_bedform bed form bottom roughness - Hout(izbld) == F ! Zo_bedload bed load bottom roughness - Hout(izwbl) == F ! Zo_wbl wave bottom roughness - Hout(iactv) == T ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height +Hout(isd50) == T ! mean grain diameter +Hout(idens) == T ! mean grain density +Hout(iwsed) == T ! mean settling velocity +Hout(itauc) == T ! critical erosion stress +Hout(irlen) == T ! ripple length +Hout(irhgt) == T ! ripple height +Hout(ibwav) == T ! wave excursion amplitude +Hout(izdef) == F ! default bottom roughness +Hout(izapp) == T ! apparent bottom roughness +Hout(izNik) == T ! Nikuradse bottom roughness +Hout(izbio) == T ! biological bottom roughness +Hout(izbfm) == F ! bed form bottom roughness +Hout(izbld) == F ! bed load bottom roughness +Hout(izwbl) == F ! wave bottom roughness +Hout(iactv) == T ! active layer thickness +Hout(ishgt) == F ! saltation height +Hout(imaxD) == F ! maximum inundation depth +Hout(idnet) == F ! Erosion or deposition +Hout(idoff) == F ! dmix erodibility profile offset +Hout(idslp) == F ! dmix or erodibility slope +Hout(idtim) == F ! erodibility profile restore time +Hout(idbmx) == F ! Bed biodifusivity maximum +Hout(idbmm) == F ! Bed biodifusivity minimum +Hout(idbzs) == F ! Bed biodifusivity zs +Hout(idbzm) == F ! Bed biodifusivity zm +Hout(idbzp) == F ! Bed biodifusivity phi +Hout(idprp) == F ! cohesive behavior ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +491,131 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ + +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 ! ! GLOSSARY: ! ========= @@ -685,6 +841,29 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1165,3 +1344,79 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + diff --git a/ROMS/External/sediment_shoreface.in b/ROMS/External/sediment_shoreface.in index e6e17c8a..e04acbf1 100644 --- a/ROMS/External/sediment_shoreface.in +++ b/ROMS/External/sediment_shoreface.in @@ -142,6 +142,27 @@ ad_LBC(isTvar) == Gra Per Clo Per ! idsed(:), compact BEDLOAD_COEFF == 0.05d0 +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + + ! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + + ! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + + ! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + + ! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters, ! [1:Ngrids] values expected. @@ -153,22 +174,33 @@ ad_LBC(isTvar) == Gra Per Clo Per ! idsed(:), compact ! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment ! parameters, [1:Ngrids] values expected. - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == T ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == F ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == F ! Zo_bio biological bottom roughness - Hout(izbfm) == F ! Zo_bedform bed form bottom roughness - Hout(izbld) == F ! Zo_bedload bed load bottom roughness - Hout(izwbl) == F ! Zo_wbl wave bottom roughness - Hout(iactv) == T ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height +Hout(isd50) == T ! mean grain diameter +Hout(idens) == T ! mean grain density +Hout(iwsed) == T ! mean settling velocity +Hout(itauc) == T ! critical erosion stress +Hout(irlen) == T ! ripple length +Hout(irhgt) == T ! ripple height +Hout(ibwav) == T ! wave excursion amplitude +Hout(izdef) == T ! default bottom roughness +Hout(izapp) == T ! apparent bottom roughness +Hout(izNik) == F ! Nikuradse bottom roughness +Hout(izbio) == F ! biological bottom roughness +Hout(izbfm) == F ! bed form bottom roughness +Hout(izbld) == F ! bed load bottom roughness +Hout(izwbl) == F ! wave bottom roughness +Hout(iactv) == T ! active layer thickness +Hout(ishgt) == F ! saltation height +Hout(imaxD) == T ! maximum inundation depth +Hout(idnet) == T ! Erosion or deposition +Hout(idoff) == F ! dmix erodibility profile offset +Hout(idslp) == F ! dmix or erodibility slope +Hout(idtim) == F ! erodibility profile restore time +Hout(idbmx) == F ! Bed biodifusivity maximum +Hout(idbmm) == F ! Bed biodifusivity minimum +Hout(idbzs) == F ! Bed biodifusivity zs +Hout(idbzm) == F ! Bed biodifusivity zm +Hout(idbzp) == F ! Bed biodifusivity phi +Hout(idprp) == F ! cohesive behavior ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +492,131 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ + +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 ! ! GLOSSARY: ! ========= @@ -685,6 +842,28 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1165,3 +1344,78 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. diff --git a/ROMS/External/sediment_test_chan.in b/ROMS/External/sediment_test_chan.in index e558ccd3..3acb7e11 100644 --- a/ROMS/External/sediment_test_chan.in +++ b/ROMS/External/sediment_test_chan.in @@ -142,6 +142,26 @@ ad_LBC(isTvar) == Gra Clo Gra Clo ! idsed(:), compact BEDLOAD_COEFF == 0.15d0 +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + +! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + +! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + +! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + +! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters, ! [1:Ngrids] values expected. @@ -153,22 +173,33 @@ ad_LBC(isTvar) == Gra Clo Gra Clo ! idsed(:), compact ! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment ! parameters, [1:Ngrids] values expected. - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == T ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == F ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == F ! Zo_bio biological bottom roughness - Hout(izbfm) == F ! Zo_bedform bed form bottom roughness - Hout(izbld) == F ! Zo_bedload bed load bottom roughness - Hout(izwbl) == F ! Zo_wbl wave bottom roughness - Hout(iactv) == F ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height +Hout(isd50) == T ! mean grain diameter +Hout(idens) == T ! mean grain density +Hout(iwsed) == T ! mean settling velocity +Hout(itauc) == T ! critical erosion stress +Hout(irlen) == T ! ripple length +Hout(irhgt) == T ! ripple height +Hout(ibwav) == T ! wave excursion amplitude +Hout(izdef) == T ! default bottom roughness +Hout(izapp) == T ! apparent bottom roughness +Hout(izNik) == T ! Nikuradse bottom roughness +Hout(izbio) == F ! biological bottom roughness +Hout(izbfm) == F ! bed form bottom roughness +Hout(izbld) == F ! bed load bottom roughness +Hout(izwbl) == F ! wave bottom roughness +Hout(iactv) == F ! active layer thickness +Hout(ishgt) == F ! saltation height +Hout(imaxD) == F ! maximum inundation depth +Hout(idnet) == F ! Erosion or deposition +Hout(idoff) == F ! dmix erodibility profile offset +Hout(idslp) == F ! dmix or erodibility slope +Hout(idtim) == F ! erodibility profile restore time +Hout(idbmx) == F ! Bed biodifusivity maximum +Hout(idbmm) == F ! Bed biodifusivity minimum +Hout(idbzs) == F ! Bed biodifusivity zs +Hout(idbzm) == F ! Bed biodifusivity zm +Hout(idbzp) == F ! Bed biodifusivity phi +Hout(idprp) == F ! cohesive behavior ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +491,131 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ + +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 ! ! GLOSSARY: ! ========= @@ -685,6 +841,28 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1165,3 +1343,79 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + diff --git a/ROMS/External/sediment_test_head.in b/ROMS/External/sediment_test_head.in index 671405af..4bf9ff4f 100644 --- a/ROMS/External/sediment_test_head.in +++ b/ROMS/External/sediment_test_head.in @@ -142,6 +142,26 @@ ad_LBC(isTvar) == Gra Clo Gra Clo ! idsed(:), compact BEDLOAD_COEFF == 0.05d0 +! Maximum biodiffusivity, [1:Ngrids]. + + DBMAX == 1.0d-10 + +! Minimum biodiffusivity, [1:Ngrids]. + + DBMIN == 1.0d-12 + +! Depth of maximum biodiffusivity, [1:Ngrids]. + + DBZS == 0.002d0 + +! Depth of end of exponential biodiffusivity, [1:Ngrids]. + + DBZM == 0.08d0 + +! Depth of minimum biodiffusivity, [1:Ngrids]. + + DBZP == 0.01d0 + ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters, ! [1:Ngrids] values expected. @@ -153,22 +173,33 @@ ad_LBC(isTvar) == Gra Clo Gra Clo ! idsed(:), compact ! Logical switches (TRUE/FALSE) to activate writing of bed bottom sediment ! parameters, [1:Ngrids] values expected. - Hout(isd50) == T ! grain_diameter mean grain diameter - Hout(idens) == T ! grain_density mean grain density - Hout(iwsed) == T ! settling_vel mean settling velocity - Hout(itauc) == T ! erosion_stress critical erosion stress - Hout(irlen) == T ! ripple_length ripple length - Hout(irhgt) == T ! ripple_height ripple height - Hout(ibwav) == T ! bed_wave_amp wave excursion amplitude - Hout(izdef) == F ! Zo_def default bottom roughness - Hout(izapp) == T ! Zo_app apparent bottom roughness - Hout(izNik) == T ! Zo_Nik Nikuradse bottom roughness - Hout(izbio) == T ! Zo_bio biological bottom roughness - Hout(izbfm) == F ! Zo_bedform bed form bottom roughness - Hout(izbld) == F ! Zo_bedload bed load bottom roughness - Hout(izwbl) == F ! Zo_wbl wave bottom roughness - Hout(iactv) == T ! active_layer_thickness active layer thickness - Hout(ishgt) == F ! saltation saltation height +Hout(isd50) == T ! mean grain diameter +Hout(idens) == T ! mean grain density +Hout(iwsed) == T ! mean settling velocity +Hout(itauc) == T ! critical erosion stress +Hout(irlen) == T ! ripple length +Hout(irhgt) == T ! ripple height +Hout(ibwav) == T ! wave excursion amplitude +Hout(izdef) == F ! default bottom roughness +Hout(izapp) == T ! apparent bottom roughness +Hout(izNik) == T ! Nikuradse bottom roughness +Hout(izbio) == T ! biological bottom roughness +Hout(izbfm) == F ! bed form bottom roughness +Hout(izbld) == F ! bed load bottom roughness +Hout(izwbl) == F ! wave bottom roughness +Hout(iactv) == T ! active layer thickness +Hout(ishgt) == F ! saltation height +Hout(imaxD) == F ! maximum inundation depth +Hout(idnet) == F ! Erosion or deposition +Hout(idoff) == F ! dmix erodibility profile offset +Hout(idslp) == F ! dmix or erodibility slope +Hout(idtim) == F ! erodibility profile restore time +Hout(idbmx) == F ! Bed biodifusivity maximum +Hout(idbmm) == F ! Bed biodifusivity minimum +Hout(idbzs) == F ! Bed biodifusivity zs +Hout(idbzm) == F ! Bed biodifusivity zm +Hout(idbzp) == F ! Bed biodifusivity phi +Hout(idprp) == F ! cohesive behavior ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into QUICKSAVE output files, [1:Ngrids] values expected. @@ -460,6 +491,131 @@ Dout(MTydif) == T ! mud_01_ydiff, ... horizontal ETA-diffusion Dout(MTsdif) == T ! mud_01_sdiff, ... horizontal S-diffusion Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed + + TRANSC == 0.03d0 + +! Noncohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed + + TRANSN == 0.2d0 + +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed. [1:Ngrids] values expected. +!------------------------------------------------------------------------------ + +! Minimum shear for erosion + + MUD_TAUCR_MIN == 0.030000d0 + +! Maximum shear for erosion + + MUD_TAUCR_MAX == 5.20d0 + +! Tau_crit profile slope + + MUD_TAUCR_SLOPE == 0.300000d0 + +! Tau_crit profile offset + + MUD_TAUCR_OFF == 1.000000d0 + +! Tau_crit consolidation rate + + MUD_TAUCR_TIME == 28800.0d0 + +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ + +! Boolean set to .true. if differential settling aggregation + + L_ADS == F + +! Boolean set to .true. if shear aggregation + + L_ASH == T + +! Boolean set to .true. if collision-induced fragmentation enable + + L_COLLFRAG == F + +! Primary particle size (m), typically 4e-6 m + + F_DP0 == 0.000004d0 + +! Floc fractal dimension, typically ranging from 1.6 to 2.6 + + F_NF == 2.0d0 + +! Maximum diameter (m) + + F_DMAX == 0.0015d0 + +! Number of fragments by shear erosion, If binary/ternary : 2.0 + + F_NB_FRAG == 2.0d0 + +! Flocculation efficiency, ranging from 0 to 1.0 + + F_ALPHA == 0.35d0 + +! Shear fragmentation rate + + F_BETA == 0.15d0 + +! For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) + + F_ATER == 0.0d0 + +! Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from [(0.0 - no erosion to 1.0 - all erosion)] + + F_ERO_FRAC == 0.0d0 + +! Number of fragments induced by shear erosion. + + F_ERO_NBFRAG == 2.0d0 + +! Fragment size class (could be changed to a particle +! size or a particle distribution) (INTEGER) + + F_ERO_IV == 1 + +! Fragmentation rate for collision-induced breakup + + F_COLLFRAGPARAM == 0.01d0 + +! Min concentration below which flocculation processes are not calculated + + F_CLIM == 0.001d0 + +! If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment + + L_TESTCASE == F + +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ + +! Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that +! [1:NCS,1:Ngrids] values expected. + + MUD_FRAC_EQ == 0.10d0 0.20d0 0.40d0 0.20d0 0.10d0 0.0d0 0.0d0 0.00d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0 + +! Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. + + MUD_T_DFLOC == 200.0d0 ! ! GLOSSARY: ! ========= @@ -685,6 +841,28 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! ! Hout(ishgt) Write out saltation height. ! +! Hout(imaxD) Maximum inundation depth +! +! Hout(idnet) Erosion or deposition +! +! Hout(idoff) Dmix erodibility profile offset +! +! Hout(idslp) Dmix or erodibility slope +! +! Hout(idtim) Erodibility profile restore time +! +! Hout(idbmx) Bed biodiffusivity maximum +! +! Hout(idbmm) Bed biodiffusivity minimum +! +! Hout(idbzs) Bed biodiffusivity +! +! Hout(idbzm) Bed biodiffusivity +! +! Hout(idbzp) Bed biodiffusivity +! +! Hout(idprp) Cohesive behavior +! ! Logical switches (TRUE/FALSE) to activate writing of bed layer parameters ! into output QUICKSAVE NetCDF file: ! @@ -1165,3 +1343,78 @@ Dout(MTvdif) == T ! mud_01_vdiff, ... vertical diffusion ! Dout(MTsdif) Horizontal S-diffusion ! Dout(MTvdif) Vertical diffusion ! +!------------------------------------------------------------------------------ +! Mixed Bed parameters- Transition threshold for cohesive mix +! and non-cohesive behaviors, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! TRANSC Cohesive transition- Under that value of total mud fraction +! entire bed behaves as a non-cohesive bed +! +! TRANSN Cohesive transition- Over that value of total mud fraction +! entire bed behaves as a cohesive bed +! +!------------------------------------------------------------------------------ +! Cohesive/Mixed bed critical shear +! Bed critical shear stress values if cohesive or mixed Bed is active +! These values are applied to the entire bed, [1:Ngrids] values expected. +!------------------------------------------------------------------------------ +! +! MUD_TAUCR_MIN Minimum shear for erosion +! +! MUD_TAUCR_MAX Maximum shear for erosion +! +! MUD_TAUCR_SLOPE Tau_crit profile slope +! +! MUD_TAUCR_OFF Tau_crit profile offset +! +! MUD_TAUCR_TIME Tau_crit consolidation rate +! +!------------------------------------------------------------------------------ +! Flocculation Sediment Parameters. +!------------------------------------------------------------------------------ +! +! L_ADS Boolean set to .true. if differential settling aggregation +! +! L_ASH Boolean set to .true. if shear aggregation +! +! L_COLLFRAG Boolean set to .true. if collision-induced fragmentation enable +! +! F_DP0 Primary particle size (m), typically 4e-6 m +! +! F_NF Floc fractal dimension, typically ranging from 1.6 to 2.6 +! +! F_DMAX Maximum diameter (m) +! +! F_NB_FRAG Number of fragments by shear erosion. If binary/ternary : 2. +! +! F_ALPHA Flocculation efficiency, ranging from 0. to 1. +! +! F_BETA Shear fragmentation rate +! +! F_ATER For ternary breakup, use 0.5, for binary : 0. (a boolean could be better) +! +! F_ERO_FAC Fraction of the shear fragmentation term transfered to shear erosion. +! Ranging from 0. (no erosion) to 1. (all erosion) +! +! F_ERO_NBFRAG Number of fragments induced by shear erosion. +! +! F_ERO_IV Fragment size class (could be changed to a particle +! size or a particle distribution (INTEGER) +! +! F_COLLFRAGPARAM Fragmentation rate for collision-induced breakup +! +! F_CLIM Min concentration below which flocculation processes are not calculated +! +! L_TESTCASE If .TRUE. sets G(t) to values from Verney et al., 2011 lab experiment +! +!------------------------------------------------------------------------------ +! Flocculation Decomposition in Bed Sediment Parameters +! Only #ifdef DEFLOC +!------------------------------------------------------------------------------ +! +! MUD_FRAC_EQ Equilibrium fractional class distribution (they should add up to 1). +! There is no check for that, [1:NCS,1:Ngrids] values expected. +! +! MUD_T_DFLOC Time scale of flocculation decomposition in bed +! [1:Ngrids] values expected. diff --git a/ROMS/External/vegetation.in b/ROMS/External/vegetation.in new file mode 100755 index 00000000..34e53d3c --- /dev/null +++ b/ROMS/External/vegetation.in @@ -0,0 +1,145 @@ +! Vegetation Model Parameters. +! +!git $Id$ +!============================================================= J. C. Warner === +! Copyright (c) 2002-2024 The ROMS/TOMS Group T. S. Kalra ! +! Licensed under a MIT/X style license N. K. Ganju ! +! See License_ROMS.txt A. Beudin ! +!============================================================================== +! ! +! Input parameters can be entered in ANY order, provided that the parameter ! +! KEYWORD (usually, upper case) is typed correctly followed by "=" or "==" ! +! symbols. Any comment lines are allowed and must begin with an exclamation ! +! mark (!) in column one. Comments may appear to the right of a parameter ! +! specification to improve documentation. Comments will be ignored during ! +! reading. Blank lines are also allowed and ignored. Continuation lines in ! +! a parameter specification are allowed and must be preceded by a backslash ! +! (\). In some instances, more than one value is required for a parameter. ! +! If fewer values are provided, the last value is assigned for the entire ! +! parameter array. The multiplication symbol (*), without blank spaces in ! +! between, is allowed for a parameter specification. For example, in a two ! +! grids nested application: ! +! ! +! AKT_BAK == 2*1.0d-6 2*5.0d-6 ! m2/s ! +! ! +! indicates that the first two entries of array AKT_BAK, in fortran column- ! +! major order, will have the same value of "1.0d-6" for grid 1, whereas the ! +! next two entries will have the same value of "5.0d-6" for grid 2. ! +! ! +! In multiple levels of nesting and/or multiple connected domains step-ups, ! +! "Ngrids" entries are expected for some of these parameters. In such case, ! +! the order of the entries for a parameter is extremely important. It must ! +! follow the same order (1:Ngrids) as in the state variable declaration. The ! +! USER may follow the above guidelines for specifying his/her values. These ! +! parameters are marked by "==" plural symbol after the KEYWORD. ! +! ! +!============================================================================== +! +! NOTICE: Input parameter units are specified within brackets and default +! ****** values are specified within braces. +! + NVEG == 1 + + CD_VEG == 1.0d0 + + E_VEG == 1.0d9 + + VEG_MASSDENS == 700.0d0 + + VEGHMIXCOEF == 0.1d0 + + KFAC_MARSH == 0.6d-9 + + SCARP_HGHT == 0.27d0 + + NTIMES_MARSH == 30 + + PAR_FAC1 == -0.7372d0 + + PAR_FAC2 == 0.092d0 + + TDAYS_MARSH_GROWTH == 180 + + NUGP == 0.0138d0 + + BMAX == 2.5d0 + + CHIREF == 0.158d0 + + ALPHA_PDENS == 250.0d0 + + BETA_PDENS == 0.3032d0 + + ALPHA_PHGHT == 0.0609d0 + + BETA_PHGHT == 0.1876d0 + + ALPHA_PDIAM == 0.0006d0 + + BETA_PDIAM == 0.3d0 + +! Logical switches (TRUE/FALSE) to activate writing of vegetation fields +! into HISTORY output file: [1:NVEG,Ngrids]. + +Hout(ipdens) == T ! Plant_density Density of the plant for each vegetation +Hout(iphght) == T ! Plant_height Height of the plant for each vegetation +Hout(ipdiam) == T ! Plant_diameter Diameter of the plant for each vegetation +Hout(ipthck) == T ! Plant_thickness Thickness of the plant for each vegetation +Hout(ipagbm) == F ! Plant_agb Above ground plant biomass +Hout(ipbgbm) == F ! Plant_bgb Below ground plant biomass +Hout(idWdvg) == T ! Dissip_veg Wave dissipation due to vegetation +! +Hout(idTims) == F ! marsh_mask Store masking marsh from marsh cells +Hout(idTtot) == F ! Thrust_total Total thrust from all direction due to waves +Hout(idTmfo) == F ! marsh_flux_out Marsh sediment flux out from marsh cells +Hout(idTmmr) == F ! marsh_retreat Amount of marsh retreat from all directions + +Hout(idTmtr) == F ! marsh_tidal_range Tidal range for vertical growth for marsh cells +Hout(idTmhw) == F ! marsh_high_water Mean high water for marsh cells +Hout(idTmvg) == F ! marsh_vert Amount of vertical growth for marsh cells +Hout(idTmbp) == F ! marsh_biomass_peak Amount of marsh biomass peak +! +! GLOSSARY: +! ========= +! +!------------------------------------------------------------------------------ +! +! NVEG Number of submerged aquatic vegetation types. +! +! CD_VEG Drag coefficient for each vegetation type. +! +! E_VEG Young's Modulus for each vegetation type. +! +! VEG_MASSDENS Mass density for each vegetation type. +! +! VEGHMIXCOEF Additional horizontal viscosity coefficient at the edge of a vegetation patch. +! +! KFAC_MARSH Marsh sediment erodibility coefficient (s/m). +! +! SCARP_HGHT Scarp height after which marsh mask converts from 1 to 0 (m). +! +! NTIMES_MARSH Number of days to record mean high water for marsh vertical growth (typically 30 days). +! +! PAR_FAC1 Marsh parabolic curve growth parameter 1. +! +! PAR_FAC2 Marsh parabolic curve growth parameter 2. +! +!TDAYS_MARSH_GROWTH Growing number of days for marsh. +! +! NUGP Fraction of below ground biomass. +! +! BMAX Peak biomass, kg/m2. +! +! CHIREF Fraction of recalcitrant Carbon. +! +! ALPHA_PDENS Marsh vegetation growth parameter 1 for density. +! +! BETA_PDENS Marsh vegetation growth parameter 2 for density. +! +! ALPHA_PHGHT Marsh vegetation growth parameter 1 for height. +! +! BETA_PHGHT Marsh vegetation growth parameter 2 for height. +! +! ALPHA_PDIAM Marsh vegetation growth parameter 1 for diameter. +! +! BETA_PDIAM Marsh vegetation growth parameter 2 for diameter. diff --git a/ROMS/Functionals/ana_vegetation.h b/ROMS/Functionals/ana_vegetation.h new file mode 100755 index 00000000..6feb43f7 Binary files /dev/null and b/ROMS/Functionals/ana_vegetation.h differ diff --git a/ROMS/Include/globaldefs.h b/ROMS/Include/globaldefs.h index 6c8a32dd..a0050310 100644 --- a/ROMS/Include/globaldefs.h +++ b/ROMS/Include/globaldefs.h @@ -1075,6 +1075,8 @@ !defined ANA_SEDIMENT) || \ (defined BBL_MODEL && \ !defined ANA_SEDIMENT) + (defined VEGETATION && \ + !defined ANA_VEGETATION) || \ # define INI_FILE #endif @@ -1224,3 +1226,10 @@ #if !defined VISC_3DCOEF && defined UV_SMAGORINSKY # define VISC_3DCOEF #endif + +/* +** Define internal switch for vegetation horizontal mixing +*/ +#if defined VEG_HMIXING +# define VISC_3DCOEF +#endif diff --git a/ROMS/Modules/mod_arrays.F b/ROMS/Modules/mod_arrays.F index aecc0e4e..cca1d2cb 100644 --- a/ROMS/Modules/mod_arrays.F +++ b/ROMS/Modules/mod_arrays.F @@ -78,6 +78,16 @@ MODULE mod_arrays & deallocate_sedbed, & & initialize_sedbed #endif +#if defined SEDIMENT && defined SED_FLOCS + USE mod_sedflocs, ONLY : allocate_sedflocs, & + & initialize_sedflocs +! & deallocate_sedflocs, & +#endif +#if defined VEGETATION + USE mod_vegarr, ONLY : allocate_vegarr, & + & initialize_vegarr +! & deallocate_vegarr, & +#endif USE mod_sources, ONLY : allocate_sources, & & deallocate_sources #if defined SSH_TIDES || defined UV_TIDES @@ -200,6 +210,12 @@ SUBROUTINE ROMS_allocate_arrays (allocate_vars) #if defined SEDIMENT || defined BBL_MODEL CALL allocate_sedbed (ng, LBi, UBi, LBj, UBj) #endif +#if defined SEDIMENT && defined SED_FLOCS + CALL allocate_sedflocs(ng, LBi, UBi, LBj, UBj) +#endif +#if defined VEGETATION + CALL allocate_vegarr(ng, LBi, UBi, LBj, UBj) +#endif #if defined SSH_TIDES || defined UV_TIDES CALL allocate_tides (ng, LBi, UBi, LBj, UBj) #endif @@ -309,6 +325,12 @@ SUBROUTINE ROMS_deallocate_arrays #if defined SEDIMENT || defined BBL_MODEL CALL deallocate_sedbed (ng) #endif +#if defined SEDIMENT && defined SED_FLOCS +! CALL deallocate_sedflocs (ng) +#endif +!#if defined VEGETATION +! CALL deallocate_vegarr(ng) +!#endif #if defined SSH_TIDES || defined UV_TIDES CALL deallocate_tides (ng) #endif @@ -423,6 +445,12 @@ SUBROUTINE ROMS_initialize_arrays #if defined SEDIMENT || defined BBL_MODEL CALL initialize_sedbed (ng, tile, model) #endif +#if defined SEDIMENT && defined SED_FLOCS + CALL initialize_sedflocs (ng, tile, model) +#endif +#if defined VEGETATION + CALL initialize_vegarr (ng, tile, model) +#endif #if defined SSH_TIDES || defined UV_TIDES CALL initialize_tides (ng, tile) #endif diff --git a/ROMS/Modules/mod_iounits.F b/ROMS/Modules/mod_iounits.F index fffae5c4..1fe3237d 100644 --- a/ROMS/Modules/mod_iounits.F +++ b/ROMS/Modules/mod_iounits.F @@ -93,6 +93,7 @@ MODULE mod_iounits ! fposnam Input initial floats positions filename. ! ! iparnam Input ice parameters file name. ! ! sparnam Input sediment transport parameters filename. ! +! vegnam Input vegetation input parameters file name. ! ! sposnam Input station positions file name. ! ! varname Input IO variables information file name. ! ! ! @@ -305,6 +306,7 @@ MODULE mod_iounits character (len=256) :: fposnam ! floats positions character (len=256) :: iparnam ! ice model parameters character (len=256) :: sparnam ! sediment model parameters + character (len=256) :: vegnam ! vegetation model parameters character (len=256) :: sposnam ! station positions character (len=256) :: varname ! I/O metadata ! @@ -738,6 +740,7 @@ SUBROUTINE allocate_iounits (Ngrids) fbionam(i:i)=blank fposnam(i:i)=blank sparnam(i:i)=blank + vegnam(i:i)=blank sposnam(i:i)=blank END DO ! diff --git a/ROMS/Modules/mod_ncparam.F b/ROMS/Modules/mod_ncparam.F index c495a0b7..16a4724b 100644 --- a/ROMS/Modules/mod_ncparam.F +++ b/ROMS/Modules/mod_ncparam.F @@ -436,6 +436,14 @@ MODULE mod_ncparam integer :: id2dRV ! 2D relative vorticity integer :: id3dPV ! 3D potential vorticity integer :: id3dRV ! 3D relative vorticity + integer :: idHs01 ! Wave height of partition 01 + integer :: idHs02 ! Wave height of partition 02 + integer :: idTp01 ! Wave peak period of partition 01 + integer :: idTp02 ! Wave peak period of partition 02 + integer :: idWl01 ! Wave avg length of partition 01 + integer :: idWl02 ! Wave avg length of partition 02 + integer :: idDr01 ! Wave avg dir of partition 01 + integer :: idDr02 ! Wave avg dir of partition 02 ! ! Last used variable ID counter. ! @@ -1166,6 +1174,9 @@ SUBROUTINE initialize_ncparam ! USE get_metadata_mod, ONLY : io_metadata USE strings_mod, ONLY : FoundError, StandardName +#if defined VEGETATION + USE mod_vegetation +#endif ! ! Local variable declarations. ! @@ -1873,6 +1884,24 @@ SUBROUTINE initialize_ncparam idHsbl=varid CASE ('idHbbl') idHbbl=varid +#ifdef WAVE_PARTITION + CASE ('idHs01') + idHs01=varid + CASE ('idHs02') + idHs02=varid + CASE ('idTp01') + idTp01=varid + CASE ('idTp02') + idTp02=varid + CASE ('idWl01') + idWl01=varid + CASE ('idWl02') + idWl02=varid + CASE ('idDr01') + idDr01=varid + CASE ('idDr02') + idDr02=varid +#endif CASE ('idHzdz') idHzdz=varid #ifdef UV_DRAG_GRID @@ -2165,6 +2194,16 @@ SUBROUTINE initialize_ncparam idDu3d(M3vvis)=varid CASE ('idDv3d(M3vvis)') idDv3d(M3vvis)=varid +# if defined VEGETATION && defined VEG_DRAG + CASE ('idDu3d(M3fveg)') + idDu3d(M3fveg)=varid + CASE ('idDv3d(M3fveg)') + idDv3d(M3fveg)=varid + CASE ('idDu2d(M2fveg)') + idDu2d(M2fveg)=varid + CASE ('idDv2d(M2fveg)') + idDv2d(M2fveg)=varid +# endif CASE ('idDu3d(M3rate)') idDu3d(M3rate)=varid CASE ('idDv3d(M3rate)') @@ -2378,6 +2417,9 @@ SUBROUTINE initialize_ncparam #if defined SEDIMENT || defined BBL_MODEL # include +#endif +#if defined VEGETATION +# include #endif CASE DEFAULT diff --git a/ROMS/Modules/mod_scalars.F b/ROMS/Modules/mod_scalars.F index 3706d93b..703b421d 100644 --- a/ROMS/Modules/mod_scalars.F +++ b/ROMS/Modules/mod_scalars.F @@ -186,6 +186,10 @@ MODULE mod_scalars integer :: M3sstm ! 3D momentum, surface streaming integer :: M3wrol ! 3D momentum, wave roller accel integer :: M3wbrk ! 3D momentum, wave breaking +# endif +# if defined VEGETATION && defined VEG_DRAG + integer :: M3fveg ! 3D momentum, vegetation drag force + integer :: M2fveg ! 2D momentum, vegetation drag force # endif integer :: M3pgrd ! 3D momentum, pressure gradient integer :: M3vvis ! 3D momentum, vertical viscosity diff --git a/ROMS/Modules/mod_sedflocs.F b/ROMS/Modules/mod_sedflocs.F new file mode 100755 index 00000000..d8e5700c --- /dev/null +++ b/ROMS/Modules/mod_sedflocs.F @@ -0,0 +1,28 @@ +#include "cppdefs.h" + MODULE mod_sedflocs + +/* +** git $Id$ +*************************************************** Hernan G. Arango *** +** Copyright (c) 2002-2024 The ROMS/TOMS Group ** +** Licensed under a MIT/X style license ** +** See License_ROMS.txt ** +************************************************************************ +** ** +** This module declares Sediment Floc Model Kernel Structure ** +** containing several variables describing flocculation interaction ** +** properties. ** +** ** +** Note that the *.h file is located in ROMS/Nonlinear/Sediment and ** +** it is included within <...> to allow the user customize it in the ** +** project directory, while keeping the distributed file intact ** +** (check build scripts for details). ** +** ** +************************************************************************ +*/ + +#if defined SEDIMENT +# include +#endif + + END MODULE mod_sedflocs diff --git a/ROMS/Modules/mod_vegarr.F b/ROMS/Modules/mod_vegarr.F new file mode 100755 index 00000000..528ce075 --- /dev/null +++ b/ROMS/Modules/mod_vegarr.F @@ -0,0 +1,28 @@ +#include "cppdefs.h" + MODULE mod_vegarr + +/* +** git $Id$ +*************************************************** Hernan G. Arango *** +** Copyright (c) 2002-2024 The ROMS/TOMS Group ** +** Licensed under a MIT/X style license ** +** See License_ROMS.txt ** +************************************************************************ +** ** +** This module declares Vegetation Model Kernel Structure containing** +** several variables describing plants, momentum and turbulence terms ** +** along wave thrust marsh output arrays. ** +** ** +** Note that the *.h file is located in ROMS/Nonlinear/Vegetation ** +** it is included within <...> to allow the user customize it in the ** +** project directory, while keeping the distributed file intact ** +** (check build scripts for details). ** +** ** +************************************************************************ +*/ + +#if defined VEGETATION +# include +#endif + + END MODULE mod_vegarr diff --git a/ROMS/Modules/mod_vegetation.F b/ROMS/Modules/mod_vegetation.F new file mode 100755 index 00000000..ced3196f --- /dev/null +++ b/ROMS/Modules/mod_vegetation.F @@ -0,0 +1,96 @@ +#include "cppdefs.h" + MODULE mod_vegetation + +/* +** git $Id$ +*************************************************** Hernan G. Arango *** +** Copyright (c) 2002-2024 The ROMS/TOMS Group ** +** Licensed under a MIT/X style license ** +** See License_ROMS.txt ** +************************************************************************ +** ** +** This module declares vegetation model internal parameters. Some ** +** of these parameters are usually read from the appropriate input ** +** script. ** +** ** +** The current design allows the user to have a lot of latitude for ** +** customizing or expanding the vegetation model. ** +** ** +** The vegetatation model is composed of several files: ** +** ** +** * Vegetation modifies rhs3d terms: ** +** ** +** vegetation_drag.F ** +** ** +** * Vegetation modifies turbulence terms: ** +** ** +** vegetation_turb_cal.F ** +** ** +** * Vegetation modifies streaming terms: ** +** ** +** vegetation_stream.F ** +** ** +** * Vegetation biomass calculation: ** +** ** +** vegetation_biomass.F ** +** ** +** * Marsh dynamics (main calling routine) calculation: ** +** ** +** marsh_dynamics.F ** +** ** +** * Marsh wave thrust calculation: ** +** ** +** marsh_wave_thrust.F ** +** ** +** * Marsh sediment erosion calculations: ** +** ** +** marsh_sed_erosion.F ** +** ** +** * Marsh growth mean high water/tidal calculations: ** +** ** +** marsh_tidal_range.F ** +** ** +** * Marsh vertical growth calculations: ** +** ** +** marsh_vert_growth.F ** +** ** +** * Internal model parameters declarations: ** +** ** +** vegetation_mod.h ** +** ** +** * Model parameters standard input script: ** +** ** +** vegetation.in ** +** ** +** * Code to read input model parameters: ** +** ** +** vegetation_inp.h ** +** ** +** * Code to assign indices to model variables during the ** +** reading of metadata information from "varinfo.dat": ** +** ** +** vegetation_var.h ** +** ** +** * Code to define input model parameters in all output ** +** NetCDF files: ** +** ** +** vegetation_def_his.h ** +** ** +** * Code to write out input model parameters in all output ** +** NetCDF files: ** +** ** +** vegetation_wrt_his.h ** +** ** +** Note that all the files are located in ROMS/Nonlinear/Vegetation ** +** and the *.h files are included within <...> to allow the user ** +** customize any of them in the project directory, while keeping ** +** the distributed code intact (check build scripts for details). ** +** ** +************************************************************************ +*/ + +#if defined VEGETATION +# include +#endif + + END MODULE mod_vegetation diff --git a/ROMS/Nonlinear/Sediment/CMakeLists.txt b/ROMS/Nonlinear/Sediment/CMakeLists.txt index 12c3b4d8..2c8a1db9 100644 --- a/ROMS/Nonlinear/Sediment/CMakeLists.txt +++ b/ROMS/Nonlinear/Sediment/CMakeLists.txt @@ -8,13 +8,22 @@ # Source code list for sub-directory "ROMS/Nonlinear/Sediment" list( APPEND _files + ROMS/Nonlinear/Sediment/mod_vandera_funcs.F ROMS/Nonlinear/Sediment/sed_bed.F + ROMS/Nonlinear/Sediment/sed_bed2.F + ROMS/Nonlinear/Sediment/sed_bed_cohesive.F ROMS/Nonlinear/Sediment/sed_bedload.F + ROMS/Nonlinear/Sediment/sed_bedload_vandera.F + ROMS/Nonlinear/Sediment/sed_biodiff.F + ROMS/Nonlinear/Sediment/sed_flocs.F ROMS/Nonlinear/Sediment/sed_fluxes.F ROMS/Nonlinear/Sediment/sediment.F ROMS/Nonlinear/Sediment/sediment_output.F ROMS/Nonlinear/Sediment/sed_settling.F ROMS/Nonlinear/Sediment/sed_surface.F + ROMS/Nonlinear/Sediment/sedtr_decay.F + ROMS/Nonlinear/Sediment/sedtr_reactions_pom.F + ROMS/Nonlinear/Sediment/sedtr_reactions_sed_decay.F ) set ( ROMS_Nonlinear_Sediment_files diff --git a/ROMS/Nonlinear/Sediment/mod_vandera_funcs.F b/ROMS/Nonlinear/Sediment/mod_vandera_funcs.F new file mode 100644 index 00000000..51b537ea --- /dev/null +++ b/ROMS/Nonlinear/Sediment/mod_vandera_funcs.F @@ -0,0 +1,360 @@ +#include "cppdefs.h" + Module MOD_VANDERA_FUNCS +#if defined SEDIMENT && defined BEDLOAD_VANDERA +! +!git $Id$ +!================================================ Tarandeep S. Kalra === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Chris Sherwood ! +! Licensed under a MIT/X style license John C. Warner ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! This module contains several functions that are required for the ! +! sediment bedload calculations using Van der A's formulations. ! +! ! +!======================================================================= +! + implicit none + + CONTAINS +! + REAL(r8) FUNCTION kh(Td,depth) +! +! Calculate wave number from Wave period and depth +! +! RL Soulsby (2006) "Simplified calculation of wave orbital velocities" +! HR Wallingford Report TR 155, February 2006 +! + USE mod_scalars +! + implicit none +! + real(r8) :: Td, depth + real(r8) :: cff + real(r8) :: x, y, t, omega +! + omega=2.0_r8*pi/Td + +! +! depth (i.e.x) cannot go negative to avoid negative wave number +! + IF(depth.lt.0.0_r8) THEN + x=0.0_r8 + ELSE + x=omega**2.0_r8*depth/g + ENDIF +! + IF(x.lt.1.0_r8) THEN + y=SQRT(x) + ELSE + y=x + ENDIF +! +! Iteratively solving 3 times for eqn.7 of Soulsby 1997 by using +! eqns. (12a-14) +! + t=TANH(y) + cff=(y*t-x)/(t+y*(1.0_r8-t*t)) + y=y-cff +! + t=TANH(y) + cff=(y*t-x)/(t+y*(1.0_r8-t*t)) + y=y-cff + + t=TANH(y) + cff=(y*t-x)/(t+y*(1.0_r8-t*t)) + y=y-cff + kh=y +! + RETURN + END FUNCTION +! + REAL(r8) FUNCTION w_s_calc(d50, rhos) +! +! Critical Shields parameter from Soulsby (1997). +! Dynamics of Marine Sands +! + USE mod_kinds + USE mod_scalars +! + implicit none +! + real(r8), parameter :: nu=1.36E-6_r8 + real(r8) :: d50, rhos + real(r8) :: s, dstar + real(r8) :: cff, cff1 +! + s=rhos/rho0 + dstar=(g*(s-1)/(nu*nu))**(1.0_r8/3.0_r8)*d50 + cff=nu/d50 + cff1=10.36_r8 + w_s_calc=cff*(sqrt(cff1*cff1+1.049_r8*dstar**3.0_r8)-cff1) +! + RETURN + END FUNCTION +! + REAL(r8) FUNCTION w_sc_calc(Hs, Td, depth, RR, w_s, zws) +! +! Second order Stokes theory to get vertical velocity of water particle +! at a given elevation based on santoss_core.m +! + USE mod_kinds + USE mod_scalars +! + implicit none +! + real(r8), parameter :: eps_inv=1.0E14_r8 + real(r8) :: Hs, Td, depth, RR, zws, w_s + real(r8) :: cff, worb1, worb2, worb + real(r8), parameter :: eps = 1.0E-14_r8 +! + worb1=pi*Hs*zws/(Td*depth+eps) + worb2=worb1*2.0_r8*(RR+RR-1.0_r8) +! +! Using the SANTOSS model formulation +! + cff=1.0_r8/8.0_r8 + worb=cff*worb1*SQRT(64.0_r8-(-worb1+ & + & SQRT(worb1**2+32.0_r8* & + & worb2**2+eps))**2/(worb2**2+eps))+ & + & worb2*SIN(2.0_r8*ACOS(cff*(-worb1+ & + & SQRT(worb1**2+32.0_r8*worb2**2))/ & + & (worb2+eps))) + +! +! Prevent worb from going to Infinity when worb2=0.0 +! + worb=MIN(worb, eps_inv) + w_sc_calc=worb +! + RETURN + END FUNCTION w_sc_calc +! + REAL(r8) FUNCTION mu_calc(d50) +! +! Calculate bed roughness factor based on grain size +! VA2013 Appendix A., required for current related bed roughness +! and wave related bed roughness. +! + USE mod_kinds + USE mod_scalars +! + implicit none +! + real(r8) :: d50, d50_mm +! + d50_mm=d50*1000.0_r8 +! + IF(d50_mm.le.0.15_r8) THEN + mu_calc=6.0_r8 + ELSEIF(d50_mm.gt.0.15_r8.and.d50_mm.lt.0.20_r8) THEN + mu_calc=6.0_r8-5.0_r8*((d50_mm-0.15_r8)/(0.2_r8-0.15_r8)) + ELSEIF(d50_mm.ge.0.20_r8) THEN + mu_calc=1.0_r8 + ENDIF +! + RETURN + END FUNCTION mu_calc +! + REAL(r8) FUNCTION ksd_calc(d50, d90, mu, theta_timeavg, & + & eta, rlen) +! +! Calculate current-related bed roughness from VA2013 Appendix A.1. +! + USE mod_kinds + USE mod_scalars +! + implicit none +! + real(r8) :: d50, d90, mu, theta_timeavg, eta, rlen + real(r8) :: ripple_fac +! + rlen=MAX(rlen,d50) + ripple_fac=0.4_r8*eta**2.0_r8/rlen + ksd_calc=MAX( 3.0_r8*d90, & + & d50*(mu+6.0_r8*(theta_timeavg-1.0_r8)) )+ & + & ripple_fac +! + RETURN + END FUNCTION ksd_calc +! + REAL(r8) FUNCTION ksw_calc(d50, mu, theta_timeavg, eta, rlen) +! +! Calculate wave related bed roughness from VA2013 Eqn. A.5. +! + USE mod_kinds + USE mod_scalars +! + implicit none + real(r8) :: d50, mu, theta_timeavg, eta, rlen + real(r8) :: ripple_fac, ksw +! + rlen=MAX(rlen,d50) +! + ripple_fac=0.4_r8*eta**2.0_r8/rlen + ksw_calc=MAX( d50, & + & d50*(mu+6.0_r8*(theta_timeavg-1.0_r8)) ) & + & +ripple_fac +! + RETURN + END FUNCTION ksw_calc +! + REAL(r8) FUNCTION fw_calc(ahat, ksw) +! +! Calculate full-cycle wave friction factor from VA2013 Eqn. A.4. +! + USE mod_kinds + USE mod_scalars +! + implicit none + real(r8) :: ahat, ksw, ratio, fw +! + ratio=ahat/ksw + IF(ratio.gt.1.587_r8) THEN + fw_calc=0.00251_r8*EXP(5.21_r8*(ratio)**(-0.19_r8)) + ELSE + fw_calc=0.3_r8 + ENDIF +! + RETURN + END FUNCTION fw_calc +! +! This function is not getting used at the time because +! we compute current frction factor from bottom current stress +! + REAL(r8) FUNCTION fd_calc_santoss(udelta, delta, ksd) + + USE mod_kinds + USE mod_scalars + + implicit none + +! Calculate current related friction factor VA2013 Eqn. 20 +! Assuming logarithmic velocity profile. + + real(r8) :: udelta, delta, ksd + real(r8), parameter :: min_udelta=1.0E-4_r8 + real(r8), parameter :: von_k=0.41_r8 + + IF(udelta.lt.min_udelta) THEN + fd_calc_santoss=0.0_r8 + ELSE + fd_calc_santoss=2.0_r8*(von_k/LOG(30.0_r8*delta/ksd))**2.0_r8 + ENDIF + + RETURN + END FUNCTION fd_calc_santoss +! + REAL(r8) FUNCTION fd_calc_madsen(udelta, mag_bstrc) +! + USE mod_kinds + USE mod_scalars +! + implicit none +! +! Calculate current related friction factor +! directly from the current stresses. +! + real(r8), parameter :: eps=1.0E-14_r8 + real(r8), parameter :: min_udelta=1.0E-4_r8 + real(r8) :: udelta, mag_bstrc +! + IF(udelta.lt.min_udelta) THEN + fd_calc_madsen=0.0_r8 + ELSE + !fd_calc_new=MAX((mag_bstrc/(0.5_r8*udelta*udelta*rho0)),eps) + fd_calc_madsen=MAX((mag_bstrc/(0.5_r8*udelta*udelta)),eps) +! fd_calc_new=MIN(fd_calc_new,2.0_r8) + fd_calc_madsen=fd_calc_madsen + ENDIF +! + RETURN + END FUNCTION fd_calc_madsen +! + REAL(r8) FUNCTION fwi_calc(T_iu, T_i, ahat, ksw) +! +! Wave friction factor for wave and crest half cycle VA2013 Eqn. 21. +! + USE mod_kinds + USE mod_scalars +! + implicit none +! + real(r8), parameter :: eps = 1.0E-14_r8 + real(r8) :: T_iu, T_i, ahat, ksw + real(r8) :: c1, ratio, fwi + real(r8) :: cff1, cff2, cff3 +! + fwi_calc=0.3_r8 +! + c1=2.6_r8 + ratio=ahat/ksw + IF(ratio.gt.1.587_r8) THEN + cff1=MAX( (T_iu/(T_i+eps)),0.0_r8 ) + cff2=(2.0_r8*cff1)**c1 + cff3=cff2*ratio +! +! These if condition prevents arithematic overflow error +! when 0.0**-0.19_r8, think about that +! + IF(cff3.le.0.0_r8) THEN + fwi_calc=0.0_r8 + ELSE + fwi_calc=0.00251_r8*EXP(5.21_r8*(cff3)**(-0.19_r8)) + END IF + END IF +! + RETURN + END FUNCTION fwi_calc +! + REAL(r8) FUNCTION dsf_calc(d50, theta_i) +! +! Sheet flow thickness VA2013 Appendix C.1. +! + USE mod_kinds + USE mod_scalars +! + implicit none +! + real(r8) :: d50, theta_i + real(r8) :: d50_mm + real(r8) :: cff +! + d50_mm=d50*1000.0_r8 + IF(d50_mm.le.0.15_r8)THEN + cff=25.0_r8*theta_i + ELSEIF(d50_mm.gt.0.15_r8.and.d50_mm.lt.0.20_r8)THEN + cff=25.0_r8-(12.0_r8*(d50_mm-0.15_r8)/0.05_r8) + ELSEIF(d50_mm.ge.0.20_r8)THEN + cff=13.0_r8*theta_i + ENDIF + dsf_calc=MAX(d50*cff,d50) +! + RETURN + END FUNCTION dsf_calc +! + REAL(r8) FUNCTION theta_cr_calc(d50, rhos) +! +! Critical Shields parameter from Soulsby (1997). +! + USE mod_kinds + USE mod_scalars + + implicit none +! + real(r8), parameter :: nu=1.36E-6_r8 + real(r8) :: d50, rhos + real(r8) :: s, dstar + real(r8) :: cff1, cff2 +! + s=rhos/rho0 + dstar=(g*(s-1)/(nu*nu))**(1.0_r8/3.0_r8)*d50 + cff1=0.30_r8/(1.0_r8+1.2_r8*dstar) + cff2=0.055_r8*(1.0_r8-EXP(-0.020_r8*dstar)) + theta_cr_calc=cff1+cff2 +! + RETURN + END FUNCTION theta_cr_calc +! +#endif + END MODULE mod_vandera_funcs diff --git a/ROMS/Nonlinear/Sediment/sed_bed.F b/ROMS/Nonlinear/Sediment/sed_bed.F index 7f4960d3..b95f2b37 100644 --- a/ROMS/Nonlinear/Sediment/sed_bed.F +++ b/ROMS/Nonlinear/Sediment/sed_bed.F @@ -2,7 +2,8 @@ MODULE sed_bed_mod -#if defined NONLINEAR && defined SEDIMENT && !defined COHESIVE_BED +#if defined NONLINEAR && defined SEDIMENT && !defined COHESIVE_BED \ + && !defined MIXED_BED && !defined NONCOHESIVE_BED2 ! !git $Id$ !==================================================== John C. Warner === @@ -216,7 +217,7 @@ SUBROUTINE sed_bed_tile (ng, tile, & ! Compute sediment bed layer stratigraphy. !----------------------------------------------------------------------- ! -# if defined BEDLOAD_MPM || defined SUSPLOAD +!# if defined BEDLOAD || defined SUSPLOAD # ifdef BBL_MODEL DO j=Jstr-1,Jend+1 DO i=Istr-1,Iend+1 @@ -240,7 +241,7 @@ SUBROUTINE sed_bed_tile (ng, tile, & END DO END DO # endif -# endif +!# endif ! !----------------------------------------------------------------------- ! Update bed properties according to ero_flux and dep_flux. @@ -484,6 +485,7 @@ SUBROUTINE sed_bed_tile (ng, tile, & # if defined SED_MORPH DO j=JstrR,JendR DO i=IstrR,IendR + bed_thick(i,j,3)=bed_thick(i,j,nnew) bed_thick(i,j,nnew)=0.0_r8 DO k=1,Nbed bed_thick(i,j,nnew)=bed_thick(i,j,nnew)+ & @@ -496,6 +498,11 @@ SUBROUTINE sed_bed_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & bed_thick(:,:,nnew)) END IF + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + CALL exchange_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & bed_thick(:,:,3)) + END IF # endif ! !----------------------------------------------------------------------- diff --git a/ROMS/Nonlinear/Sediment/sed_bed2.F b/ROMS/Nonlinear/Sediment/sed_bed2.F new file mode 100644 index 00000000..918363bb --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sed_bed2.F @@ -0,0 +1,993 @@ +#include "cppdefs.h" + + MODULE sed_bed_mod2 + +#if defined NONLINEAR && defined SEDIMENT && defined NONCOHESIVE_BED2 +! +!git $Id$ +!============================================== Alfredo Aretxabaleta === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Hernan G. Arango ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! This routine computes sediment bed layer stratigraphy. ! +! ! +! Warner, J.C., C.R. Sherwood, R.P. Signell, C.K. Harris, and H.G. ! +! Arango, 2008: Development of a three-dimensional, regional, ! +! coupled wave, current, and sediment-transport model, Computers ! +! & Geosciences, 34, 1284-1306. ! +! ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: sed_bed2 + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sed_bed2 (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_sedbed + USE mod_stepping +# ifdef BBL_MODEL + USE mod_bbl +# endif +# ifdef SEDBIO_COUP + USE mod_diags +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL sed_bed_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & +# ifdef WET_DRY + & GRID(ng) % rmask_wet, & +# endif +# ifdef SEDBIO_COUP + & GRID(ng) % Hz, & +# ifdef DIAGNOSTICS_BIO + & DIAGS(ng) % DiaBio2d, & +# ifdef WET_DRY + & GRID(ng) % rmask_full, & +# endif +# endif +# endif +# ifdef BBL_MODEL + & BBL(ng) % bustrc, & + & BBL(ng) % bvstrc, & + & BBL(ng) % bustrw, & + & BBL(ng) % bvstrw, & + & BBL(ng) % bustrcwmax, & + & BBL(ng) % bvstrcwmax, & +# else + & FORCES(ng) % bustr, & + & FORCES(ng) % bvstr, & +# endif + & OCEAN(ng) % t, & +# ifdef SUSPLOAD + & SEDBED(ng) % ero_flux, & + & SEDBED(ng) % settling_flux, & +# endif +# if defined SED_MORPH + & SEDBED(ng) % bed_thick, & +# endif + & SEDBED(ng) % bed, & + & SEDBED(ng) % bed_frac, & + & SEDBED(ng) % bed_mass, & + & SEDBED(ng) % bottom) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE sed_bed2 +! +!*********************************************************************** + SUBROUTINE sed_bed_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & +# ifdef WET_DRY + & rmask_wet, & +# endif +# ifdef SEDBIO_COUP + & Hz, & +# ifdef DIAGNOSTICS_BIO + & DiaBio2d, & +# ifdef WET_DRY + & rmask_full, & +# endif +# endif +# endif +# ifdef BBL_MODEL + & bustrc, bvstrc, & + & bustrw, bvstrw, & + & bustrcwmax, bvstrcwmax, & +# else + & bustr, bvstr, & +# endif + & t, & +# ifdef SUSPLOAD + & ero_flux, settling_flux, & +# endif +# if defined SED_MORPH + & bed_thick, & +# endif + & bed, bed_frac, bed_mass, & + & bottom) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment +# ifdef SEDBIO_COUP + USE mod_biology +# endif +! + USE bc_3d_mod, ONLY : bc_r3d_tile + USE exchange_2d_mod, ONLY : exchange_r2d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:,LBj:) +# endif +# ifdef SEDBIO_COUP + real(r8), intent(in) :: Hz(LBi:,LBj:,:) +# ifdef DIAGNOSTICS_BIO + real(r8), intent(inout) :: DiaBio2d(LBi:,LBj:,:) +# ifdef WET_DRY + real(r8), intent(in) :: rmask_full(LBi:,LBj:) +# endif +# endif +# endif +# ifdef BBL_MODEL + real(r8), intent(in) :: bustrc(LBi:,LBj:) + real(r8), intent(in) :: bvstrc(LBi:,LBj:) + real(r8), intent(in) :: bustrw(LBi:,LBj:) + real(r8), intent(in) :: bvstrw(LBi:,LBj:) + real(r8), intent(in) :: bustrcwmax(LBi:,LBj:) + real(r8), intent(in) :: bvstrcwmax(LBi:,LBj:) +# else + real(r8), intent(in) :: bustr(LBi:,LBj:) + real(r8), intent(in) :: bvstr(LBi:,LBj:) +# endif +# if defined SED_MORPH + real(r8), intent(inout):: bed_thick(LBi:,LBj:,:) +# endif + real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:) +# ifdef SUSPLOAD + real(r8), intent(inout) :: ero_flux(LBi:,LBj:,:) + real(r8), intent(inout) :: settling_flux(LBi:,LBj:,:) +# endif + real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bottom(LBi:,LBj:,:) +# else +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj) +# endif +# ifdef SEDBIO_COUP + real(r8), intent(in) :: Hz(LBi:UBi,LBj:Ubj,UBk) +# ifdef DIAGNOSTICS_BIO + real(r8), intent(inout) :: DiaBio2d(LBi:UBi,LBj:Ubj,NDbio2d) +# ifdef WET_DRY + real(r8), intent(in) :: rmask_full(LBi:Ubi,LBj:Ubj) +# endif +# endif +# endif +# ifdef BBL_MODEL + real(r8), intent(in) :: bustrc(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstrc(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bustrw(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstrw(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bustrcwmax(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstrcwmax(LBi:UBi,LBj:UBj) +# else + real(r8), intent(in) :: bustr(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstr(LBi:UBi,LBj:UBj) +# endif +# if defined SED_MORPH + real(r8), intent(inout):: bed_thick(LBi:UBi,LBj:UBj,3) +# endif + real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng)) +# ifdef SUSPLOAD + real(r8), intent(inout) :: ero_flux(LBi:UBi,LBj:UBj,NST) + real(r8), intent(inout) :: settling_flux(LBi:UBi,LBj:UBj,NST) +# endif + real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) + real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) + real(r8), intent(inout) :: bottom(LBi:UBi,LBj:UBj,MBOTP) +# endif +! +! Local variable declarations. +! + integer :: Ksed, i, ised, j, k, ks + integer :: bnew, nnn + + real(r8), parameter :: eps = 1.0E-14_r8 + + real(r8) :: cff, cff1, cff2, cff3 + real(r8) :: thck_avail, thck_to_add + + real(r8), dimension(NST) :: nlysm + + real(r8), dimension(IminS:ImaxS,NST) :: dep_mass + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tau_w + +# ifdef SEDBIO_COUP +! Coefficient for diffusion across seabed-water interface (m2/s) + real(r8), parameter :: D_sw = 1.08E-9_r8 +! Other variables for keeping track of dissolved solutes + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ndep_thck_tot + real(r8), dimension(IminS:ImaxS,JminS:JmaxS,4) :: ndep_diss + integer :: iwc +# ifdef DIAGNOSTICS_BIO + integer :: idf, ief +# endif + real(r8) :: cff4, cff5 + real(r8), dimension(4) :: nlysm_diss + +! Parameters for including 4 types of seabed layers: +! - an active layer +! - N0-1 fine layers of thickness ~= newlayer_thick +! - N1-1 medium-thick layers of thickness ~= newlayer_thick2 +! N1=Nbed-N0 +! - thick repository in bottom layer +! NOTE: as of now, these are not used + integer, parameter :: N0=20 + real(8), parameter :: firstlayer_thick=0.0001_r8 + real(8), parameter :: newlayer_thick2=0.01_r8 + real(8), parameter :: minsedlayer_thick=1.0E-4_r8 + integer :: N1,indnl,kk + +# endif +# include "set_bounds.h" + +# ifdef BEDLOAD + bnew=nnew +# else + bnew=nstp +# endif + +! KLUDGE alert +! minlayer_thick(ng) = 0.0005 +minlayer_thick(ng) = newlayer_thick(ng) +! +!----------------------------------------------------------------------- +! Compute sediment bed layer stratigraphy. +!----------------------------------------------------------------------- +! +# if defined BEDLOAD_MPM || defined SUSPLOAD +# ifdef BBL_MODEL + DO j=Jstr-1,Jend+1 + DO i=Istr-1,Iend+1 + tau_w(i,j)=SQRT(bustrcwmax(i,j)*bustrcwmax(i,j)+ & + & bvstrcwmax(i,j)*bvstrcwmax(i,j)) +# ifdef WET_DRY + tau_w(i,j)=tau_w(i,j)*rmask_wet(i,j) +# endif + END DO + END DO +# else + DO j=Jstrm1,Jendp1 + DO i=Istrm1,Iendp1 + tau_w(i,j)=0.5_r8*SQRT((bustr(i,j)+bustr(i+1,j))* & + & (bustr(i,j)+bustr(i+1,j))+ & + & (bvstr(i,j)+bvstr(i,j+1))* & + & (bvstr(i,j)+bvstr(i,j+1))) +# ifdef WET_DRY + tau_w(i,j)=tau_w(i,j)*rmask_wet(i,j) +# endif + END DO + END DO +# endif +# endif +! +!----------------------------------------------------------------------- +! Update bed properties according to ero_flux and dep_flux. +!----------------------------------------------------------------------- +! +# ifdef SUSPLOAD + J_LOOP : DO j=Jstr,Jend + ! + ! The deposition and resuspension of sediment on the bottom "bed" + ! is due to precipitation flux FC(:,0), already computed, and the + ! resuspension (erosion, hence called ero_flux). The resuspension is + ! applied to the bottom-most grid box value qc(:,1) so the total mass + ! is conserved. Restrict "ero_flux" so that "bed" cannot go negative + ! after both fluxes are applied. + ! + DO i=Istr,Iend +# ifdef SEDBIO_COUP + ndep_thck_tot(i,j)=0.0_r8 +# endif + SED_LOOP: DO ised=1,NST + dep_mass(i,ised)=0.0_r8 +# ifdef SED_MORPH + ! Apply morphology factor. + ero_flux(i,j,ised)=ero_flux(i,j,ised)*morph_fac(ised,ng) + settling_flux(i,j,ised)=settling_flux(i,j,ised)* & + & morph_fac(ised,ng) +# endif + + ! Update bed mass arrays. + bed_mass(i,j,1,nnew,ised)=MAX(bed_mass(i,j,1,bnew,ised)- & + & (ero_flux(i,j,ised)- & + & settling_flux(i,j,ised)), & + & 0.0_r8) +# ifdef SEDBIO_COUP + ndep_thck_tot(i,j)=ndep_thck_tot(i,j)+ & + & (bed_mass(i,j,1,nnew,ised)-bed_mass(i,j,1,bnew,ised))/ & + & (Srho(ised,ng)*(1.0_r8-bed(i,j,1,iporo))) +# endif + DO k=2,Nbed + bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nstp,ised) + END DO + END DO SED_LOOP + + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,1,nnew,ised) + END DO + + IF (cff3.eq.0.0_r8) THEN + cff3=eps + END IF + bed(i,j,1,ithck)=0.0_r8 + DO ised=1,NST + bed_frac(i,j,1,ised)=bed_mass(i,j,1,nnew,ised)/cff3 + bed(i,j,1,ithck)=MAX(bed(i,j,1,ithck)+ & + & bed_mass(i,j,1,nnew,ised)/ & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,1,iporo))),0.0_r8) + END DO +# if defined SEDBIO_COUP && defined BIO_FENNEL +# if defined OXYGEN && defined ODU +! +!----------------------------------------------------------------------- +! Update dissolved bed tracers due to erosion/deposition. Assume that +! new porewater formed during deposition has the same properties as the +! water in the overlying (i.e. bottom) water column grid cell. During +! erosion, the porewater removed from the bed has the same properties +! as the remaining porewater in the seabed; also porewater erosion is +! limited by the thickness of the grid cell. +! +! Note that units of dissolved tracers are mmol tracer / m2 +! for both bed(...) and t(..,nnew,...). +!----------------------------------------------------------------------- +! + DO ised=iboxy,ibodu + IF (ised.eq.iboxy) THEN + iwc=iOxyg +# if defined DIAGNOSTICS_BIO + ief=iseO2 +# endif + ELSEIF (ised.eq.ibodu) THEN + iwc=iODU_ +# if defined DIAGNOSTICS_BIO + ief=iseOD +# endif + ELSEIF (ised.eq.ibno3) THEN + iwc=iNO3_ +# if defined DIAGNOSTICS_BIO + ief=iseNO +# endif + ELSEIF (ised.eq.ibnh4) THEN + iwc=iNH4_ +# if defined DIAGNOSTICS_BIO + ief=iseNH +# endif + ENDIF + IF (ndep_thck_tot(i,j).gt.eps) THEN +! depostion + ndep_diss(i,j,ised-iboxy+1)=t(i,j,1,nnew,iwc) & + & /Hz(i,j,1)*(ndep_thck_tot(i,j)*bed(i,j,1,iporo)) +! ELSE + ELSEIF (ndep_thck_tot(i,j).lt.(-1.0_r8*eps)) THEN +! erosion + ndep_diss(i,j,ised-iboxy+1)=bed(i,j,1,ised) & + & /(bed(i,j,1,ithck)-ndep_thck_tot(i,j)) & + & *(ndep_thck_tot(i,j)) + ELSE + ndep_diss(i,j,ised-iboxy+1)=0.0_r8 + ENDIF + bed(i,j,1,ised)=bed(i,j,1,ised)+ndep_diss(i,j,ised-iboxy+1) + t(i,j,1,nnew,iwc)=t(i,j,1,nnew,iwc)-ndep_diss(i,j,ised-iboxy+1) +# if defined DIAGNOSTICS_BIO + DiaBio2d(i,j,ief)=DiaBio2d(i,j,ief) + & +# ifdef WET_DRY + & rmask_full(i,j)* & +# endif + & (-1.0_r8)*ndep_diss(i,j,ised-iboxy+1) +# endif + END DO +# endif +# endif + END DO + + END DO J_LOOP +# endif /* SUSPLOAD section */ +! +!----------------------------------------------------------------------- +! At this point, all deposition or erosion is complete, and +! has been added/subtracted to top layer. Thickness has NOT been corrected. +!----------------------------------------------------------------------- +! + J_LOOP2 : DO j=Jstr,Jend + DO i=Istr,Iend + +! Calculate active layer thickness, bottom(i,j,iactv). +! (trunk version allows this to be zero...this has minimum of 6*D50) +# ifdef SEDBED_BIO +! bottom(i,j,iactv)=firstlayer_thick + bottom(i,j,iactv)=newlayer_thick(ng) +# else + bottom(i,j,iactv)=MAX(0.0_r8, & + & 0.007_r8* & + & (tau_w(i,j)-bottom(i,j,itauc))*rho0)+ & + & 6.0_r8*bottom(i,j,isd50) +# endif +# ifdef SED_MORPH + ! Apply morphology factor. + bottom(i,j,iactv)=MAX(bottom(i,j,iactv)*morph_fac(1,ng), & + & bottom(i,j,iactv)) +# endif +! +! Calculate net deposition and erosion + cff=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff=cff+settling_flux(i,j,ised) + cff2=cff2+ero_flux(i,j,ised) + dep_mass(i,ised)=0.0_r8 + IF ((ero_flux(i,j,ised)-settling_flux(i,j,ised)).lt. & + & 0.0_r8) THEN + dep_mass(i,ised)=settling_flux(i,j,ised)- & + & ero_flux(i,j,ised) + END IF + END DO + + IF ( cff-cff2.GT.0.0_r8) THEN ! NET depostion + ! Deposition. Determine if we need to create a new bed layer + ! (no test for age here) + bed(i,j,1,iaged)=time(ng) + IF(bed(i,j,1,ithck).gt. & + & MAX(bottom(i,j,iactv),newlayer_thick(ng))) THEN + ! Top layer is too thick + IF (Nbed.gt.2) THEN + IF(bed(i,j,2,ithck).lt.minlayer_thick(ng)) THEN + ! Layer 2 is smaller than minimum size + ! Instead of pushing down all layers, just combine top 2 layers + cff=0.0_r8 + cff1=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff =cff +dep_mass(i,ised) + cff1=cff1+bed_mass(i,j,1,nnew,ised) + cff2=cff2+bed_mass(i,j,2,nnew,ised) + END DO + ! Update bed mass + DO ised=1,NST + bed_mass(i,j,2,nnew,ised)= & + & MAX(bed_mass(i,j,2,nnew,ised)+ & + & bed_mass(i,j,1,nnew,ised)- & + & dep_mass(i,ised),0.0_r8) + bed_mass(i,j,1,nnew,ised)=dep_mass(i,ised) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,2,ised)= & + & bed(i,j,2,ised)+bed(i,j,1,ised) & + & -MAX(0.0_r8,ndep_diss(i,j,ised-iboxy+1)) + bed(i,j,1,ised)=MAX(0.0_r8, & + & ndep_diss(i,j,ised-iboxy+1)) + END DO +# endif + ! ALA - average time and porosity + ! ALA CHECK WITH CRS cff1 or cff1-cff for first layer + bed(i,j,2,iaged)=(bed(i,j,1,iaged)*cff1+ & + & bed(i,j,2,iaged)*cff2)/(cff1+cff2) + bed(i,j,1,iaged)=time(ng) + bed(i,j,2,iporo)=(bed(i,j,1,iporo)*cff1+ & + & bed(i,j,2,iporo)*cff2)/(cff1+cff2) + ! ALA CHECK WITH CRS POROSITY OF 1ST LAYER + bed(i,j,1,iporo)=bed(i,j,1,iporo) + ELSE + ! Layer 2 is > minlayer thick, need another layer + ! Combine bottom layers. + cff1=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff1=cff1+bed_mass(i,j,Nbed-1,nnew,ised) + cff2=cff2+bed_mass(i,j,Nbed,nnew,ised) + END DO + bed(i,j,Nbed,iporo)= & + & (bed(i,j,Nbed-1,iporo)*cff1+ & + & bed(i,j,Nbed,iporo)*cff2)/(cff1+cff2) + bed(i,j,Nbed,iaged)= & + & (bed(i,j,Nbed-1,iaged)*cff1+ & + & bed(i,j,Nbed,iaged)*cff2)/(cff1+cff2) + DO ised=1,NST + bed_mass(i,j,Nbed,nnew,ised)= & + & bed_mass(i,j,Nbed-1,nnew,ised)+ & + & bed_mass(i,j,Nbed ,nnew,ised) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,Nbed,ised)=bed(i,j,Nbed-1,ised)+ & + & bed(i,j,Nbed,ised) + END DO +# endif + ! + ! Push layers down. + DO k=Nbed-1,2,-1 + bed(i,j,k,iporo)=bed(i,j,k-1,iporo) + bed(i,j,k,iaged)=bed(i,j,k-1,iaged) + DO ised =1,NST + bed_mass(i,j,k,nnew,ised)= & + & bed_mass(i,j,k-1,nnew,ised) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,k,ised)=bed(i,j,k-1,ised) + END DO +# endif + END DO + ! Set new top parameters for top 2 layers + DO ised=1,NST + bed_mass(i,j,2,nnew,ised)= & + & MAX(bed_mass(i,j,2,nnew,ised)- & + & dep_mass(i,ised),0.0_r8) + bed_mass(i,j,1,nnew,ised)=dep_mass(i,ised) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,2,ised)= & + & bed(i,j,2,ised)-MAX(0.0_r8, & + & ndep_diss(i,j,ised-iboxy+1)) + bed(i,j,1,ised)=MAX(0.0_r8, & + & ndep_diss(i,j,ised-iboxy+1)) + END DO +# endif + END IF + ELSEIF (Nbed.eq.2) THEN + ! NBED=2 + cff1=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff1=cff1+bed_mass(i,j,1,nnew,ised) + cff2=cff2+bed_mass(i,j,2,nnew,ised) + END DO + DO ised=1,NST + bed_mass(i,j,2,nnew,ised)= & + & MAX(bed_mass(i,j,2,nnew,ised)+ & + & bed_mass(i,j,1,nnew,ised)- & + & dep_mass(i,ised),0.0_r8) + bed_mass(i,j,1,nnew,ised)=dep_mass(i,ised) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,2,ised)=MAX(0.0_r8, & + & bed(i,j,2,ised)+bed(i,j,1,ised) & + & -MAX(0.0_r8,ndep_diss(i,j,ised-iboxy+1))) + bed(i,j,1,ised)=MAX(0.0_r8, & + & ndep_diss(i,j,ised-iboxy+1)) + END DO +# endif + ! ALA - average time and porosity + bed(i,j,2,iaged)=(bed(i,j,1,iaged)*cff1+ & + & bed(i,j,2,iaged)*cff2)/(cff1+cff2) + bed(i,j,1,iaged)=time(ng) + bed(i,j,2,iporo)=(bed(i,j,1,iporo)*cff1+ & + & bed(i,j,2,iporo)*cff2)/(cff1+cff2) + ! ALA CHECK WITH CRS POROSITY OF 1ST LAYER + bed(i,j,1,iporo)=bed(i,j,1,iporo) + ELSE + ! NBED=1 + END IF + ELSE + ! Net deposition has occured, but no new bed layer was created + END IF + ELSE + ! Net erosion occurred + bed(i,j,1,iaged)=time(ng) + IF (Nbed.eq.2) THEN + ! NBED=2 + DO ised=1,NST + bed_mass(i,j,2,nnew,ised)= & + & MAX(bed_mass(i,j,2,nnew,ised)+ & + & bed_mass(i,j,1,nnew,ised)- & + & dep_mass(i,ised),0.0_r8) + bed_mass(i,j,1,nnew,ised)=dep_mass(i,ised) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,2,ised)=MAX(0.0_r8, & + & bed(i,j,2,ised)+bed(i,j,1,ised) & + & -MAX(0.0_r8,ndep_diss(i,j,ised-iboxy+1))) + bed(i,j,1,ised)=MAX(0.0_r8, & + & ndep_diss(i,j,ised-iboxy+1)) + END DO +# endif + + ELSEIF (Nbed.eq.1) THEN + ! ALF NO NEED TO DO ANYTHING + ELSE + END IF + END IF + + ! Recalculate thickness and fractions for all layers. + DO k=1,Nbed + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,k,nnew,ised) + END DO + IF (cff3.eq.0.0_r8) THEN + cff3=eps + END IF + bed(i,j,k,ithck)=0.0_r8 + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_mass(i,j,k,nnew,ised)/cff3 + bed(i,j,k,ithck)=MAX(bed(i,j,k,ithck)+ & + & bed_mass(i,j,k,nnew,ised)/ & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,k,iporo))),0.0_r8) + END DO + END DO + END DO + END DO J_LOOP2 + + J_LOOP3 : DO j=Jstr,Jend + DO i=Istr,Iend + IF (bottom(i,j,iactv).gt.bed(i,j,1,ithck)) THEN + IF (Nbed.eq.1) THEN + bottom(i,j,iactv)=bed(i,j,1,ithck) + ELSE + thck_to_add=bottom(i,j,iactv)-bed(i,j,1,ithck) + thck_avail=0.0_r8 + Ksed=1 ! initialize + DO k=2,Nbed + IF (thck_avail.lt.thck_to_add) THEN + thck_avail=thck_avail+bed(i,j,k,ithck) + Ksed=k + END IF + END DO +! +! Catch here if there was not enough bed material. +! + IF (thck_avail.lt.thck_to_add) THEN + bottom(i,j,iactv)=bed(i,j,1,ithck)+thck_avail + thck_to_add=thck_avail + END IF +! +! Update bed mass of top layer and fractional layer. +! + cff2=MAX(thck_avail-thck_to_add,0.0_r8)/ & + & MAX(bed(i,j,Ksed,ithck),eps) + DO ised=1,NST + cff1=0.0_r8 + DO k=1,Ksed + cff1=cff1+bed_mass(i,j,k,nnew,ised) + END DO + cff3=cff2*bed_mass(i,j,Ksed,nnew,ised) + bed_mass(i,j,1 ,nnew,ised)=cff1-cff3 + bed_mass(i,j,Ksed,nnew,ised)=cff3 + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + cff1=0.0_r8 + DO k=1,Ksed + cff1=cff1+bed(i,j,k,ised) + END DO + cff3=MIN(cff1-eps,MAX(eps,cff2*bed(i,j,Ksed,ised))) + bed(i,j,1 ,ised)=cff1-cff3 + bed(i,j,Ksed,ised)=cff3 + END DO +# endif +! +! Update thickness of fractional layer ksource_sed. +! + bed(i,j,Ksed,ithck)=MAX(thck_avail-thck_to_add,0.0_r8) +! +! Update bed fraction of top layer. +! + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,1,nnew,ised) + END DO + IF (cff3.eq.0.0_r8) THEN + cff3=eps + END IF + DO ised=1,NST + bed_frac(i,j,1,ised)=bed_mass(i,j,1,nnew,ised)/cff3 + END DO +! +! Upate bed thickness of top layer. +! + bed(i,j,1,ithck)=bottom(i,j,iactv) +! +! Pull all layers closer to the surface. +! + DO k=Ksed,Nbed + ks=Ksed-2 + bed(i,j,k-ks,ithck)=bed(i,j,k,ithck) + bed(i,j,k-ks,iporo)=bed(i,j,k,iporo) + bed(i,j,k-ks,iaged)=bed(i,j,k,iaged) + DO ised=1,NST + bed_frac(i,j,k-ks,ised)=bed_frac(i,j,k,ised) + bed_mass(i,j,k-ks,nnew,ised)=bed_mass(i,j,k,nnew,ised) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,k-ks,ised)=bed(i,j,k,ised) + END DO +# endif + END DO +! +! Add new layers onto the bottom. Split what was in the bottom layer to +! fill these new empty cells. ("ks" is the number of new layers). +! + ks=Ksed-2 + ! ALA CHECK WITH CRS about bed_frac + nnn=0 + DO ised=1,NST + nlysm(ised)=newlayer_thick(ng)*REAL(ks+1,r8)* & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,Nbed-ks,iporo)))* & + & bed_frac(i,j,Nbed-ks,ised) + IF (ks.gt.0) THEN + IF (bed_mass(i,j,Nbed-ks,nnew,ised).gt. & + & nlysm(ised)) THEN + nnn=nnn+1 + nlysm(ised)= & + & newlayer_thick(ng)*REAL(ks,r8)* & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,Nbed-ks,iporo)))* & + & bed_frac(i,j,Nbed-ks,ised) + END IF + END IF + END DO + IF (nnn.eq.NST) THEN + bed(i,j,Nbed,ithck)=bed(i,j,Nbed-ks,ithck)- & + & newlayer_thick(ng)*REAL(ks,r8) + DO ised=1,NST + bed_mass(i,j,Nbed,nnew,ised)= & + & bed_mass(i,j,Nbed-ks,nnew,ised)-nlysm(ised) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + nlysm_diss(ised-iboxy+1)=newlayer_thick(ng) & + & /(MAX(eps,bed(i,j,Nbed-ks,ithck))) & + & *REAL(ks,r8)*bed(i,j,Nbed-ks,ised) + bed(i,j,Nbed,ised)= bed(i,j,Nbed-ks,ised)- & + & nlysm_diss(ised-iboxy+1) + END DO +# endif + DO k=Nbed-1,Nbed-ks,-1 + bed(i,j,k,ithck)=newlayer_thick(ng) + bed(i,j,k,iaged)=bed(i,j,Nbed-ks,iaged) + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_frac(i,j,Nbed-ks,ised) + bed_mass(i,j,k,nnew,ised)= & + & nlysm(ised)/REAL(ks,r8) + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,k,ised)= & + & nlysm_diss(ised-iboxy+1)/REAL(ks,r8) + END DO +# endif + END DO + ELSE + cff=1.0_r8/REAL(ks+1,r8) + DO k=Nbed,Nbed-ks,-1 + bed(i,j,k,ithck)=bed(i,j,Nbed-ks,ithck)*cff + bed(i,j,k,iaged)=bed(i,j,Nbed-ks,iaged) + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_frac(i,j,Nbed-ks,ised) + bed_mass(i,j,k,nnew,ised)= & + & bed_mass(i,j,Nbed-ks,nnew,ised)*cff + END DO +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU + DO ised=iboxy,ibodu + bed(i,j,k,ised)= bed(i,j,Nbed-ks,ised)*cff + END DO +# endif + END DO + END IF + END IF ! Nbed > 1 + END IF ! increase top bed layer + END DO + END DO J_LOOP3 +# if defined SEDBIO_COUP +# if defined OXYGEN && defined ODU +! +!----------------------------------------------------------------------- +! Diffusion across the seabed-water interface. +! +! The user may assume either "instantaneous diffusion", i.e. that the +! top seabed layer and bottom water column layer are in equilibrium). +! Or, the user may use a Fickian diffusion scheme based on a +! diffusion coefficient and an assumed length scale of 2 mm. +! +! Note that t(i,j,*,nnew,*) is in units of mmol/m2, but t(i,j,*,3,*) is +! in units of mmol/m3 +!----------------------------------------------------------------------- +! + J_LOOP4 : DO j=Jstr,Jend + DO i=Istr,Iend + DO ised=iboxy,ibodu + IF (ised.eq.iboxy) THEN + iwc=iOxyg +# if defined DIAGNOSTICS_BIO + idf=isdO2 +# endif + ELSEIF (ised.eq.ibodu) THEN + iwc=iODU_ +# if defined DIAGNOSTICS_BIO + idf=isdOD +# endif + ELSEIF (ised.eq.ibno3) THEN + iwc=iNO3_ +# if defined DIAGNOSTICS_BIO + idf=isdNO +# endif + ELSEIF (ised.eq.ibnh4) THEN + iwc=iNH4_ +# if defined DIAGNOSTICS_BIO + idf=isdNH +# endif + ENDIF +# if defined INSTANT_DIFFUSION + cff1=MAX(0.0_r8,t(i,j,1,nnew,iwc))+ & + & MAX(0.0_r8,bed(i,j,1,ised)) + cff2=MIN(1.0_r8,MAX(0.0_r8,Hz(i,j,1)/ & + & (Hz(i,j,1)+MAX(bed(i,j,1,ithck)*bed(i,j,1,iporo), & + & 0.0_r8)))) +# if defined DIAGNOSTICS_BIO + DiaBio2d(i,j,idf)=DiaBio2d(i,j,idf) + & +# ifdef WET_DRY + & rmask_full(i,j)* & +# endif + & cff1*cff2-t(i,j,1,nnew,iwc) +# endif + t(i,j,1,nnew,iwc)=cff1*cff2 + bed(i,j,1,ised)=cff1*(1.0_r8-cff2) +# else +! cff1=dC/dz in mmol/m3/m +! cff2=diffusive flux out of seabed in mmol/m2 +! cff3=equilibrium concentration in water column +! cff4=equilibrium concentration in seabed +! cff5 = vertical distance for diffusion + cff5 = 0.000001_r8 + cff1=(t(i,j,1,nnew,iwc)/MAX(eps,Hz(i,j,1)) & + & -bed(i,j,1,ised)/ & + & MAX(eps,bed(i,j,1,ithck)*bed(i,j,1,iporo))) & + & / MAX(eps,cff5) +! & / MAX(eps,bed(i,j,1,ithck)) + cff2=-1.0_r8*bed(i,j,1,iporo)*D_sw*cff1*dt(ng) + cff3=(t(i,j,1,nnew,iwc)+MAX(eps,bed(i,j,1,ised))) & + & *(Hz(i,j,1) & + & /MAX(eps,Hz(i,j,1)+bed(i,j,1,ithck)*bed(i,j,1,iporo))) + cff4=(t(i,j,1,nnew,iwc)+bed(i,j,1,ised)) & + & *(bed(i,j,1,ithck)*bed(i,j,1,iporo) & + & /MAX(eps,Hz(i,j,1)+bed(i,j,1,ithck)*bed(i,j,1,iporo))) +# if defined DIAGNOSTICS_BIO + DiaBio2d(i,j,idf)=DiaBio2d(i,j,idf) + & +# ifdef WET_DRY + & rmask_full(i,j)* & +# endif + & cff2 +# endif + t(i,j,1,nnew,iwc)=t(i,j,1,nnew,iwc) + cff2 + bed(i,j,1,ised)=bed(i,j,1,ised) - cff2 + IF ( ((cff2.gt.eps).and.(t(i,j,1,nnew,iwc).gt.cff3)).or. & + & ((cff2.lt.(eps*-1.0_r8)).and.(bed(i,j,1,ised).gt.cff4))) & + & THEN +! diffusion exceeded equilibrium +# if defined DIAGNOSTICS_BIO + DiaBio2d(i,j,idf)=DiaBio2d(i,j,idf) + & +# ifdef WET_DRY + & rmask_full(i,j)* & +# endif + & cff3-t(i,j,1,nnew,iwc) +# endif + t(i,j,1,nnew,iwc)=cff3 + bed(i,j,1,ised)=cff4 + ENDIF +# endif + END DO + END DO + END DO J_LOOP4 +# endif +# endif +! +!----------------------------------------------------------------------- +! Store old bed thickness. +!----------------------------------------------------------------------- +! +# if defined SED_MORPH + DO j=JstrR,JendR + DO i=IstrR,IendR + bed_thick(i,j,nnew)=0.0_r8 + DO k=1,Nbed + bed_thick(i,j,nnew)=bed_thick(i,j,nnew)+ & + & bed(i,j,k,ithck) + END DO + END DO + END DO + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + CALL exchange_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & bed_thick(:,:,nnew)) + END IF +# endif +! +!----------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions to property arrays. +!----------------------------------------------------------------------- +! + DO ised=1,NST + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_frac(:,:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed_frac, & + & bed_mass(:,:,:,nnew,:)) +# endif + + DO i=1,MBEDP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed(:,:,:,i)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, MBEDP, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed) +# endif + + RETURN + END SUBROUTINE sed_bed_tile +#endif + END MODULE sed_bed_mod2 diff --git a/ROMS/Nonlinear/Sediment/sed_bed_cohesive.F b/ROMS/Nonlinear/Sediment/sed_bed_cohesive.F new file mode 100644 index 00000000..9127cdc0 --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sed_bed_cohesive.F @@ -0,0 +1,1040 @@ +#include "cppdefs.h" + + MODULE sed_bed_cohesive_mod +!#if defined NONLINEAR && defined SEDIMENT && defined COHESIVE_BED +#if defined NONLINEAR && defined SEDIMENT +#if defined COHESIVE_BED || defined MIXED_BED +! +!git $Id$ +!==================================================== John C. Warner === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Hernan G. Arango ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! This routine computes sediment bed layer stratigraphy. ! +! ! +! Warner, J.C., C.R. Sherwood, R.P. Signell, C.K. Harris, and H.G. ! +! Arango, 2008: Development of a three-dimensional, regional, ! +! coupled wave, current, and sediment-transport model, Computers ! +! & Geosciences, 34, 1284-1306. ! +! ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: sed_bed_cohesive + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sed_bed_cohesive (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_sedbed + USE mod_stepping +# ifdef BBL_MODEL + USE mod_bbl +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL sed_bed_cohesive_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & +# ifdef WET_DRY + & GRID(ng) % rmask_wet, & +# endif +# ifdef BBL_MODEL + & BBL(ng) % bustrc, & + & BBL(ng) % bvstrc, & + & BBL(ng) % bustrw, & + & BBL(ng) % bvstrw, & + & BBL(ng) % bustrcwmax, & + & BBL(ng) % bvstrcwmax, & +# else + & FORCES(ng) % bustr, & + & FORCES(ng) % bvstr, & +# endif + & OCEAN(ng) % t, & +# ifdef SUSPLOAD + & SEDBED(ng) % ero_flux, & + & SEDBED(ng) % settling_flux, & +# endif +# if defined SED_MORPH + & SEDBED(ng) % bed_thick, & +# endif + & SEDBED(ng) % bed, & + & SEDBED(ng) % bed_frac, & + & SEDBED(ng) % bed_mass, & + & SEDBED(ng) % bottom) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE sed_bed_cohesive +! +!*********************************************************************** + SUBROUTINE sed_bed_cohesive_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & +# ifdef WET_DRY + & rmask_wet, & +# endif +# ifdef BBL_MODEL + & bustrc, bvstrc, & + & bustrw, bvstrw, & + & bustrcwmax, bvstrcwmax, & +# else + & bustr, bvstr, & +# endif + & t, & +# ifdef SUSPLOAD + & ero_flux, settling_flux, & +# endif +# if defined SED_MORPH + & bed_thick, & +# endif + & bed, bed_frac, bed_mass, & + & bottom) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment +! + USE bc_3d_mod, ONLY : bc_r3d_tile + USE exchange_2d_mod, ONLY : exchange_r2d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:,LBj:) +# endif +# ifdef BBL_MODEL + real(r8), intent(in) :: bustrc(LBi:,LBj:) + real(r8), intent(in) :: bvstrc(LBi:,LBj:) + real(r8), intent(in) :: bustrw(LBi:,LBj:) + real(r8), intent(in) :: bvstrw(LBi:,LBj:) + real(r8), intent(in) :: bustrcwmax(LBi:,LBj:) + real(r8), intent(in) :: bvstrcwmax(LBi:,LBj:) +# else + real(r8), intent(in) :: bustr(LBi:,LBj:) + real(r8), intent(in) :: bvstr(LBi:,LBj:) +# endif +# if defined SED_MORPH + real(r8), intent(inout):: bed_thick(LBi:,LBj:,:) +# endif + real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:) +# ifdef SUSPLOAD + real(r8), intent(inout) :: ero_flux(LBi:,LBj:,:) + real(r8), intent(inout) :: settling_flux(LBi:,LBj:,:) +# endif + real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bottom(LBi:,LBj:,:) +# else +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj) +# endif +# ifdef BBL_MODEL + real(r8), intent(in) :: bustrc(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstrc(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bustrw(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstrw(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bustrcwmax(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstrcwmax(LBi:UBi,LBj:UBj) +# else + real(r8), intent(in) :: bustr(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstr(LBi:UBi,LBj:UBj) +# endif +# if defined SED_MORPH + real(r8), intent(inout):: bed_thick(LBi:UBi,LBj:UBj,3) +# endif + real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng)) +# ifdef SUSPLOAD + real(r8), intent(inout) :: ero_flux(LBi:UBi,LBj:UBj,NST) + real(r8), intent(inout) :: settling_flux(LBi:UBi,LBj:UBj,NST) +# endif + real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) + real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) + real(r8), intent(inout) :: bottom(LBi:UBi,LBj:UBj,MBOTP) +# endif +! +! Local variable declarations. +! + integer :: Ksed, i, ised, j, k, ks + integer :: bnew, nnn + + real(r8), parameter :: eps = 1.0E-14_r8 + + real(r8) :: cff, cff1, cff2, cff3,cff4 + real(r8) :: thck_avail, thck_to_add + + real(r8), dimension(NST) :: nlysm + + real(r8), dimension(IminS:ImaxS,NST) :: dep_mass + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tau_w +# if defined MIXED_BED + real(r8) :: pcoh +# endif +# if defined COHESIVE_BED || defined MIXED_BED + real(r8) :: alpha, bzactv, frt, tcb_top, tcb_bot + real(r8), dimension(Nbed) :: tcr +# endif +# if defined COHESIVE_BED || defined MIXED_BED + real(r8), dimension(Nbed) :: bmz +# endif +# if defined SED_FLOCS && defined SED_DEFLOC + real(r8), dimension(NCS) :: masseq +# endif +# include "set_bounds.h" + +# ifdef BEDLOAD + bnew=nnew +# else + bnew=nstp +# endif + +! KLUDGE alert +! minlayer_thick(ng) = 0.0005 +minlayer_thick(ng) = newlayer_thick(ng) +! +!----------------------------------------------------------------------- +! Compute sediment bed layer stratigraphy. +!----------------------------------------------------------------------- +! +# if defined BEDLOAD_MPM || defined SUSPLOAD +# ifdef BBL_MODEL + DO j=Jstr-1,Jend+1 + DO i=Istr-1,Iend+1 + tau_w(i,j)=SQRT(bustrcwmax(i,j)*bustrcwmax(i,j)+ & + & bvstrcwmax(i,j)*bvstrcwmax(i,j)) +# ifdef WET_DRY + tau_w(i,j)=tau_w(i,j)*rmask_wet(i,j) +# endif + END DO + END DO +# else + DO j=Jstrm1,Jendp1 + DO i=Istrm1,Iendp1 + tau_w(i,j)=0.5_r8*SQRT((bustr(i,j)+bustr(i+1,j))* & + & (bustr(i,j)+bustr(i+1,j))+ & + & (bvstr(i,j)+bvstr(i,j+1))* & + & (bvstr(i,j)+bvstr(i,j+1))) +# ifdef WET_DRY + tau_w(i,j)=tau_w(i,j)*rmask_wet(i,j) +# endif + END DO + END DO +# endif +# endif +! +!----------------------------------------------------------------------- +! Update bed properties according to ero_flux and dep_flux. +!----------------------------------------------------------------------- +! +# ifdef SUSPLOAD + J_LOOP : DO j=Jstr,Jend +! +! The deposition and resuspension of sediment on the bottom "bed" +! is due to precipitation flux FC(:,0), already computed, and the +! resuspension (erosion, hence called ero_flux). The resuspension is +! applied to the bottom-most grid box value qc(:,1) so the total mass +! is conserved. Restrict "ero_flux" so that "bed" cannot go negative +! after both fluxes are applied. +! + DO i=Istr,Iend + SED_LOOP: DO ised=1,NST + dep_mass(i,ised)=0.0_r8 +# ifdef SED_MORPH + ! Apply morphology factor. + ero_flux(i,j,ised)=ero_flux(i,j,ised)*morph_fac(ised,ng) + settling_flux(i,j,ised)=settling_flux(i,j,ised)* & + & morph_fac(ised,ng) +# endif + + ! Update bed mass arrays. + bed_mass(i,j,1,nnew,ised)=MAX(bed_mass(i,j,1,bnew,ised)- & + & (ero_flux(i,j,ised)- & + & settling_flux(i,j,ised)), & + & 0.0_r8) + DO k=2,Nbed + bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nstp,ised) + END DO + END DO SED_LOOP + + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,1,nnew,ised) + END DO + + IF (cff3.eq.0.0_r8) THEN + cff3=eps + END IF + bed(i,j,1,ithck)=0.0_r8 + DO ised=1,NST + bed_frac(i,j,1,ised)=bed_mass(i,j,1,nnew,ised)/cff3 + bed(i,j,1,ithck)=MAX(bed(i,j,1,ithck)+ & + & bed_mass(i,j,1,nnew,ised)/ & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,1,iporo))),0.0_r8) + END DO + END DO + + END DO J_LOOP +# endif /* SUSPLOAD section */ +! +!----------------------------------------------------------------------- +! At this point, all deposition or erosion is complete, and +! has been added/subtracted to top layer. Thickness has NOT been corrected. +!----------------------------------------------------------------------- +! + J_LOOP_CB : DO j=Jstr,Jend + I_LOOP_CB: DO i=Istr,Iend +! Calculate active layer thickness, bottom(i,j,iactv). +! (trunk version allows this to be zero...this has minimum of 6*D50) + bottom(i,j,iactv)=MAX(0.0_r8, & + & 0.007_r8* & + & (tau_w(i,j)-bottom(i,j,itauc))*rho0)+ & + & 6.0_r8*bottom(i,j,isd50) +# if defined COHESIVE_BED + bottom(i,j,iactv)=MAX(0.0_r8, & + & 0.007_r8* & + & (tau_w(i,j)*rho0-bed(i,j,1,ibtcr)))+ & + & 6.0_r8*bottom(i,j,isd50) +# endif +# if defined MIXED_BED + cff1= MAX(0.0_r8, & + & 0.007_r8* & + & (tau_w(i,j)*rho0-bed(i,j,1,ibtcr)))+ & + & 6.0_r8*bottom(i,j,isd50) + cff2= MAX(0.0_r8, & + & 0.007_r8* & + & (tau_w(i,j)-bottom(i,j,itauc))*rho0)+ & + & 6.0_r8*bottom(i,j,isd50) + bottom(i,j,iactv)=MAX(cff1,cff2) +# endif +# ifdef SED_MORPH + ! Apply morphology factor. + bottom(i,j,iactv)=MAX(bottom(i,j,iactv)*morph_fac(1,ng), & + & bottom(i,j,iactv)) +# endif +# if defined COHESIVE_BED || defined MIXED_BED +! Find first layer with tc > tb +! Remember, the critical stresses apply to the TOP of each layer + Ksed = 1 + bzactv = 0.0_r8 + frt = 0.0_r8 ! CRS + cff1 = rho0*tau_w(i,j) + tcb_top = bed(i,j,1,ibtcr) + tcb_bot = bed(i,j,2,ibtcr) +# if defined MIXED_BED +! Calc. tau crit for bottom of next layer +! Update cohesive property of seds in top layer + cff3 = 0.0_r8 + cff4 = 1.0_r8 + DO ised=1,NCS + cff3=cff3+bed_frac(i,j,1,ised) + cff4=cff4*tau_ce(ised,ng)**bed_frac(i,j,1,ised) + END DO + DO ised=NCS+1,NST + cff4=cff4*tau_ce(ised,ng)**bed_frac(i,j,1,ised) + ENDDO + pcoh=min(max((cff3-transN(ng))/(transC(ng)-transN(ng)) & + & ,0.0_r8),1.0_r8) + tcb_top = pcoh*bed(i,j,1,ibtcr)+(pcoh-1.0_r8)*cff4*rho0 !BF +# endif + IF(cff1 .GT. tcb_top)THEN +! Calculate tcb_temp for next layer + tcb_bot = bed(i,j,Ksed+1,ibtcr) +# if defined MIXED_BED +! Recalculate cohesive fraction and mean grain tau crit +! Note that Ksed is used for grain props, and Ksed+1 for +! bed tau crit at bottom of layer Ksed + cff3 = 0.0_r8 + cff4 = 1.0_r8 + DO ised=1,NCS + cff3=cff3+bed_frac(i,j,Ksed,ised) + cff4=cff4*tau_ce(ised,ng)**bed_frac(i,j,Ksed,ised) + END DO + DO ised=NCS+1,NST + cff4=cff4*tau_ce(ised,ng)**bed_frac(i,j,Ksed,ised) + ENDDO +! Calculate cohesive behavior and blended tau crit + pcoh=min(max((cff3-transN(ng))/(transC(ng)-transN(ng)), & + & 0.0_r8),1.0_r8) + tcb_bot =pcoh*bed(i,j,Ksed+1,ibtcr)+(pcoh-1.0_r8)*cff4*rho0 !BF +# endif + DO WHILE ( (Ksed.LE.(Nbed-1)) .AND. & + & (cff1 .GT. tcb_bot)) +!ALA Instead of adding entire 2nd layer, add just what is needed +!ALA! Add entire layer +!ALA bzactv = bzactv + bed(i,j,Ksed,ithck) +! Add thickness equivalent to difference between cff1 and tcb_bot + IF (cff1.GT.bed(i,j,Ksed+1,ibtcr)) THEN + bzactv = bzactv + bed(i,j,Ksed,ithck) + tcb_top = tcb_bot + tcb_bot = bed(i,j,Ksed+1,ibtcr) + ELSE + bzactv = bzactv + MIN(bed(i,j,Ksed,ithck), & + & (MAX(0.0_r8,0.007_r8*(cff1-tcb_bot)))) + tcb_top = cff1 + tcb_bot = bed(i,j,Ksed+1,ibtcr) + ENDIF +# if defined MIXED_BED +! Recalculate cohesive fraction and mean grain tau crit + cff3 = 0.0_r8 + cff4 = 1.0_r8 + DO ised=1,NCS + cff3=cff3+bed_frac(i,j,Ksed,ised) + cff4=cff4*tau_ce(ised,ng)**bed_frac(i,j,Ksed,ised) + END DO + DO ised=NCS+1,NST + cff4=cff4*tau_ce(ised,ng)**bed_frac(i,j,Ksed,ised) + ENDDO +! Calculate cohesive behavior and blended tau crit + pcoh=min(max((cff3-transN(ng))/(transC(ng)-transN(ng)), & + & 0.0_r8),1.0_r8) + tcb_bot = pcoh*bed(i,j,Ksed+1,ibtcr)+(pcoh-1.0_r8)*cff4 & + & *rho0 !BF +#endif + Ksed = Ksed+1 + ENDDO + frt = MAX(0.0_r8,(cff1-tcb_top) ) / & + & MAX( eps, & + & ( tcb_bot-tcb_top )) + ENDIF + bzactv = bzactv+frt*bed(i,j,Ksed,ithck) + bzactv = MAX( bzactv, 6.0_r8*bottom(i,j,isd50) ) !CRS + bottom(i,j,iactv)=min(bottom(i,j,iactv),bzactv) !?CRS +! bottom(i,j,iactv)=max(bottom(i,j,iactv),bzactv) !?CRS +# endif /* defined COHESIVE_BED || defined MIXED_BED */ + END DO I_LOOP_CB + END DO J_LOOP_CB + + J_LOOP2 : DO j=Jstr,Jend + DO i=Istr,Iend + +! +! Calculate net deposition and erosion + cff=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff=cff+settling_flux(i,j,ised) + cff2=cff2+ero_flux(i,j,ised) + dep_mass(i,ised)=0.0_r8 + IF ((ero_flux(i,j,ised)-settling_flux(i,j,ised)).lt. & + & 0.0_r8) THEN + dep_mass(i,ised)=settling_flux(i,j,ised)- & + & ero_flux(i,j,ised) + END IF + END DO + bottom(i,j,idnet)=cff-cff2 + + IF ( cff-cff2.GT.0.0_r8) THEN ! NET deposition + ! Deposition. Determine if we need to create a new bed layer + +#if defined COHESIVE_BED || defined MIXED_BED +! +! Calculate tau_crit of deposited bed +! +! Calculate new mass in top layer + bmz(1) = 0.0_r8 + DO ised=1,NST + bmz(1) = bmz(1)+bed_mass(i,j,1,nnew,ised) + END DO + IF (Nbed.GT.1) THEN +! Average of cff1 and cff2, where +! cff1 = linear extension of previous tcr slope to new surface +! cff2 = minimum deposition + cff1 = bed(i,j,1,ibtcr) - & + & bottom(i,j,idnet) * & + & (bed(i,j,2,ibtcr)-bed(i,j,1,ibtcr)) / & + & (bmz(1)-bottom(i,j,idnet)) + cff2 = MAX( rho0*tau_w(i,j) , tcr_min(ng) ) + bed(i,j,1,ibtcr) = MIN(bed(i,j,1,ibtcr), & + & MAX( 0.5_r8*(cff1+cff2), cff2 )) +! cff1 = bottom(i,j,idnet)/MAX(bmz(1),eps) +! cff2 = bed(i,j,1,ibtcr)+bed(i,j,2,ibtcr)-2*tcr_min(ng) +! bed(i,j,1,ibtcr) =bed(i,j,1,ibtcr) - cff1*cff2 + ELSE +! TODO: Not sure what mud tau_crit should be for single-layer bed. +! Try weighted average of dep and old value + cff1 = (bed(i,j,1,ibtcr)*(bmz(1)-bottom(i,j,idnet)) & + & + cff2*bottom(i,j,idnet)) / bmz(1) + bed(i,j,1,ibtcr) = MAX( cff1, cff2 ) + END IF +#endif + ! (no test for age here) + bed(i,j,1,iaged)=time(ng) + IF(bed(i,j,1,ithck).gt. & + & MAX(bottom(i,j,iactv),newlayer_thick(ng))) THEN + ! Top layer is too thick + IF (Nbed.gt.2) THEN + IF(bed(i,j,2,ithck).lt.minlayer_thick(ng)) THEN + ! Layer 2 is smaller than minimum size + ! Instead of pushing down all layers, just combine top 2 layers + cff=0.0_r8 + cff1=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff =cff +dep_mass(i,ised) + cff1=cff1+bed_mass(i,j,1,nnew,ised) + cff2=cff2+bed_mass(i,j,2,nnew,ised) + END DO +#if defined COHESIVE_BED || defined MIXED_BED +! +! Assign new tau_crit at 2nd layer +! + bed(i,j,2,ibtcr)= bed(i,j,2,ibtcr) - & + & (cff1-cff)/(cff1+cff2)*(bed(i,j,3,ibtcr)-bed(i,j,1,ibtcr)) +! bed(i,j,2,ibtcr) = 0.5_r8*( bed(i,j,1,ibtcr)+ & +! & bed(i,j,2,ibtcr) ) +#endif +! + + ! Update bed mass + DO ised=1,NST + bed_mass(i,j,2,nnew,ised)= & + & MAX(bed_mass(i,j,2,nnew,ised)+ & + & bed_mass(i,j,1,nnew,ised)- & + & dep_mass(i,ised),0.0_r8) + bed_mass(i,j,1,nnew,ised)=dep_mass(i,ised) + END DO + ! ALA - average time and porosity + ! ALA CHECK WITH CRS cff1 or cff1-cff for first layer + bed(i,j,2,iaged)=(bed(i,j,1,iaged)*cff1+ & + & bed(i,j,2,iaged)*cff2)/(cff1+cff2) + bed(i,j,1,iaged)=time(ng) + bed(i,j,2,iporo)=(bed(i,j,1,iporo)*cff1+ & + & bed(i,j,2,iporo)*cff2)/(cff1+cff2) + ! ALA CHECK WITH CRS POROSITY OF 1ST LAYER + bed(i,j,1,iporo)=bed(i,j,1,iporo) + ELSE + ! Layer 2 is > minlayer thick, need another layer + ! Combine bottom layers. + cff1=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff1=cff1+bed_mass(i,j,Nbed-1,nnew,ised) + cff2=cff2+bed_mass(i,j,Nbed,nnew,ised) + END DO + bed(i,j,Nbed,iporo)= & + & (bed(i,j,Nbed-1,iporo)*cff1+ & + & bed(i,j,Nbed,iporo)*cff2)/(cff1+cff2) + bed(i,j,Nbed,iaged)= & + & (bed(i,j,Nbed-1,iaged)*cff1+ & + & bed(i,j,Nbed,iaged)*cff2)/(cff1+cff2) +#if defined COHESIVE_BED || defined MIXED_BED +! +! Assign tcrit at top of new bottom bed tcrit for Nbed-1 + bed(i,j,Nbed,ibtcr)= bed(i,j,Nbed-1,ibtcr) +! bed(i,j,Nbed,ibtcr)=bed(i,j,Nbed-1,ibtcr) + & +! & cff2*(bed(i,j,Nbed,ibtcr)-bed(i,j,Nbed-1,ibtcr))/cff1 +#endif + + DO ised=1,NST + bed_mass(i,j,Nbed,nnew,ised)= & + & bed_mass(i,j,Nbed-1,nnew,ised)+ & + & bed_mass(i,j,Nbed ,nnew,ised) + END DO + ! + ! Push layers down. + DO k=Nbed-1,2,-1 + bed(i,j,k,iporo)=bed(i,j,k-1,iporo) + bed(i,j,k,iaged)=bed(i,j,k-1,iaged) + DO ised =1,NST + bed_mass(i,j,k,nnew,ised)= & + & bed_mass(i,j,k-1,nnew,ised) + END DO +#if defined COHESIVE_BED || defined MIXED_BED + bed(i,j,k,ibtcr)=bed(i,j,k-1,ibtcr) +#endif + END DO + ! Set new top parameters for top 2 layers +#if defined COHESIVE_BED || defined MIXED_BED + ! Tau_crit at top already determined + ! Set tau_crit at 2nd layer + cff=0.0_r8 + cff1=0.0_r8 + DO ised=1,NST + cff =cff +dep_mass(i,ised) + cff1=cff1+bed_mass(i,j,1,nnew,ised) + END DO + + cff2 = (bed(i,j,2,ibtcr)-bed(i,j,1,ibtcr))/cff1 + bed(i,j,2,ibtcr) = bed(i,j,1,ibtcr)+cff*cff2 +#endif + + DO ised=1,NST + bed_mass(i,j,2,nnew,ised)= & + & MAX(bed_mass(i,j,2,nnew,ised)- & + & dep_mass(i,ised),0.0_r8) + bed_mass(i,j,1,nnew,ised)=dep_mass(i,ised) + END DO + END IF + ELSEIF (Nbed.eq.2) THEN + ! NBED=2 + ! +#if defined COHESIVE_BED || defined MIXED_BED + ! Tau_crit at top already determined + ! Set tau_crit at 2nd layer + cff=0.0_r8 + cff1=0.0_r8 + DO ised=1,NST + cff =cff +dep_mass(i,ised) + cff1=cff1+bed_mass(i,j,1,nnew,ised) + END DO + cff2 = (bed(i,j,2,ibtcr)-bed(i,j,1,ibtcr))/cff1 + bed(i,j,2,ibtcr) = bed(i,j,1,ibtcr)+cff*cff2 +#endif + cff1=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff1=cff1+bed_mass(i,j,1,nnew,ised) + cff2=cff2+bed_mass(i,j,2,nnew,ised) + END DO + DO ised=1,NST + bed_mass(i,j,2,nnew,ised)= & + & MAX(bed_mass(i,j,2,nnew,ised)+ & + & bed_mass(i,j,1,nnew,ised)- & + & dep_mass(i,ised),0.0_r8) + bed_mass(i,j,1,nnew,ised)=dep_mass(i,ised) + END DO + ! ALA - average time and porosity + bed(i,j,2,iaged)=(bed(i,j,1,iaged)*cff1+ & + & bed(i,j,2,iaged)*cff2)/(cff1+cff2) + bed(i,j,1,iaged)=time(ng) + bed(i,j,2,iporo)=(bed(i,j,1,iporo)*cff1+ & + & bed(i,j,2,iporo)*cff2)/(cff1+cff2) + ! ALA CHECK WITH CRS POROSITY OF 1ST LAYER + bed(i,j,1,iporo)=bed(i,j,1,iporo) + ELSE + ! NBED=1 + END IF + ELSE + ! Net deposition has occurred, but no new bed layer was created + END IF + ELSE + ! Net erosion occurred +#if defined COHESIVE_BED || defined MIXED_BED + bmz(1) = 0.0_r8 + DO ised=1,NST + bmz(1) = bmz(1)+bed_mass(i,j,1,nnew,ised) + END DO +! recalc tc for top of bed, based on linear +! interpolation and mass removed / orig. mass in top layer + bed(i,j,1,ibtcr)=bed(i,j,1,ibtcr)+ & + & MIN(1.0_r8,-bottom(i,j,idnet)/MAX(eps,bmz(1)))* & + & MAX(0.0_r8,(bed(i,j,2,ibtcr)-bed(i,j,1,ibtcr))) +#endif + bed(i,j,1,iaged)=time(ng) + IF (Nbed.eq.2) THEN + ! NBED=2 + DO ised=1,NST + bed_mass(i,j,2,nnew,ised)= & + & MAX(bed_mass(i,j,2,nnew,ised)+ & + & bed_mass(i,j,1,nnew,ised)- & + & dep_mass(i,ised),0.0_r8) + bed_mass(i,j,1,nnew,ised)=dep_mass(i,ised) + END DO + ELSEIF (Nbed.eq.1) THEN + ! ALF NO NEED TO DO ANYTHING + ELSE + END IF + END IF + + ! Recalculate thickness and fractions for all layers. + DO k=1,Nbed + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,k,nnew,ised) + END DO + IF (cff3.eq.0.0_r8) THEN + cff3=eps + END IF + bed(i,j,k,ithck)=0.0_r8 + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_mass(i,j,k,nnew,ised)/cff3 + bed(i,j,k,ithck)=MAX(bed(i,j,k,ithck)+ & + & bed_mass(i,j,k,nnew,ised)/ & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,k,iporo))),0.0_r8) + END DO + END DO + END DO + END DO J_LOOP2 + + J_LOOP3 : DO j=Jstr,Jend + I_LOOP3 : DO i=Istr,Iend + IF (bottom(i,j,iactv).gt.bed(i,j,1,ithck)) THEN + IF (Nbed.eq.1) THEN + bottom(i,j,iactv)=bed(i,j,1,ithck) + ELSE + thck_to_add=bottom(i,j,iactv)-bed(i,j,1,ithck) + thck_avail=0.0_r8 + Ksed=1 ! initialize + DO k=2,Nbed + IF (thck_avail.lt.thck_to_add) THEN + thck_avail=thck_avail+bed(i,j,k,ithck) + Ksed=k + END IF + END DO +! +! Catch here if there was not enough bed material. +! + IF (thck_avail.lt.thck_to_add) THEN + bottom(i,j,iactv)=bed(i,j,1,ithck)+thck_avail + thck_to_add=thck_avail + END IF +! +! Update bed mass of top layer and fractional layer. +! + cff2=MAX(thck_avail-thck_to_add,0.0_r8)/ & + & MAX(bed(i,j,Ksed,ithck),eps) + DO ised=1,NST + cff1=0.0_r8 + DO k=1,Ksed + cff1=cff1+bed_mass(i,j,k,nnew,ised) + END DO + cff3=cff2*bed_mass(i,j,Ksed,nnew,ised) + bed_mass(i,j,1 ,nnew,ised)=cff1-cff3 + bed_mass(i,j,Ksed,nnew,ised)=cff3 + END DO +! +! Update thickness of fractional layer ksource_sed. +! + bed(i,j,Ksed,ithck)=MAX(thck_avail-thck_to_add,0.0_r8) + +#if defined COHESIVE_BED || defined MIXED_BED +! +! Update tau_cr of fractional layer + bed(i,j,Ksed,ibtcr) = bed(i,j,Ksed+1,ibtcr)- & + & cff2*(bed(i,j,Ksed+1,ibtcr)-bed(i,j,Ksed,ibtcr)) +#endif + +! +! Update bed fraction of top layer. +! + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,1,nnew,ised) + END DO + IF (cff3.eq.0.0_r8) THEN + cff3=eps + END IF + DO ised=1,NST + bed_frac(i,j,1,ised)=bed_mass(i,j,1,nnew,ised)/cff3 + END DO +! +! Upate bed thickness of top layer. +! + bed(i,j,1,ithck)=bottom(i,j,iactv) +! +! Pull all layers closer to the surface. +! + DO k=Ksed,Nbed + ks=Ksed-2 + bed(i,j,k-ks,ithck)=bed(i,j,k,ithck) + bed(i,j,k-ks,iporo)=bed(i,j,k,iporo) + bed(i,j,k-ks,iaged)=bed(i,j,k,iaged) + +# if defined COHESIVE_BED || defined MIXED_BED + bed(i,j,k-ks,ibtcr)=bed(i,j,k,ibtcr) +# endif + + DO ised=1,NST + bed_frac(i,j,k-ks,ised)=bed_frac(i,j,k,ised) + bed_mass(i,j,k-ks,nnew,ised)=bed_mass(i,j,k,nnew,ised) + END DO + END DO +! +! Add new layers onto the bottom. Split what was in the bottom layer to +! fill these new empty cells. ("ks" is the number of new layers). +! + ks=Ksed-2 + cff=1.0_r8/REAL(ks+1,r8) +# if defined COHESIVE_BED || defined MIXED_BED +#undef BF_TCR +#if defined BF_TCR + bmz(1) = 0.0_r8 + DO ised=1,NST + bmz(1) = bmz(1)+bed_mass(i,j,1,nnew,ised) + ENDDO + DO k=2,Nbed + bmz(k) = bmz(k-1) + DO ised=1,NST + bmz(k)=bmz(k)+bed_mass(i,j,k,nnew,ised) + ENDDO + ENDDO + tcr(1) = tcr_min(ng) + DO k=2,Nbed + tcr(k) = tcr_min(ng) + IF (bmz(k-1).GT.eps) THEN +! tcr(k) = exp((log(bmz(k-1))- & +! & bottom(i,j,idoff))/ & +! & bottom(i,j,idslp)) + tcr(k) = exp((log(bmz(k-1))- & + & tcr_off(ng))/ & + & tcr_slp(ng)) + ENDIF + tcr(k) = MIN( MAX( tcr(k), tcr_min(ng)), tcr_max(ng) ) + ENDDO +#else +!alf cff1 = cff*(tcr_max(ng)-bed(i,j,Nbed-ks,ibtcr)) +!alf Use the value from the bottom layer as max. + cff1 = cff*(bed(i,j,Nbed,ibtcr)-bed(i,j,Nbed-ks,ibtcr)) +#endif + +# if defined COHESIVE_BED || defined MIXED_BED +! Interpolate bottom layer to tau_crit_max +! TODO: should be the reference profile and not tau_crit_max + DO k=Nbed-1,Nbed-ks,-1 +#if defined BF_TCR + bed(i,j,k,ibtcr)=tcr(k) +#else + bed(i,j,k,ibtcr)=bed(i,j,Nbed-ks,ibtcr)+ & + & REAL(k-Nbed+ks,r8) * cff1 +#endif + ENDDO +#endif +#endif + ! ALA CHECK WITH CRS about bed_frac + nnn=0 + DO ised=1,NST + nlysm(ised)=newlayer_thick(ng)*REAL(ks+1,r8)* & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,Nbed-ks,iporo)))* & + & bed_frac(i,j,Nbed-ks,ised) + IF (ks.gt.0) THEN + IF (bed_mass(i,j,Nbed-ks,nnew,ised).gt. & + & nlysm(ised)) THEN + nnn=nnn+1 + nlysm(ised)= & + & newlayer_thick(ng)*REAL(ks,r8)* & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,Nbed-ks,iporo)))* & + & bed_frac(i,j,Nbed-ks,ised) + END IF + END IF + END DO + IF (nnn.eq.NST) THEN + bed(i,j,Nbed,ithck)=bed(i,j,Nbed-ks,ithck)- & + & newlayer_thick(ng)*REAL(ks,r8) + DO ised=1,NST + bed_mass(i,j,Nbed,nnew,ised)= & + & bed_mass(i,j,Nbed-ks,nnew,ised)-nlysm(ised) + END DO + DO k=Nbed-1,Nbed-ks,-1 + bed(i,j,k,ithck)=newlayer_thick(ng) + bed(i,j,k,iaged)=bed(i,j,Nbed-ks,iaged) + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_frac(i,j,Nbed-ks,ised) + bed_mass(i,j,k,nnew,ised)= & + & nlysm(ised)/REAL(ks,r8) + END DO + END DO + ELSE + cff=1.0_r8/REAL(ks+1,r8) + DO k=Nbed,Nbed-ks,-1 + bed(i,j,k,ithck)=bed(i,j,Nbed-ks,ithck)*cff + bed(i,j,k,iaged)=bed(i,j,Nbed-ks,iaged) + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_frac(i,j,Nbed-ks,ised) + bed_mass(i,j,k,nnew,ised)= & + & bed_mass(i,j,Nbed-ks,nnew,ised)*cff + END DO + END DO + END IF + END IF ! Nbed > 1 + END IF ! increase top bed layer +#if defined MIXED_BED +! +! Update cohesive property of seds in top layer + cff1 = 0.0_r8 + DO ised=1,NCS + cff1=cff1+bed_frac(i,j,1,ised) + END DO + bottom(i,j,idprp)=min(max((cff1-transN(ng))/ & + & (transC(ng)-transN(ng)),0.0_r8),1.0_r8) +#endif + END DO I_LOOP3 + +#if defined SED_FLOCS && defined SED_DEFLOC + I_LOOP_DFL: DO i=Istr,Iend +! Activate defloc in all layers but the top one +! DO k=2,Nbed +! Activate defloc in all layers + DO k=1,Nbed + alpha = MIN((time(ng)-bed(i,j,k,iaged))/t_dfloc(ng), & + & 1.0_r8) + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,k,nnew,ised) + END DO + cff1 = 0.0_r8 + DO ised=1,NCS + cff1 = cff1+bed_mass(i,j,k,nnew,ised) + END DO + DO ised=1,NCS + masseq(ised)=mud_frac_eq(ised,ng)*cff1 + bed_mass(i,j,k,nnew,ised)=alpha*masseq(ised)+ & + & bed_mass(i,j,k,nnew,ised)*(1.0_r8-alpha) + bed_frac(i,j,k,ised)=bed_mass(i,j,k,nnew,ised)/cff3 + END DO + END DO + ENDDO I_LOOP_DFL +#endif + +#if defined COHESIVE_BED || defined MIXED_BED + I_LOOP_CB2: DO i=Istr,Iend +! +! Key to this algorithm: "mass available depth" (mad) [kg/m2] +! present tau crit profile (tcp) +! representative tau crit profile (tcr) +! Compute depth and mass depth of sediment column +! Compute cumulative depth +! Compute mass depth + bmz(1) = 0.0_r8 + DO ised=1,NST + bmz(1) = bmz(1)+bed_mass(i,j,1,nnew,ised) + ENDDO + DO k=2,Nbed + bmz(k) = bmz(k-1) + DO ised=1,NST + bmz(k)=bmz(k)+bed_mass(i,j,k,nnew,ised) + ENDDO + ENDDO + +! Calculate representative critical shear stress profile +! Note that the values are for the TOP of the layer...we +! assume the bottom of the bottom layer has tcr = tcr_max + tcr(1) = tcr_min(ng) + DO k=2,Nbed + tcr(k) = tcr_min(ng) + IF (bmz(k-1).GT.eps) THEN +! tcr(k) = exp((log(bmz(k-1))- & +! & bottom(i,j,idoff))/ & +! & bottom(i,j,idslp)) + tcr(k) = exp((log(bmz(k-1))- & + & tcr_off(ng))/ & + & tcr_slp(ng)) + ENDIF + tcr(k) = MIN( MAX( tcr(k), tcr_min(ng)), tcr_max(ng) ) + ENDDO +! ks=Ksed-2 +! DO k=Nbed,Nbed-ks,-1 +! bed(i,j,k,ibtcr)=tcr(k) +! ENDDO +! Relax tau crit profile bottom(i,j,k,ibtcr) +! towards representative profile tcr...100 x slower for "swelling" +! than consolidation +! TODO - make the factor an input parameter + IF( bed(i,j,1,ibtcr).LE.tcr(1)) THEN +! alpha = MIN(dt(ng)/bottom(i,j,idtim),1.0_r8) + alpha = MIN(dt(ng)/tcr_tim(ng),1.0_r8) + ELSE +! alpha = MIN(dt(ng)/(100.0_r8*bottom(i,j,idtim)),1.0_r8) + alpha = MIN(dt(ng)/(100.0_r8*tcr_tim(ng)),1.0_r8) + ENDIF + DO k=1,Nbed + bed(i,j,k,ibtcr)=bed(i,j,k,ibtcr)+ & + & alpha*(tcr(k)-bed(i,j,k,ibtcr)) + bed(i,j,k,ibtcr)= & + & MIN( MAX( bed(i,j,k,ibtcr), tcr_min(ng)), tcr_max(ng) ) + ENDDO +!ALA Enforce last layer = tcr_max +!ALA bed(i,j,Nbed,ibtcr)= tcr_max(ng) + ENDDO I_LOOP_CB2 +#endif /* cohesive bed */ + + END DO J_LOOP3 +! +!----------------------------------------------------------------------- +! Store old bed thickness. +!----------------------------------------------------------------------- +! +# if defined SED_MORPH + DO j=JstrR,JendR + DO i=IstrR,IendR + bed_thick(i,j,nnew)=0.0_r8 + DO k=1,Nbed + bed_thick(i,j,nnew)=bed_thick(i,j,nnew)+ & + & bed(i,j,k,ithck) + END DO + END DO + END DO + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + CALL exchange_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & bed_thick(:,:,nnew)) + END IF +# endif +! +!----------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions to property arrays. +!----------------------------------------------------------------------- +! + DO ised=1,NST + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_frac(:,:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed_frac, & + & bed_mass(:,:,:,nnew,:)) +# endif + + DO i=1,MBEDP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed(:,:,:,i)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, MBEDP, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed) +# endif + + RETURN + END SUBROUTINE sed_bed_cohesive_tile +#endif +#endif + END MODULE sed_bed_cohesive_mod diff --git a/ROMS/Nonlinear/Sediment/sed_bedload.F b/ROMS/Nonlinear/Sediment/sed_bedload.F index fe0aeb21..eab15b66 100644 --- a/ROMS/Nonlinear/Sediment/sed_bedload.F +++ b/ROMS/Nonlinear/Sediment/sed_bedload.F @@ -1,17 +1,22 @@ #include "cppdefs.h" -#define SLOPE_NEMETH -#undef SLOPE_LESSER -#define BSTRESS_UPWIND +#ifdef BBL_MODEL +# undef BSTRESS_UPWIND +#else +# define BSTRESS_UPWIND +#endif +#define SED_WENO +#undef SED_UPWIND MODULE sed_bedload_mod -#if defined NONLINEAR && defined SEDIMENT && defined BEDLOAD +#if defined NONLINEAR && defined SEDIMENT && \ + (defined BEDLOAD_SOULSBY || defined BEDLOAD_MPM) ! !git $Id$ !==================================================== John C. Warner === ! Copyright (c) 2002-2025 The ROMS Group Hernan G. Arango ! ! Licensed under a MIT/X style license ! -! See License_ROMS.md ! +! See License_ROMS.txt ! !======================================================================= ! ! ! This routine computes sediment bedload transport using the Meyer- ! @@ -33,6 +38,12 @@ MODULE sed_bedload_mod ! coupled wave, current, and sediment-transport model, Computers ! ! & Geosciences, 34, 1284-1306. ! ! ! +! Udated sed bed evolution scheme to the WENO method of: ! +! Wen Long, James T. Kirby, Zhiyu Shao, ! +! A numerical scheme for morphological bed level calculations, ! +! Coastal Engineering,55, Issue 2, 2008, 167-180. ! +! https://doi.org/10.1016/j.coastaleng.2007.09.009. ! +! ! !======================================================================= ! implicit none @@ -83,6 +94,8 @@ SUBROUTINE sed_bedload (ng, tile) # endif # ifdef WET_DRY & GRID(ng) % rmask_wet, & + & GRID(ng) % umask_wet, & + & GRID(ng) % vmask_wet, & # endif & GRID(ng) % z_w, & # ifdef BBL_MODEL @@ -97,15 +110,11 @@ SUBROUTINE sed_bedload (ng, tile) # endif & FORCES(ng) % bustr, & & FORCES(ng) % bvstr, & - & OCEAN(ng) % t, & # if defined BEDLOAD_SOULSBY & FORCES(ng) % Hwave, & & FORCES(ng) % Lwave, & & GRID(ng) % angler, & # endif -# if defined SED_MORPH - & SEDBED(ng) % bed_thick, & -# endif # if defined BEDLOAD_MPM || defined BEDLOAD_SOULSBY & GRID(ng) % h, & & GRID(ng) % om_r, & @@ -136,7 +145,7 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & rmask, umask, vmask, & # endif # ifdef WET_DRY - & rmask_wet, & + & rmask_wet, umask_wet, vmask_wet, & # endif & z_w, & # ifdef BBL_MODEL @@ -146,14 +155,10 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & Dwave, Pwave_bot, & # endif & bustr, bvstr, & - & t, & # if defined BEDLOAD_SOULSBY & Hwave, Lwave, & & angler, & # endif -# if defined SED_MORPH - & bed_thick, & -# endif # if defined BEDLOAD_MPM || defined BEDLOAD_SOULSBY & h, om_r, om_u, on_r, on_v, & & bedldu, bedldv, & @@ -192,6 +197,8 @@ SUBROUTINE sed_bedload_tile (ng, tile, & # endif # ifdef WET_DRY real(r8), intent(in) :: rmask_wet(LBi:,LBj:) + real(r8), intent(in) :: umask_wet(LBi:,LBj:) + real(r8), intent(in) :: vmask_wet(LBi:,LBj:) # endif real(r8), intent(in) :: z_w(LBi:,LBj:,0:) # ifdef BBL_MODEL @@ -211,9 +218,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & real(r8), intent(in) :: Lwave(LBi:,LBj:) real(r8), intent(in) :: angler(LBi:,LBj:) # endif -# if defined SED_MORPH - real(r8), intent(inout):: bed_thick(LBi:,LBj:,:) -# endif # if defined BEDLOAD_MPM || defined BEDLOAD_SOULSBY real(r8), intent(in) :: h(LBi:,LBj:) real(r8), intent(in) :: om_r(LBi:,LBj:) @@ -223,7 +227,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & real(r8), intent(inout) :: bedldu(LBi:,LBj:,:) real(r8), intent(inout) :: bedldv(LBi:,LBj:,:) # endif - real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:) real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) @@ -238,6 +241,8 @@ SUBROUTINE sed_bedload_tile (ng, tile, & # endif # ifdef WET_DRY real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: umask_wet(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask_wet(LBi:UBi,LBj:UBj) # endif real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng)) # ifdef BBL_MODEL @@ -257,9 +262,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & real(r8), intent(in) :: Lwave(LBi:UBi,LBj:UBj) real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj) # endif -# if defined SED_MORPH - real(r8), intent(inout):: bed_thick(LBi:UBi,LBj:UBj,3) -# endif # if defined BEDLOAD_MPM || defined BEDLOAD_SOULSBY real(r8), intent(in) :: h(LBi:UBi,LBj:UBj) real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj) @@ -269,7 +271,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & real(r8), intent(inout) :: bedldu(LBi:UBi,LBj:UBj,NST) real(r8), intent(inout) :: bedldv(LBi:UBi,LBj:UBj,NST) # endif - real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng)) real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) @@ -282,16 +283,38 @@ SUBROUTINE sed_bedload_tile (ng, tile, & real(r8), parameter :: eps = 1.0E-14_r8 - real(r8) :: cff, cff1, cff2, cff3, cff4, cff5 + real(r8) :: cff, cff1, cff2, cff3, cff4, cff5, fac1, fac2 + real(r8) :: Dstp, bed_change, dz, roll +# if defined BEDLOAD_MPM real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tau_w +! nondimensional critical erosion stress for MPM + real(r8), parameter :: tau_mpmc = 0.047_r8 +# endif # ifdef BSTRESS_UPWIND real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tau_wX real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tau_wE # endif +# ifdef SED_SLUMP + real(r8) :: slopefac_wet_local, slopefac_dry_local +# endif +# ifdef SED_WENO + real(r8) :: S1m, S2m, S3m, S1p, S2p, S3p + real(r8) :: alpha1m, alpha2m, alpha3m + real(r8) :: alpha1p, alpha2p, alpha3p, alpham, alphap + real(r8) :: w1m, w2m, w3m, w1p, w2p, w3p + real(r8) :: q1m, q2m, q3m, q1p, q2p, q3p + real(r8) :: signa, FXm, FXp, FEm, FEp + real(r8), parameter :: thirtotwelv = 13.0_r8/12.0_r8 + real(r8), parameter :: elevenosix = 11.0_r8/6.0_r8 + real(r8), parameter :: sevenosix = 7.0_r8/6.0_r8 + real(r8), parameter :: fiveosix = 5.0_r8/6.0_r8 + real(r8), parameter :: oneosix = 1.0_r8/6.0_r8 + real(r8), parameter :: oneothree = 1.0_r8/3.0_r8 +# endif # ifdef BEDLOAD + real(r8) :: bedld, bedld_mass, dzdx, dzdy, dzdxdy real(r8) :: a_slopex, a_slopey, sed_angle - real(r8) :: bedld, bedld_mass, dzdx, dzdy real(r8) :: smgd, smgdr, osmgd, Umag real(r8) :: rhs_bed, Ua, Ra, phi, Clim @@ -300,14 +323,15 @@ SUBROUTINE sed_bedload_tile (ng, tile, & real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FX_r real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FE_r # endif -# if defined BEDLOAD_MPM +# if defined BEDLOAD_MPM && !defined BSTRESS_UPWIND + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: angleu real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: anglev # endif # if defined BEDLOAD_SOULSBY real(r8) :: theta_mean, theta_wav, w_asym real(r8) :: theta_max, theta_max1, theta_max2 - real(r8) :: phi_x1, phi_x2, phi_x, phi_y, Dstp + real(r8) :: phi_x1, phi_x2, phi_x, phi_y real(r8) :: bedld_x, bedld_y, tau_cur, waven, wavec real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: phic @@ -323,15 +347,12 @@ SUBROUTINE sed_bedload_tile (ng, tile, & ! Compute maximum bottom stress for MPM bedload or suspended load. !----------------------------------------------------------------------- ! -# if defined BEDLOAD_MPM || defined SUSPLOAD +# if defined BEDLOAD_MPM # ifdef BBL_MODEL DO j=Jstr-1,Jend+1 DO i=Istr-1,Iend+1 tau_w(i,j)=SQRT(bustrcwmax(i,j)*bustrcwmax(i,j)+ & & bvstrcwmax(i,j)*bvstrcwmax(i,j)) -# ifdef WET_DRY - tau_w(i,j)=tau_w(i,j)*rmask_wet(i,j) -# endif END DO END DO # else @@ -359,15 +380,10 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & (bustr(i,j)+bustr(i+1,j))+ & & (bvstr(i,j)+bvstr(i,j+1))* & & (bvstr(i,j)+bvstr(i,j+1))) -# ifdef WET_DRY - tau_w(i,j)=tau_w(i,j)*rmask_wet(i,j) -# endif END DO END DO # endif # endif - -# ifdef BEDLOAD ! !----------------------------------------------------------------------- ! Compute bedload sediment transport. @@ -379,9 +395,14 @@ SUBROUTINE sed_bedload_tile (ng, tile, & ! ! Compute angle between currents and waves (radians). ! +# if defined SED_WENO + DO j=Jstrm3,Jendp2i + DO i=Istrm3,Iendp2i +# else DO j=Jstrm1,Jendp1 DO i=Istrm1,Iendp1 -# if defined BEDLOAD_SOULSBY +# endif +# if defined BEDLOAD_SOULSBY ! ! Compute angle between currents and waves, measure CCW from current ! direction toward wave vector. @@ -397,18 +418,18 @@ SUBROUTINE sed_bedload_tile (ng, tile, & ! tau_cur=SQRT(bustrc(i,j)*bustrc(i,j)+ & & bvstrc(i,j)*bvstrc(i,j)) - tau_wav(i,j)=SQRT(bustrw(i,j)*bustrw(i,j)+ & - & bvstrw(i,j)*bvstrw(i,j)) + tau_wav(i,j)=MIN(SQRT(bustrw(i,j)*bustrw(i,j)+ & + & bvstrw(i,j)*bvstrw(i,j)),20.0_r8) tau_mean(i,j)=tau_cur*(1.0_r8+1.2_r8*((tau_wav(i,j)/ & & (tau_cur+tau_wav(i,j)+eps))**3.2_r8)) ! -# elif defined BEDLOAD_MPM +# elif defined BEDLOAD_MPM && !defined BSTRESS_UPWIND cff1=0.5_r8*(bustr(i,j)+bustr(i+1,j)) cff2=0.5_r8*(bvstr(i,j)+bvstr(i,j+1)) Umag=SQRT(cff1*cff1+cff2*cff2)+eps angleu(i,j)=cff1/Umag anglev(i,j)=cff2/Umag -# endif +# endif END DO END DO ! @@ -417,21 +438,30 @@ SUBROUTINE sed_bedload_tile (ng, tile, & osmgd=1.0_r8/smgd smgdr=SQRT(smgd)*Sd50(ised,ng)*Srho(ised,ng) ! +# if defined SED_WENO + DO j=Jstrm3,Jendp2i + DO i=Istrm3,Iendp2i +# else DO j=Jstrm1,Jendp1 DO i=Istrm1,Iendp1 -# ifdef BEDLOAD_SOULSBY +# endif +# ifdef BEDLOAD_SOULSBY ! ! Compute wave asymmetry factor, based on Fredosoe and Deigaard. ! Dstp=z_w(i,j,N(ng))+h(i,j) waven=2.0_r8*pi/(Lwave(i,j)+eps) - wavec=SQRT(g/waven*tanh(waven*Dstp)) +! wavec=SQRT(g/waven*tanh(waven*Dstp)) cff4=MIN(waven*Dstp,kdmax) - cff1=-0.1875_r8*wavec*(waven*Dstp)**2/(SINH(cff4))**4 - cff2=0.125_r8*g*Hwave(i,j)**2/(wavec*Dstp+eps) - cff3=pi*Hwave(i,j)/(Pwave_bot(i,j)*SINH(cff4)+eps) - w_asym=MAX(MIN((cff1-cff2)/cff3,0.2_r8),0.0_r8) - w_asym=0.0_r8 +! cff1=-0.1875_r8*wavec*(waven*Dstp)**2/(SINH(cff4))**4 +! cff2=0.125_r8*g*Hwave(i,j)**2/(wavec*Dstp+eps) +! cff3=pi*Hwave(i,j)/(Pwave_bot(i,j)*SINH(cff4)+eps) +! +! Compute wave asymmetry factor, based on the note of Soulsby +! + cff1=MIN(0.375_r8*(Hwave(i,j)/Dstp)* & + & ((waven*Dstp)/(SINH(cff4))**3),0.15_r8) + w_asym=2.0_r8*cff1/(1.0_r8+cff1**2.0_r8) ! ! Compute nondimensional stresses. ! @@ -450,14 +480,23 @@ SUBROUTINE sed_bedload_tile (ng, tile, & ! ! Motion initiation factor. ! +# if defined COHESIVE_BED || defined MIXED_BED +! Check that both sediment class and bed critical stresses are exceeded + cff3=0.5_r8*(1.0_r8+SIGN(1.0_r8, & + & theta_max/ & + & (max(tau_ce(ised,ng),bed(i,j,1,ibtcr))*osmgd)-1.0_r8)) + +# else +! Only sediment class critical stresses needs to be exceeded cff3=0.5_r8*(1.0_r8+SIGN(1.0_r8, & - & theta_max/tau_ce(ised,ng)-1.0_r8)) + & theta_max/(tau_ce(ised,ng)*osmgd)-1.0_r8)) +# endif ! ! Calculate bed loads in direction of current and perpendicular ! direction. ! phi_x1=12.0_r8*SQRT(theta_mean)* & - & MAX((theta_mean-tau_ce(ised,ng)),0.0_r8) + & MAX((theta_mean-tau_ce(ised,ng)*osmgd),0.0_r8) phi_x2=12.0_r8*(0.9534_r8+0.1907*COS(2.0_r8*phicw(i,j)))* & & SQRT(theta_wav)*theta_mean+ & & 12.0_r8*(0.229_r8*w_asym*theta_wav**1.5_r8* & @@ -483,67 +522,93 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & on_r(i,j)*dt(ng) FE_r(i,j)=(bedld_x*SIN(phic(i,j))+bedld_y*COS(phic(i,j)))* & & om_r(i,j)*dt(ng) -# elif defined BEDLOAD_MPM -# ifdef BSTRESS_UPWIND +# elif defined BEDLOAD_MPM +# ifdef BSTRESS_UPWIND ! ! Magnitude of bed load at rho points. Meyer-Peter Muller formulation. ! bedld has dimensions of kg m-1 s-1. Use partitions of stress ! from upwind direction, still at rho points. ! (FX_r and FE_r have dimensions of kg). ! - bedld=8.0_r8*(MAX((ABS(tau_wX(i,j))*osmgd-0.047_r8), & +# if defined COHESIVE_BED || defined MIXED_BED + IF (tau_wX(i,j).gt.bed(i,j,1,ibtcr)) THEN + cff=1.0_r8 + ELSE + cff=0.0_r8 + END + bedld=8.0_r8*(MAX((ABS(tau_wX(i,j))*osmgd-tau_mpmc), & + & 0.0_r8)**1.5_r8)*smgdr* & + & SIGN(1.0_r8,tau_wX(i,j))*cff + FX_r(i,j)=bedld*on_r(i,j)*dt(ng) + IF (tau_wE(i,j).gt.bed(i,j,1,ibtcr)) THEN + cff=1.0_r8 + ELSE + cff=0.0_r8 + END + bedld=8.0_r8*(MAX((ABS(tau_wE(i,j))*osmgd-tau_mpmc), & + & 0.0_r8)**1.5_r8)*smgdr* & + & SIGN(1.0_r8,tau_wE(i,j))*cff + FE_r(i,j)=bedld*om_r(i,j)*dt(ng) +# else + bedld=8.0_r8*(MAX((ABS(tau_wX(i,j))*osmgd-tau_mpmc), & & 0.0_r8)**1.5_r8)*smgdr* & & SIGN(1.0_r8,tau_wX(i,j)) FX_r(i,j)=bedld*on_r(i,j)*dt(ng) - bedld=8.0_r8*(MAX((ABS(tau_wE(i,j))*osmgd-0.047_r8), & + bedld=8.0_r8*(MAX((ABS(tau_wE(i,j))*osmgd-tau_mpmc), & & 0.0_r8)**1.5_r8)*smgdr* & & SIGN(1.0_r8,tau_wE(i,j)) FE_r(i,j)=bedld*om_r(i,j)*dt(ng) -# else +# endif +# else ! ! Magnitude of bed load at rho points. Meyer-Peter Muller formulation. ! (BEDLD has dimensions of kg m-1 s-1). ! - bedld=8.0_r8*(MAX((tau_w(i,j)*osmgd-0.047_r8), & - & 0.0_r8)**1.5_r8)*smgdr +# if defined COHESIVE_BED || defined MIXED_BED + IF (tau_w(i,j).gt.bed(i,j,1,ibtcr)) THEN + bedld=8.0_r8*(MAX((tau_w(i,j)*osmgd-tau_mpmc), & + & 0.0_r8)**1.5_r8)*smgdr + ELSE + bedld=0.0_r8 + END IF +# else + bedld=8.0_r8*(MAX((tau_w(i,j)*osmgd-tau_mpmc), & + & 0.0_r8)**1.5_r8)*smgdr +# endif ! ! Partition bedld into xi and eta directions, still at rho points. ! (FX_r and FE_r have dimensions of kg). ! FX_r(i,j)=angleu(i,j)*bedld*on_r(i,j)*dt(ng) FE_r(i,j)=anglev(i,j)*bedld*om_r(i,j)*dt(ng) -# endif # endif +# endif ! ! Correct for along-direction slope. Limit slope to 0.9*sed angle. ! cff1=0.5_r8*(1.0_r8+SIGN(1.0_r8,FX_r(i,j))) cff2=0.5_r8*(1.0_r8-SIGN(1.0_r8,FX_r(i,j))) -# if defined SLOPE_NEMETH - dzdx=(h(i+1,j)-h(i ,j))/om_u(i+1,j)*cff1+ & - & (h(i-1,j)-h(i ,j))/om_u(i ,j)*cff2 - dzdy=(h(i,j+1)-h(i,j ))/on_v(i,j+1)*cff1+ & - & (h(i,j-1)-h(i,j ))/on_v(i ,j)*cff2 -# ifdef BEDLOAD_MPM - cff=ABS(tau_w(i,j)) -# else - cff=ABS(tau_mean(i,j)) -# endif - a_slopex=0.3_r8*cff**0.5_r8*0.002_r8*dzdx+ & - & 0.3_r8*cff**1.5_r8*3.330_r8*dzdx - a_slopey=0.3_r8*cff**0.5_r8*0.002_r8*dzdy+ & - & 0.3_r8*cff**1.5_r8*3.330_r8*dzdy + cff3=0.5_r8*(1.0_r8+SIGN(1.0_r8,FE_r(i,j))) + cff4=0.5_r8*(1.0_r8-SIGN(1.0_r8,FE_r(i,j))) +# if defined SLOPE_NEMETH + dzdx=(h(i+1,j)-h(i,j))/om_u(i+1,j)*cff1+ & + & (h(i-1,j)-h(i,j))/om_u(i ,j)*cff2 + dzdy=(h(i,j+1)-h(i,j))/on_v(i,j+1)*cff3+ & + & (h(i,j-1)-h(i,j))/on_v(i ,j)*cff4 + a_slopex=1.7_r8*dzdx + a_slopey=1.7_r8*dzdy ! ! Add contriubiton of bed slope to bed load transport fluxes. ! - FX_r(i,j)=FX_r(i,j)+a_slopex - FE_r(i,j)=FE_r(i,j)+a_slopey -# elif defined SLOPE_LESSER + FX_r(i,j)=FX_r(i,j)*(1.0_r8+a_slopex) + FE_r(i,j)=FE_r(i,j)*(1.0_r8+a_slopey) +! +# elif defined SLOPE_LESSER dzdx=MIN(((h(i+1,j)-h(i ,j))/om_u(i+1,j)*cff1+ & & (h(i ,j)-h(i-1,j))/om_u(i ,j)*cff2),0.52_r8)* & & SIGN(1.0_r8,FX_r(i,j)) - dzdy=MIN(((h(i,j+1)-h(i,j ))/on_v(i,j+1)*cff1+ & - & (h(i,j )-h(i,j-1))/on_v(i ,j)*cff2),0.52_r8)* & + dzdy=MIN(((h(i,j+1)-h(i,j ))/on_v(i,j+1)*cff3+ & + & (h(i,j )-h(i,j-1))/on_v(i ,j)*cff4),0.52_r8)* & & SIGN(1.0_r8,FE_r(i,j)) cff=DATAN(dzdx) a_slopex=sed_angle/(COS(cff)*(sed_angle-dzdx)) @@ -554,17 +619,14 @@ SUBROUTINE sed_bedload_tile (ng, tile, & ! FX_r(i,j)=FX_r(i,j)*a_slopex FE_r(i,j)=FE_r(i,j)*a_slopey -# endif -! -! -# ifdef SED_MORPH +# endif +# ifdef SED_MORPH ! ! Apply morphology factor. ! FX_r(i,j)=FX_r(i,j)*morph_fac(ised,ng) FE_r(i,j)=FE_r(i,j)*morph_fac(ised,ng) - -# endif +# endif ! ! Apply bedload transport rate coefficient. Also limit ! bedload to the fraction of each sediment class. @@ -585,6 +647,15 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & om_r(i,j)*on_r(i,j)*ABS(FE_r(i,j))/ & & bedld_mass)* & & SIGN(1.0_r8,FE_r(i,j)) +# ifdef MASKING +# ifdef WET_DRY + FX_r(i,j)=FX_r(i,j)*rmask_wet(i,j) + FE_r(i,j)=FE_r(i,j)*rmask_wet(i,j) +# else + FX_r(i,j)=FX_r(i,j)*rmask(i,j) + FE_r(i,j)=FE_r(i,j)*rmask(i,j) +# endif +# endif END DO END DO ! @@ -664,10 +735,12 @@ SUBROUTINE sed_bedload_tile (ng, tile, & END IF END IF ! -! Upwind shift FX_r and FE_r to u and v points. +! Compute face fluxes at u and v points before taking divergence. ! - DO j=Jstr-1,Jend+1 +! DO j=JstrR,JendR + DO j=Jstr,Jend DO i=Istr,Iend+1 +# if defined SED_UPWIND cff1=0.5_r8*(1.0_r8+SIGN(1.0_r8,FX_r(i,j))) cff2=0.5_r8*(1.0_r8-SIGN(1.0_r8,FX_r(i,j))) FX(i,j)=0.5_r8*(1.0_r8+SIGN(1.0_r8,FX_r(i-1,j)))* & @@ -676,13 +749,105 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & 0.5_r8*(1.0_r8-SIGN(1.0_r8,FX_r(i-1,j)))* & & (cff2*FX_r(i ,j)+ & & cff1*0.5_r8*(FX_r(i-1,j)+FX_r(i,j))) -# ifdef MASKING +# elif defined SED_WENO +! +! Long et al. (2008). Coastal Engr, 55, 167-180. +! + S1m=thirtotwelv* & + & (FX_r(i-3,j)-2.0_r8*FX_r(i-2,j)+FX_r(i-1,j))**2+ & + & 0.25_r8* & + & (FX_r(i-3,j)-4.0_r8*FX_r(i-2,j)+3.0_r8*FX_r(i-1,j))**2 + S2m=thirtotwelv* & + & (FX_r(i-2,j)-2.0_r8*FX_r(i-1,j)+FX_r(i,j))**2+ & + & 0.25_r8* & + & (FX_r(i-2,j)-FX_r(i,j))**2 + S3m=thirtotwelv* & + & (FX_r(i-1,j)-2.0_r8*FX_r(i,j)+FX_r(i+1,j))**2+ & + & 0.25_r8* & + & (3.0_r8*FX_r(i-1,j)-4.0_r8*FX_r(i,j)+FX_r(i+1,j))**2 +! + S1p=thirtotwelv* & + & (FX_r(i-2,j)-2.0_r8*FX_r(i-1,j)+FX_r(i,j))**2+ & + & 0.25_r8* & + & (FX_r(i-2,j)-4.0_r8*FX_r(i-1,j)+3.0_r8*FX_r(i,j))**2 + S2p=thirtotwelv* & + & (FX_r(i-1,j)-2.0_r8*FX_r(i,j)+FX_r(i+1,j))**2+ & + & 0.25_r8* & + & (FX_r(i-1,j)-FX_r(i+1,j))**2 +! & (-FX_r(i-1,j)+FX_r(i+1,j))**2 + S3p=thirtotwelv* & + & (FX_r(i,j)-2.0_r8*FX_r(i+1,j)+FX_r(i+2,j))**2+ & + & 0.25_r8* & + & (3.0_r8*FX_r(i,j)-4.0_r8*FX_r(i+1,j)+FX_r(i+2,j))**2 + + +! + alpha1m=0.1_r8/(S1m+eps)**2 + alpha2m=0.6_r8/(S2m+eps)**2 + alpha3m=0.3_r8/(S3m+eps)**2 +! + alpha1p=0.3_r8/(S1p+eps)**2 + alpha2p=0.6_r8/(S2p+eps)**2 + alpha3p=0.1_r8/(S3p+eps)**2 +! + alpham=alpha1m+alpha2m+alpha3m + alphap=alpha1p+alpha2p+alpha3p +! + w1m=alpha1m/alpham + w2m=alpha2m/alpham + w3m=alpha3m/alpham + w1p=alpha1p/alphap + w2p=alpha2p/alphap + w3p=alpha3p/alphap +! + q1m=oneothree*FX_r(i-3,j)-sevenosix*FX_r(i-2,j)+ & + & elevenosix*FX_r(i-1,j) + q2m=-oneosix*FX_r(i-2,j)+fiveosix*FX_r(i-1,j)+ & + & oneothree*FX_r(i,j) + q3m=oneothree*FX_r(i-1,j)+fiveosix*FX_r(i,j)- & + & oneosix*FX_r(i+1,j) +! + q1p=-oneosix*FX_r(i-2,j)+fiveosix*FX_r(i-1,j)+ & + & oneothree*FX_r(i,j) + q2p=oneothree*FX_r(i-1,j)+fiveosix*FX_r(i,j)- & + & oneosix*FX_r(i+1,j) + q3p=elevenosix*FX_r(i,j)-sevenosix*FX_r(i+1,j)+ & + & oneothree*FX_r(i+2,j) +! +! signa=(FX_r(i,j)-FX_r(i-1,j))*(h(i,j)-h(i-1,j)) + signa=FX_r(i,j) + cff=SIGN(1.0_r8,signa) + FXm=0.5_r8*(1.0_r8+cff)*(w1m*q1m+w2m*q2m+w3m*q3m) + FXp=0.5_r8*(1.0_r8-cff)*(w1p*q1p+w2p*q2p+w3p*q3p) +! + FX(i,j)=FXm+FXp +# else + FX(i,j)=0.5_r8*(FX_r(i-1,j)+FX_r(i,j)) +# endif +# ifdef SLOPE_KIRWAN +! cff1=30.0_r8 + cff1=10.0_r8 + dzdx=(h(i,j)-h(i-1 ,j))/om_u(i,j) + a_slopex=(MAX(0.0_r8,abs(dzdx)-0.05_r8) & + & *SIGN(1.0_r8,dzdx)*cff1) & + & *om_r(i,j)*dt(ng) +# ifdef SED_MORPH + a_slopex=a_slopex*morph_fac(ised,ng) +# endif + FX(i,j)=FX(i,j)+a_slopex +# endif +# ifdef MASKING FX(i,j)=FX(i,j)*umask(i,j) +# ifdef WET_DRY + FX(i,j)=FX(i,j)*umask_wet(i,j) # endif +# endif END DO END DO DO j=Jstr,Jend+1 - DO i=Istr-1,Iend+1 +! DO i=IstrR,IendR + DO i=Istr,Iend +# ifdef SED_UPWIND cff1=0.5_r8*(1.0_r8+SIGN(1.0_r8,FE_r(i,j))) cff2=0.5_r8*(1.0_r8-SIGN(1.0_r8,FE_r(i,j))) FE(i,j)=0.5_r8*(1.0_r8+SIGN(1.0_r8,FE_r(i,j-1)))* & @@ -691,34 +856,291 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & 0.5_r8*(1.0_r8-SIGN(1.0_r8,FE_r(i,j-1)))* & & (cff2*FE_r(i ,j)+ & & cff1*0.5_r8*(FE_r(i,j-1)+FE_r(i,j))) -# ifdef MASKING +# elif defined SED_WENO + S1m=thirtotwelv* & + & (FE_r(i,j-3)-2.0_r8*FE_r(i,j-2)+FE_r(i,j-1))**2+ & + & 0.25_r8* & + & (FE_r(i,j-3)-4.0_r8*FE_r(i,j-2)+3.0_r8*FE_r(i,j-1))**2 + S2m=thirtotwelv* & + & (FE_r(i,j-2)-2.0_r8*FE_r(i,j-1)+FE_r(i,j))**2+ & + & 0.25_r8* & + & (FE_r(i,j-2)-FE_r(i,j))**2 + S3m=thirtotwelv* & + & (FE_r(i,j-1)-2.0_r8*FE_r(i,j)+FE_r(i,j+1))**2+ & + & 0.25_r8* & + & (3.0_r8*FE_r(i,j-1)-4.0_r8*FE_r(i,j)+FE_r(i,j+1))**2 +! + S1p=thirtotwelv* & + & (FE_r(i,j-2)-2.0_r8*FE_r(i,j-1)+FE_r(i,j))**2+ & + & 0.25_r8* & + & (FE_r(i,j-2)-4.0_r8*FE_r(i,j-1)+3.0_r8*FE_r(i,j))**2 + S2p=thirtotwelv* & + & (FE_r(i,j-1)-2.0_r8*FE_r(i,j)+FE_r(i,j+1))**2+ & + & 0.25_r8* & + & (FE_r(i,j-1)-FE_r(i,j+1))**2 +! & (-FE_r(i,j-1)+FE_r(i,j+1))**2 + S3p=thirtotwelv* & + & (FE_r(i,j)-2.0_r8*FE_r(i,j+1)+FE_r(i,j+2))**2+ & + & 0.25_r8* & + & (3.0_r8*FE_r(i,j)-4.0_r8*FE_r(i,j+1)+FE_r(i,j+2))**2 + + + alpha1m=0.1_r8/(S1m+eps)**2 + alpha2m=0.6_r8/(S2m+eps)**2 + alpha3m=0.3_r8/(S3m+eps)**2 +! + alpha1p=0.3_r8/(S1p+eps)**2 + alpha2p=0.6_r8/(S2p+eps)**2 + alpha3p=0.1_r8/(S3p+eps)**2 +! + alpham=alpha1m+alpha2m+alpha3m + alphap=alpha1p+alpha2p+alpha3p +! + w1m=alpha1m/alpham + w2m=alpha2m/alpham + w3m=alpha3m/alpham + w1p=alpha1p/alphap + w2p=alpha2p/alphap + w3p=alpha3p/alphap +! + q1m=oneothree*FE_r(i,j-3)-sevenosix*FE_r(i,j-2)+ & + & elevenosix*FE_r(i,j-1) + q2m=-oneosix*FE_r(i,j-2)+fiveosix*FE_r(i,j-1)+ & + & oneothree*FE_r(i,j) + q3m=oneothree*FE_r(i,j-1)+fiveosix*FE_r(i,j)- & + & oneosix*FE_r(i,j+1) +! + q1p=-oneosix*FE_r(i,j-2)+fiveosix*FE_r(i,j-1)+ & + & oneothree*FE_r(i,j) + q2p=oneothree*FE_r(i,j-1)+fiveosix*FE_r(i,j)- & + & oneosix*FE_r(i,j+1) + q3p=elevenosix*FE_r(i,j)-sevenosix*FE_r(i,j+1)+ & + & oneothree*FE_r(i,j+2) +! +! signa=(FE_r(i,j)-FE_r(i,j-1))*(h(i,j)-h(i,j-1)) + signa=FE_r(i,j) + cff=SIGN(1.0_r8,signa) + FEm=0.5_r8*(1.0_r8+cff)*(w1m*q1m+w2m*q2m+w3m*q3m) + FEp=0.5_r8*(1.0_r8-cff)*(w1p*q1p+w2p*q2p+w3p*q3p) +! + FE(i,j)=FEm+FEp + +# else + FE(i,j)=0.5_r8*(FE_r(i,j-1)+FE_r(i,j)) +# endif +# ifdef SLOPE_KIRWAN +! cff1=30.0_r8 + cff1=10.0_r8 + dzdy=(h(i,j)-h(i ,j-1))/on_v(i,j) + a_slopey=(MAX(0.0_r8,abs(dzdy)-0.05_r8) & + & *SIGN(1.0_r8,dzdy)*cff1) & + & *on_r(i,j)*dt(ng) +# ifdef SED_MORPH + a_slopey=a_slopey*morph_fac(ised,ng) +# endif + FE(i,j)=FE(i,j)+a_slopey +# endif +# ifdef MASKING FE(i,j)=FE(i,j)*vmask(i,j) +# ifdef WET_DRY + FE(i,j)=FE(i,j)*vmask_wet(i,j) # endif +# endif END DO END DO +# ifdef SED_SLUMP +! +! Sed slump computation to allow slumping for wet areas everywhere +! and at the wet/dry interface. +! +! sedslopes are the critical slopes to allow slumping. +! slopefac are the scale factors for sediment movement. +! +! U-direction slumping +! + DO j=Jstr,Jend + DO i=Istr,Iend+1 + cff2=Srho(ised,ng)*(1.0_r8-bed(i,j,1,iporo)) + slopefac_dry_local=cff2*dt(ng)*slopefac_dry(ng) + slopefac_wet_local=cff2*dt(ng)*slopefac_wet(ng) +# ifdef SED_MORPH + slopefac_wet_local=slopefac_wet_local*morph_fac(ised,ng) + slopefac_dry_local=slopefac_dry_local*morph_fac(ised,ng) +# endif + dzdx=(h(i,j)-h(i-1,j))/om_u(i,j) + dzdy=(h(i,j)-h(i,j-1))/on_v(i,j) + dzdxdy=sqrt(dzdx**2.0_r8+dzdy**2.0_r8) +! For the wet part + cff=dzdxdy-sedslope_crit_wet(ng) + cff1=(0.5_r8+SIGN(0.5_r8,cff)) +!jcw +! cff=0.5_r8*cff*cff1/(pm(i,j)*pn(i,j)) +! cff2=cff*slopefac_wet_local*SIGN(1.0_r8,dzdx) +!mai + cff=ABS(dzdxdy-sedslope_crit_wet(ng))*dzdx/(dzdxdy+eps) + cff2=cff*cff1/(pm(i,j)*pn(i,j))*slopefac_wet_local +# ifdef MASKING + cff2=cff2*umask(i,j) +# ifdef WET_DRY + cff2=cff2*umask_wet(i,j) +# endif +# endif + FX(i,j)=FX(i,j)+cff2 +! For the dry part +!jcw +! cff=ABS(dzdx)-sedslope_crit_dry(ng) +! cff1=(0.5_r8+SIGN(0.5_r8,cff)) +! cff=0.5_r8*cff*cff1/(pm(i,j)*pn(i,j)) +! cff2=cff*slopefac_dry_local*SIGN(1.0_r8,dzdx) +!mai + cff=dzdxdy-sedslope_crit_dry(ng) + cff1=(0.5_r8+SIGN(0.5_r8,cff)) + cff=ABS(dzdxdy-sedslope_crit_dry(ng))*dzdx/(dzdxdy+eps) + cff2=cff*cff1/(pm(i,j)*pn(i,j))*slopefac_dry_local +# ifdef MASKING + cff2=cff2*umask(i,j) +# ifdef WET_DRY + ii=MAX(i-1,1) + ip=MIN(i+1,Lm(ng)+1) + cff2=cff2*(1.0_r8-umask_wet(i,j))* & + & ((1.0_r8-umask_wet(ii,j))*umask_wet(ip,j)+ & + & (1.0_r8-umask_wet(ip,j))*umask_wet(ii,j)) +# endif +# endif + FX(i,j)=FX(i,j)+cff2 + END DO + END DO +! +! V-direction slumping +! + DO j=Jstr,Jend+1 + DO i=Istr,Iend + cff2=Srho(ised,ng)*(1.0_r8-bed(i,j,1,iporo)) + slopefac_dry_local=cff2*dt(ng)*slopefac_dry(ng) + slopefac_wet_local=cff2*dt(ng)*slopefac_wet(ng) +# ifdef SED_MORPH + slopefac_wet_local=slopefac_wet_local*morph_fac(ised,ng) + slopefac_dry_local=slopefac_dry_local*morph_fac(ised,ng) +# endif + dzdy=(h(i,j)-h(i,j-1))/on_v(i,j) ! positive is downhill + dzdx=(h(i,j)-h(i-1,j))/om_u(i,j) + dzdxdy=sqrt(dzdx**2.0_r8+dzdy**2.0_r8) +! For the wet part + cff=ABS(dzdxdy)-sedslope_crit_wet(ng) + cff1=(0.5_r8+SIGN(0.5_r8,cff)) +!jcw +! cff=0.5_r8*cff*cff1/(pm(i,j)*pn(i,j)) +! cff2=cff*slopefac_wet_local*SIGN(1.0_r8,dzdy) +!mai + cff=ABS(dzdxdy-sedslope_crit_wet(ng))*dzdy/(dzdxdy+eps) + cff2=cff*cff1/(pm(i,j)*pn(i,j))*slopefac_wet_local +# ifdef MASKING + cff2=cff2*vmask(i,j) +# ifdef WET_DRY + cff2=cff2*vmask_wet(i,j) +# endif +# endif + FE(i,j)=FE(i,j)+cff2 +! For the dry part +!jcw +! cff=ABS(dzdy)-sedslope_crit_dry(ng) +! cff1=(0.5_r8+SIGN(0.5_r8,cff)) +! cff=0.5_r8*cff*cff1/(pm(i,j)*pn(i,j)) +! cff2=cff*slopefac_dry_local*SIGN(1.0_r8,dzdy) +!mai + cff=dzdxdy-sedslope_crit_dry(ng) + cff1=(0.5_r8+SIGN(0.5_r8,cff)) + cff=ABS(dzdxdy-sedslope_crit_dry(ng))*dzdy/(dzdxdy+eps) + cff2=cff*cff1/(pm(i,j)*pn(i,j))*slopefac_dry_local +# ifdef MASKING + cff2=cff2*vmask(i,j) +# ifdef WET_DRY + jj=MAX(j-1,1) + jp=MIN(j+1,Mm(ng)+1) + cff2=cff2*(1.0_r8-vmask_wet(i,j))* & + & ((1.0_r8-vmask_wet(i,jj))*vmask_wet(i,jp)+ & + & (1.0_r8-vmask_wet(i,jp))*vmask_wet(i,jj)) +# endif +# endif + FE(i,j)=FE(i,j)+cff2 + END DO + END DO +# endif ! ! Limit fluxes to prevent bottom from breaking thru water surface. ! -! DO j=Jstr,Jend -! DO i=Istr,Iend -! cff1=1.0_r8/(Srho(ised,ng)*(1.0_r8-bed(i,j,1,iporo))) -! rhs_bed=(FX(i+1,j)-FX(i,j)+ & -! & FE(i,j+1)-FE(i,j))*pm(i,j)*pn(i,j) -! cff2=MAX(rhs_bed*cff1+h(i,j)-Dcrit(ng),0.0_r8) -! cff=cff2/ABS(cff2+eps) -! FX(i ,j )=MAX(FX(i ,j ),0.0_r8)*cff+ & -! & MIN(FX(i ,j ),0.0_r8) -! FX(i+1,j )=MAX(FX(i+1,j ),0.0_r8)+ & -! & MIN(FX(i+1,j ),0.0_r8)*cff -! FE(i ,j )=MAX(FE(i ,j ),0.0_r8)*cff+ & -! & MIN(FE(i ,j ),0.0_r8) -! FE(i ,j+1)=MAX(FE(i ,j+1),0.0_r8)+ & -! & MIN(FE(i ,j+1),0.0_r8)*cff -! END DO -! END DO + DO j=Jstr,Jend + DO i=Istr,Iend+1 +! +! Compute Total thickness available and change. +! + IF (FX(i,j).ge.0.0_r8) THEN + Dstp=z_w(i,j,1)-z_w(i,j,0) +! Dstp=z_w(i,j,N(ng))-z_w(i,j,0) + rhs_bed=FX(i,j)*pm(i,j)*pn(i,j) + bed_change=rhs_bed/(Srho(ised,ng)* & + & (1.0_r8-bed(i,j,1,iporo))) + ELSE + Dstp=z_w(i-1,j,1)-z_w(i-1,j,0) +! Dstp=z_w(i-1,j,N(ng))-z_w(i-1,j,0) + rhs_bed=ABS(FX(i,j))*pm(i-1,j)*pn(i-1,j) + bed_change=rhs_bed/(Srho(ised,ng)* & + & (1.0_r8-bed(i-1,j,1,iporo))) + END IF +! +! Limit that change to be less than available. +! +! cff=MAX(bed_change-0.75_r8*Dstp,0.0_r8) + cff=MAX(bed_change-1.00_r8*Dstp,0.0_r8) + cff1=cff/ABS(bed_change+eps) + FX(i,j)=FX(i,j)*(1.0_r8-cff1) + END DO + END DO + DO j=Jstr,Jend+1 + DO i=Istr,Iend +! +! Compute Total thickness available and change. +! + IF (FE(i,j).ge.0.0_r8) THEN + Dstp=z_w(i,j,1)-z_w(i,j,0) +! Dstp=z_w(i,j,N(ng))-z_w(i,j,0) + rhs_bed=FE(i,j)*pm(i,j)*pn(i,j) + bed_change=rhs_bed/(Srho(ised,ng)* & + & (1.0_r8-bed(i,j,1,iporo))) + ELSE + Dstp=z_w(i,j-1,1)-z_w(i,j-1,0) +! Dstp=z_w(i,j-1,N(ng))-z_w(i,j-1,0) + rhs_bed=ABS(FE(i,j))*pm(i,j-1)*pn(i,j-1) + bed_change=rhs_bed/(Srho(ised,ng)* & + & (1.0_r8-bed(i,j-1,1,iporo))) + END IF +! +! Limit that change to be less than available. +! +! cff=MAX(bed_change-0.75_r8*Dstp,0.0_r8) + cff=MAX(bed_change-1.00_r8*Dstp,0.0_r8) + cff1=cff/ABS(bed_change+eps) + FE(i,j)=FE(i,j)*(1.0_r8-cff1) + END DO + END DO ! ! Apply boundary conditions (gradient). ! +! + IF (.not.(CompositeGrid(isouth,ng).or.NSperiodic(ng))) THEN + IF (DOMAIN(ng)%Southern_Edge(tile)) THEN + DO i=Istr,IendR + FX(i,Jstr-1)=FX(i,Jstr) + END DO + END IF + END IF + IF (.not.(CompositeGrid(inorth,ng).or.NSperiodic(ng))) THEN + IF (DOMAIN(ng)%Northern_Edge(tile)) THEN + DO i=Istr,IendR + FX(i,Jend+1)=FX(i,Jend) + END DO + END IF + END IF IF (.not.(CompositeGrid(iwest,ng).or.EWperiodic(ng))) THEN IF (DOMAIN(ng)%Western_Edge(tile)) THEN IF (LBC(iwest,isTvar(idsed(ised)),ng)%closed) THEN @@ -738,6 +1160,20 @@ SUBROUTINE sed_bedload_tile (ng, tile, & END IF END IF ! + IF (.not.(CompositeGrid(iwest,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%Western_Edge(tile)) THEN + DO j=Jstr,JendR + FE(Istr-1,j)=FE(Istr,j) + END DO + END IF + END IF + IF (.not.(CompositeGrid(ieast,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN + DO j=Jstr,JendR + FE(Iend+1,j)=FE(Iend,j) + END DO + END IF + END IF IF (.not.(CompositeGrid(isouth,ng).or.NSperiodic(ng))) THEN IF (DOMAIN(ng)%Southern_Edge(tile)) THEN IF (LBC(isouth,isTvar(idsed(ised)),ng)%closed) THEN @@ -765,18 +1201,15 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & FE(i,j+1)-FE(i,j))*pm(i,j)*pn(i,j) bed_mass(i,j,1,nnew,ised)=MAX(bed_mass(i,j,1,nstp,ised)- & & cff,0.0_r8) -# if !defined SUSPLOAD +# if !defined SUSPLOAD DO k=2,Nbed bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nstp,ised) END DO -# endif +# endif bed(i,j,1,ithck)=MAX(bed(i,j,1,ithck)- & & cff/(Srho(ised,ng)* & & (1.0_r8-bed(i,j,1,iporo))), & & 0.0_r8) -# ifdef MASKING - bed(i,j,1,ithck)=bed(i,j,1,ithck)*rmask(i,j) -# endif END DO END DO ! @@ -797,6 +1230,22 @@ SUBROUTINE sed_bedload_tile (ng, tile, & END DO END DO ! +! Need to update bed mass for the non-cohesive sediment types, becasue +! they did not partake in the bedload transport. +! + DO ised=1,NCS + DO j=Jstr,Jend + DO i=Istr,Iend + bed_mass(i,j,1,nnew,ised)=bed_mass(i,j,1,nstp,ised) +# if !defined SUSPLOAD + DO k=2,Nbed + bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nstp,ised) + END DO +# endif + END DO + END DO + END DO +! ! Update mean surface properties. ! Sd50 must be positive definite, due to BBL routines. ! Srho must be >1000, due to (s-1) in BBL routines. @@ -807,11 +1256,8 @@ SUBROUTINE sed_bedload_tile (ng, tile, & DO ised=1,NST cff3=cff3+bed_mass(i,j,1,nnew,ised) END DO - IF (cff3.eq.0.0_r8) THEN - cff3=eps - END IF DO ised=1,NST - bed_frac(i,j,1,ised)=bed_mass(i,j,1,nnew,ised)/cff3 + bed_frac(i,j,1,ised)=bed_mass(i,j,1,nnew,ised)/MAX(cff3,eps) END DO ! cff1=1.0_r8 @@ -830,7 +1276,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & bottom(i,j,idens)=MAX(cff4,1050.0_r8) END DO END DO -# endif ! !----------------------------------------------------------------------- ! Apply periodic or gradient boundary conditions to property arrays. @@ -843,7 +1288,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & CALL bc_r3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, 1, Nbed, & & bed_mass(:,:,:,nnew,ised)) -# ifdef BEDLOAD IF (EWperiodic(ng).or.NSperiodic(ng)) THEN CALL exchange_u2d_tile (ng, tile, & & LBi, UBi, LBj, UBj, & @@ -852,7 +1296,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & bedldv(:,:,ised)) END IF -# endif END DO # ifdef DISTRIBUTE CALL mp_exchange4d (ng, tile, iNLM, 2, & @@ -861,7 +1304,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & EWperiodic(ng), NSperiodic(ng), & & bed_frac, & & bed_mass(:,:,:,nnew,:)) -# ifdef BEDLOAD IF (EWperiodic(ng).or.NSperiodic(ng)) THEN CALL mp_exchange3d (ng, tile, iNLM, 2, & & LBi, UBi, LBj, UBj, 1, NST, & @@ -869,9 +1311,7 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & EWperiodic(ng), NSperiodic(ng), & & bedldu, bedldv) END IF -# endif # endif - DO i=1,MBEDP CALL bc_r3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, 1, Nbed, & @@ -884,7 +1324,6 @@ SUBROUTINE sed_bedload_tile (ng, tile, & & EWperiodic(ng), NSperiodic(ng), & & bed) # endif - CALL bc_r3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, 1, MBOTP, & & bottom) diff --git a/ROMS/Nonlinear/Sediment/sed_bedload_vandera.F b/ROMS/Nonlinear/Sediment/sed_bedload_vandera.F new file mode 100644 index 00000000..a3679644 --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sed_bedload_vandera.F @@ -0,0 +1,2197 @@ +#include "cppdefs.h" +#define SED_WENO +#undef SED_UPWIND + MODULE sed_bedload_vandera_mod + +#if defined NONLINEAR && defined SEDIMENT && defined BEDLOAD_VANDERA +! +!git $Id$ +!================================================ Tarandeep S. Kalra === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Chris Sherwood ! +! Licensed under a MIT/X style license John C. Warner ! +! See License_ROMS.txt ! +!======================================================================= +¡ ! +! This routine computes sediment bedload transport using ! +! Van der A et al.(2013) formulation for unidirectional flow and ! +! accounts for wave asymmetry leading to differential sediment ! +! transport for crest and trough cycles. ! +! ! +! References: ! +! ! +! van der A, D.A., Ribberink, J.S., van der Werf, J.J.,O'Donoghue, T.,! +! Buijsrogge, R.H., Kranenburg, W.M., (2013). Practical sand transport! +! formula for non-breaking waves and currents. Coastal Engineering, ! +! 76, pp.26-42 ! +! ! +! Kalra, T.S., Suttles, S., Sherwood, C.R., Warner, J.C. ! +! Aretxabaleta,A.L., and Leavitt, G.R. (2022). Shoaling Wave Shape ! +! Estimates from Field Observations and derived Bedload Sediment Rates! +! J. Mar.Sci.Eng. 2022, 10, 223. https://doi.org/10.3390/jmse10020223 ! +! ! +! Udated sed bed evolution scheme to the WENO method of: ! +! Wen Long, James T. Kirby, Zhiyu Shao, ! +! A numerical scheme for morphological bed level calculations, ! +! Coastal Engineering,55, Issue 2, 2008, 167-180. ! +! https://doi.org/10.1016/j.coastaleng.2007.09.009. ! +! ! +!======================================================================! +! + implicit none + + PRIVATE + PUBLIC :: sed_bedload_vandera + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sed_bedload_vandera (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_sedbed + USE mod_stepping + +# ifdef BBL_MODEL + USE mod_bbl +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL sed_bedload_vandera_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & + & BBL(ng) % bustrc, & + & BBL(ng) % bvstrc, & + & FORCES(ng) % Hwave, & + & FORCES(ng) % Lwave, & + & FORCES(ng) % Dwave, & + & FORCES(ng) % Pwave_bot, & + & FORCES(ng) % Uwave_rms, & + & GRID(ng) % angler, & + & GRID(ng) % h, & + & GRID(ng) % om_r, & + & GRID(ng) % om_u, & + & GRID(ng) % on_r, & + & GRID(ng) % on_v, & + & GRID(ng) % pm, & + & GRID(ng) % pn, & +# ifdef MASKING + & GRID(ng) % rmask, & + & GRID(ng) % umask, & + & GRID(ng) % vmask, & +# endif +# ifdef WET_DRY + & GRID(ng) % rmask_wet, & + & GRID(ng) % umask_wet, & + & GRID(ng) % vmask_wet, & +# endif + & GRID(ng) % z_w, & + & OCEAN(ng) % zeta, & + & SEDBED(ng) % ursell_no, & + & SEDBED(ng) % RR_asymwave, & + & SEDBED(ng) % beta_asymwave, & + & SEDBED(ng) % ucrest_r, & + & SEDBED(ng) % utrough_r, & + & SEDBED(ng) % T_crest, & + & SEDBED(ng) % T_trough, & + & SEDBED(ng) % bedldu, & + & SEDBED(ng) % bedldv, & + & SEDBED(ng) % bed, & + & SEDBED(ng) % bed_frac, & + & SEDBED(ng) % bed_mass, & + & SEDBED(ng) % bottom) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE sed_bedload_vandera +! +!*********************************************************************** + SUBROUTINE sed_bedload_vandera_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & + & bustrc, bvstrc, & + & Hwave, Lwave, & + & Dwave, Pwave_bot, & + & Uwave_rms, & + & angler, & + & h, om_r, om_u, on_r, on_v, & + & pm, pn, & +# ifdef MASKING + & rmask, umask, vmask, & +# endif +# ifdef WET_DRY + & rmask_wet, umask_wet, vmask_wet, & +# endif + & z_w, & + & zeta, & + & ursell_no, & + & RR_asymwave, beta_asymwave, & + & ucrest_r, utrough_r, & + & T_crest, T_trough, & + & bedldu, bedldv, & + & bed, bed_frac, bed_mass, & + & bottom) +!*********************************************************************** +! + USE mod_param + USE mod_ncparam + USE mod_scalars + USE mod_sediment + USE mod_vandera_funcs +! + USE bc_2d_mod, ONLY : bc_r2d_tile + USE bc_3d_mod, ONLY : bc_r3d_tile + USE exchange_2d_mod, ONLY : exchange_u2d_tile, exchange_v2d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d, & + & mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: bustrc(LBi:,LBj:) + real(r8), intent(in) :: bvstrc(LBi:,LBj:) +! + real(r8), intent(in) :: Hwave(LBi:,LBj:) + real(r8), intent(in) :: Lwave(LBi:,LBj:) + real(r8), intent(in) :: Dwave(LBi:,LBj:) + real(r8), intent(in) :: Pwave_bot(LBi:,LBj:) + real(r8), intent(in) :: Uwave_rms(LBi:,LBj:) +! + real(r8), intent(in) :: angler(LBi:,LBj:) + real(r8), intent(in) :: h(LBi:,LBj:) + real(r8), intent(in) :: om_r(LBi:,LBj:) + real(r8), intent(in) :: om_u(LBi:,LBj:) + real(r8), intent(in) :: on_r(LBi:,LBj:) + real(r8), intent(in) :: on_v(LBi:,LBj:) + real(r8), intent(in) :: pm(LBi:,LBj:) + real(r8), intent(in) :: pn(LBi:,LBj:) +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:,LBj:) + real(r8), intent(in) :: umask(LBi:,LBj:) + real(r8), intent(in) :: vmask(LBi:,LBj:) +# endif +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:,LBj:) + real(r8), intent(in) :: umask_wet(LBi:,LBj:) + real(r8), intent(in) :: vmask_wet(LBi:,LBj:) +# endif + real(r8), intent(in) :: z_w(LBi:,LBj:,0:) +! + real(r8), intent(in) :: zeta(LBi:,LBj:,:) +! + real(r8), intent(inout) :: ursell_no(LBi:,LBj:) + real(r8), intent(inout) :: RR_asymwave(LBi:,LBj:) + real(r8), intent(inout) :: beta_asymwave(LBi:,LBj:) + real(r8), intent(inout) :: ucrest_r(LBi:,LBj:) + real(r8), intent(inout) :: utrough_r(LBi:,LBj:) + real(r8), intent(inout) :: T_crest(LBi:,LBj:) + real(r8), intent(inout) :: T_trough(LBi:,LBj:) +! + real(r8), intent(inout) :: bedldu(LBi:,LBj:,:) + real(r8), intent(inout) :: bedldv(LBi:,LBj:,:) + real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bottom(LBi:,LBj:,:) +# else + real(r8), intent(in) :: bustrc(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstrc(LBi:UBi,LBj:UBj) +! + real(r8), intent(in) :: Hwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Lwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Dwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Pwave_bot(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Uwave_rms(LBi:UBi,LBj:UBj) +! + real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: h(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj) +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj) +# endif +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: umask_wet(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask_wet(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng)) +! + real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,3) +! + real(r8), intent(inout) :: ursell_no(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: RR_asymwave(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: beta_asymwave(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: ucrest_r((LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: utrough_r(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: T_crest(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: T_trough(LBi:UBi,LBj:UBj) +! + real(r8), intent(inout) :: bedldu(LBi:UBi,LBj:UBj,NST) + real(r8), intent(inout) :: bedldv(LBi:UBi,LBj:UBj,NST) + real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) + real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) + real(r8), intent(inout) :: bottom(LBi:UBi,LBj:UBj,MBOTP) +# endif +! +! Local variable declarations. +! + integer :: i, ii, ip, ised, j, jj, jp, k +! + real(r8) :: cff, cff1, cff2, cff3, cff4, cff5, fac1, fac2 + real(r8) :: Dstp, bed_change, dz, roll + real(r8) :: a_slopex, a_slopey, sed_angle + real(r8) :: bedld, bedld_mass, dzdx, dzdy, dzdxdy + real(r8) :: rhs_bed, Ua, Ra, Clim, phi_cw +! + real(r8) :: Hs, Td, depth + real(r8) :: d50, d50_mix, d90, rhos + real(r8) :: urms, umag_curr, phi_curwave, udelta + real(r8) :: y, uhat, ahat + real(r8) :: k_wn, c_w + real(r8) :: smgd, osmgd +! + real(r8) :: r, phi, Su, Au + real(r8) :: Sk, Ak + real(r8) :: T_cu, T_tu + real(r8) :: umax, umin +! + real(r8) :: uhat_c, uhat_t + real(r8) :: mag_uc, mag_ut +! + real(r8) :: theta + real(r8) :: fd, ksw, eta, alpha, tau_wRe + real(r8) :: dsf_c, dsf_t + real(r8) :: theta_c, theta_t + real(r8) :: theta_cx, theta_cy, theta_tx, theta_ty + real(r8) :: mag_theta_c, mag_theta_t + real(r8) :: mag_bstrc + real(r8) :: om_cc, om_tt, om_ct, om_tc + real(r8) :: smgd_3 +! + real(r8) :: bedld_cx, bedld_cy + real(r8) :: bedld_tx, bedld_ty + real(r8) :: bedld_x, bedld_y +! + real(r8) :: wavecycle, alphac, alphaw + real(r8) :: twopi, otwopi, sqrt2 +! +# ifdef SED_SLUMP + real(r8) :: slopefac_wet_local, slopefac_dry_local +# endif + real(r8), parameter :: eps = 1.0E-14_r8 + +# ifdef SED_WENO + real(r8) :: S1m, S2m, S3m, S1p, S2p, S3p + real(r8) :: alpha1m, alpha2m, alpha3m + real(r8) :: alpha1p, alpha2p, alpha3p, alpham, alphap + real(r8) :: w1m, w2m, w3m, w1p, w2p, w3p + real(r8) :: q1m, q2m, q3m, q1p, q2p, q3p + real(r8) :: signa, FXm, FXp, FEm, FEp + real(r8), parameter :: thirtotwelv = 13.0_r8/12.0_r8 + real(r8), parameter :: elevenosix = 11.0_r8/6.0_r8 + real(r8), parameter :: sevenosix = 7.0_r8/6.0_r8 + real(r8), parameter :: fiveosix = 5.0_r8/6.0_r8 + real(r8), parameter :: oneosix = 1.0_r8/6.0_r8 + real(r8), parameter :: oneothree = 1.0_r8/3.0_r8 +# endif +! + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FX + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FE + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FX_r + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FE_r + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: phic +! +! Need local arrays for the global vars because we fill the local +! arrays larger than the standard stencil. +! + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ursell_nol + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: RR_asymwavel + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: beta_asymwavel + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ksd_wbll + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: fd_wbll + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: phi_wcl + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ucrest_rl + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: utrough_rl + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: T_crestl + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: T_troughl + +# include "set_bounds.h" +! + twopi=2.0_r8*pi + otwopi=1.0_r8/twopi + sqrt2=SQRT(2.0_r8) + FX_r=0.0_r8 + FE_r=0.0_r8 + fd=0.0_r8 +! +!----------------------------------------------------------------------- +! Compute bedload sediment transport. +!----------------------------------------------------------------------- +! + sed_angle=DTAN(33.0_r8*pi/180.0_r8) + alphac=bedload_vandera_alphac(ng) + alphaw=bedload_vandera_alphaw(ng) +! +# if defined SED_WENO + DO j=Jstrm3,Jendp2i + DO i=Istrm3,Iendp2i +# else + DO j=Jstrm1,Jendp1 + DO i=Istrm1,Iendp1 +# endif +! +! Compute angle between currents and waves, measure CCW from current +! direction toward wave vector. +! + phi_cw=1.5_r8*pi-Dwave(i,j)-bottom(i,j,idpcx)-angler(i,j) +! +! Compute angle between waves and current, measure CCW from wave +! towards current vector +! + phi_wcl(i,j)=2.0_r8*pi-phi_cw +! + END DO + END DO +! + DO ised=NCS+1,NST + rhos=Srho(ised,ng) ! (kg/m3) + d50=sd50(ised,ng) ! (m) + d90=1.3_r8*d50 ! (m) + IF(NST>1) THEN + d50_mix=0.0003 ! 0.3 mm + ELSE + d50_mix=d50 + ENDIF +! + cff=rhos/rho0 + smgd=(cff-1.0_r8)*g*d50 + osmgd=1.0_r8/smgd +! + smgd_3=sqrt((cff-1.0_r8)*g*d50**3.0_r8) +! +# if defined SED_WENO + DO j=Jstrm3,Jendp2i + DO i=Istrm3,Iendp2i +# else + DO j=Jstrm1,Jendp1 + DO i=Istrm1,Iendp1 +# endif +! + Hs=Hwave(i,j) ! (m) + depth=MAX(h(i,j)+zeta(i,j,1),Dcrit(ng)) ! (m) + Td=MAX(Pwave_bot(i,j),1.0_r8) ! (s) + urms=Uwave_rms(i,j) ! (m/s) + phi_curwave=phi_wcl(i,j) + udelta=bottom(i,j,idubl) +# if defined BEDLOAD_VANDERA_MADSEN_UDELTA + ksd_wbll(i,j)=bottom(i,j,idksd) +# endif +! +! Compute magnitude of stress for computing current velocity +! at the wave boundary layer +! + mag_bstrc=SQRT(bustrc(i,j)*bustrc(i,j)+ & + & bvstrc(i,j)*bvstrc(i,j)) +! + uhat=urms*sqrt2 + ahat=uhat*Td*otwopi + k_wn=kh(Td,depth)/depth ! Wave number + c_w=2.0_r8*pi/(k_wn*Td) ! Wave speed +! +! VA-2013 equation 1 is solved in 3 sub-steps +! +!---------------------------------------------------------------------- +! Ruessink et al. provides equations for calculating skewness parameters +! Uses Malarkey and Davies equations to get "r" and "phi" +! common to both crest and trough. +!----------------------------------------------------------------------- +! + CALL skewness_params(Hs, Td, depth, r, phi, ursell_nol(i,j)) +! +!----------------------------------------------------------------------- +! Abreu et al. use skewness params to get representative critical orbital +! velocity for crest and trough cycles , use r and phi. +!----------------------------------------------------------------------- +! + CALL abreu_points(r, phi, uhat, Td, & + & T_crestl(i,j), T_troughl(i,j), & + & T_cu, T_tu, umax, umin, & + & RR_asymwavel(i,j), beta_asymwavel(i,j)) +! +!----------------------------------------------------------------------- +! Crest half cycle +!----------------------------------------------------------------------- +! Step 1. Representative crest half cycle water particle velocity +! as well as full cycle orbital velocity and excursion. +!----------------------------------------------------------------------- +! + uhat_c=umax + uhat_t=umin +! +!----------------------------------------------------------------------- +! VA2013 Equation 10, 11. +!----------------------------------------------------------------------- +! + ucrest_rl(i,j)=0.5_r8*sqrt2*uhat_c + utrough_rl(i,j)=0.5_r8*sqrt2*uhat_t +! + smgd=(rhos/rho0-1.0_r8)*g*d50 + osmgd=1.0_r8/smgd +! +! Full wave cycle +! + CALL full_wave_cycle_stress_factors(ng, d50, d90, osmgd, & + & Td, depth, & + & umag_curr, phi_curwave, & + & RR_asymwavel(i,j), uhat, ahat,& + & umax, umin, & + & mag_bstrc, & + & alphac, alphaw, & + & T_crestl(i,j), T_troughl(i,j), & + & T_cu, T_tu, & + & ksd_wbll(i,j), udelta, & + & fd_wbll(i,j), & + alpha, eta, ksw, tau_wRe ) +! +!----------------------------------------------------------------------- +! 2. Bed shear stress (Shields parameter) for Crest half cycle +! alpha VA2013 Eqn. 19 +!----------------------------------------------------------------------- +! +! alpha VA2013 Eqn. 19 +!----------------------------------------------------------------------- +! + CALL half_wave_cycle_stress_factors( T_cu, T_crestl(i,j), & + & ahat, ksw, & + & fd_wbll(i,j), alpha, & + & alphac, alphaw, & + & d50, osmgd, & + & ucrest_rl(i,j), uhat_c, udelta, phi_curwave, & + & tau_wRe, & + & dsf_c, theta_cx, theta_cy, mag_theta_c ) +! +!----------------------------------------------------------------------- +! 3. Compute sediment load entrained during each crest half cycle +!----------------------------------------------------------------------- +! + wavecycle=1.0_r8 + CALL sandload_vandera( wavecycle, & + & Hs, Td, depth, RR_asymwavel(i,j), & + & d50, d50_mix, rhos, c_w, & + & eta, dsf_c, & + & T_crestl(i,j), T_cu, uhat_c, & + & mag_theta_c, om_cc, om_ct ) +! +!----------------------------------------------------------------------- +! 2. Bed shear stress (Shields parameter) for Trough half cycle +! alpha VA2013 Eqn. 19 +!----------------------------------------------------------------------- +! + CALL half_wave_cycle_stress_factors( T_tu, T_troughl(i,j), & + & ahat, ksw, & + & fd_wbll(i,j), alpha, & + & alphac, alphaw, & + & d50, osmgd, & + & utrough_rl(i,j), uhat_t, udelta, phi_curwave, & + & tau_wRe, & + & dsf_t, theta_tx, theta_ty, mag_theta_t ) +! +!----------------------------------------------------------------------- +! 3. Compute sediment load entrained during each trough half cycle +!----------------------------------------------------------------------- +! + wavecycle=-1.0_r8 + CALL sandload_vandera( wavecycle, & + & Hs, Td, depth, RR_asymwavel(i,j), & + & d50, d50_mix, rhos, c_w, & + & eta, dsf_t, & + & T_troughl(i,j), T_tu, uhat_t, & + & mag_theta_t, om_tt, om_tc ) +! +!----------------------------------------------------------------------- +! 3. Compute sediment load entrained during each trough half cycle +!----------------------------------------------------------------------- +! + cff1=MAX(0.5_r8*T_crestl(i,j)/(T_cu+eps), 0.0_r8) +! + cff2=sqrt(mag_theta_c)*(om_cc+cff1*om_tc) + cff3=(theta_cx/mag_theta_c) + bedld_cx=cff2*cff3 +! + cff3=(theta_cy/mag_theta_c) + bedld_cy=cff2*cff3 +! + cff1=MAX(0.5_r8*T_troughl(i,j)/(T_tu+eps), 0.0_r8) +! + cff2=sqrt(mag_theta_t)*(om_tt+cff1*om_ct) + cff3=(theta_tx/mag_theta_t) + bedld_tx=cff2*cff3 +! + cff3=(theta_ty/mag_theta_t) + bedld_ty=cff2*cff3 +! +!----------------------------------------------------------------------- +! VA2013 Use the velocity-load equation 1. +! Units of smgd_3 are m2-s-1 +!----------------------------------------------------------------------- +! + smgd_3=sqrt((rhos/rho0-1.0_r8)*g*d50**3.0_r8) +! + bedld_x=smgd_3*( bedld_cx*T_crestl(i,j)+ & + & bedld_tx*T_troughl(i,j) )/(Td+eps) + bedld_y=smgd_3*( bedld_cy*T_crestl(i,j)+ & + & bedld_ty*T_troughl(i,j) )/(Td+eps) +! +! The units of these are kg m-1 sec-1 +! COMMENTED FOR NOW +! + bedld_x=rhos*bedld_x*bed_frac(i,j,1,ised) + bedld_y=rhos*bedld_y*bed_frac(i,j,1,ised) +! +! Convert bedload from the wave aligned axis to xi and eta directions +! + theta=1.5_r8*pi-Dwave(i,j)-angler(i,j) +! +! Partition bedld into xi and eta directions, still at rho points. +! (FX_r and FE_r have dimensions of kg). +! + FX_r(i,j)=(bedld_x*COS(theta)-bedld_y*SIN(theta))* & + & on_r(i,j)*dt(ng) + FE_r(i,j)=(bedld_x*SIN(theta)+bedld_y*COS(theta))* & + & om_r(i,j)*dt(ng) +! +! Correct for along-direction slope. Limit slope to 0.9*sed angle. +! + cff1=0.5_r8*(1.0_r8+SIGN(1.0_r8,FX_r(i,j))) + cff2=0.5_r8*(1.0_r8-SIGN(1.0_r8,FX_r(i,j))) + cff3=0.5_r8*(1.0_r8+SIGN(1.0_r8,FE_r(i,j))) + cff4=0.5_r8*(1.0_r8-SIGN(1.0_r8,FE_r(i,j))) +# if defined SLOPE_NEMETH + dzdx=(h(i+1,j)-h(i,j))/om_u(i+1,j)*cff1+ & + & (h(i-1,j)-h(i,j))/om_u(i ,j)*cff2 + dzdy=(h(i,j+1)-h(i,j))/on_v(i,j+1)*cff3+ & + & (h(i,j-1)-h(i,j))/on_v(i ,j)*cff4 + a_slopex=1.7_r8*dzdx + a_slopey=1.7_r8*dzdy +! +! Add contribution of bed slope to bed load transport fluxes. +! + FX_r(i,j)=FX_r(i,j)*(1.0_r8+a_slopex) + FE_r(i,j)=FE_r(i,j)*(1.0_r8+a_slopey) +! +# elif defined SLOPE_LESSER + dzdx=MIN(((h(i+1,j)-h(i ,j))/om_u(i+1,j)*cff1+ & + & (h(i ,j)-h(i-1,j))/om_u(i ,j)*cff2),0.52_r8)* & + & SIGN(1.0_r8,FX_r(i,j)) + dzdy=MIN(((h(i,j+1)-h(i,j ))/on_v(i,j+1)*cff3+ & + & (h(i,j )-h(i,j-1))/on_v(i ,j)*cff4),0.52_r8)* & + & SIGN(1.0_r8,FE_r(i,j)) + cff=DATAN(dzdx) + a_slopex=sed_angle/(COS(cff)*(sed_angle-dzdx)) + cff=DATAN(dzdy) + a_slopey=sed_angle/(COS(cff)*(sed_angle-dzdy)) +! +! Add contribution of bed slope to bed load transport fluxes. +! + FX_r(i,j)=FX_r(i,j)*a_slopex + FE_r(i,j)=FE_r(i,j)*a_slopey +# endif +# ifdef SED_MORPH +! +! Apply morphology factor. +! + FX_r(i,j)=FX_r(i,j)*morph_fac(ised,ng) + FE_r(i,j)=FE_r(i,j)*morph_fac(ised,ng) +# endif +! +! Apply bedload transport rate coefficient. Also limit +! bedload to the fraction of each sediment class. +! + FX_r(i,j)=FX_r(i,j)*bedload_coeff(ng)*bed_frac(i,j,1,ised) + FE_r(i,j)=FE_r(i,j)*bedload_coeff(ng)*bed_frac(i,j,1,ised) +! +! Limit bed load to available bed mass. +! + bedld_mass=ABS(FX_r(i,j))+ABS(FE_r(i,j))+eps + FX_r(i,j)=MIN(ABS(FX_r(i,j)), & + & bed_mass(i,j,1,nstp,ised)* & + & om_r(i,j)*on_r(i,j)*ABS(FX_r(i,j))/ & + & bedld_mass)* & + & SIGN(1.0_r8,FX_r(i,j)) + FE_r(i,j)=MIN(ABS(FE_r(i,j)), & + & bed_mass(i,j,1,nstp,ised)* & + & om_r(i,j)*on_r(i,j)*ABS(FE_r(i,j))/ & + & bedld_mass)* & + & SIGN(1.0_r8,FE_r(i,j)) +# ifdef MASKING +# ifdef WET_DRY + FX_r(i,j)=FX_r(i,j)*rmask_wet(i,j) + FE_r(i,j)=FE_r(i,j)*rmask_wet(i,j) +# else + FX_r(i,j)=FX_r(i,j)*rmask(i,j) + FE_r(i,j)=FE_r(i,j)*rmask(i,j) +# endif +# endif + END DO + END DO +! +! Apply boundary conditions (gradient). +! + IF (.not.(CompositeGrid(iwest,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%Western_Edge(tile)) THEN + DO j=Jstrm1,Jendp1 + FX_r(Istr-1,j)=FX_r(Istr,j) + FE_r(Istr-1,j)=FE_r(Istr,j) + END DO + END IF + END IF + IF (.not.(CompositeGrid(ieast,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN + DO j=Jstrm1,Jendp1 + FX_r(Iend+1,j)=FX_r(Iend,j) + FE_r(Iend+1,j)=FE_r(Iend,j) + END DO + END IF + END IF +! + IF (.not.(CompositeGrid(isouth,ng).or.NSperiodic(ng))) THEN + IF (DOMAIN(ng)%Southern_Edge(tile)) THEN + DO i=Istrm1,Iendp1 + FX_r(i,Jstr-1)=FX_r(i,Jstr) + FE_r(i,Jstr-1)=FE_r(i,Jstr) + END DO + END IF + END IF + IF (.not.(CompositeGrid(inorth,ng).or.NSperiodic(ng))) THEN + IF (DOMAIN(ng)%Northern_Edge(tile)) THEN + DO i=Istrm1,Iendp1 + FX_r(i,Jend+1)=FX_r(i,Jend) + FE_r(i,Jend+1)=FE_r(i,Jend) + END DO + END IF + END IF +! + IF (.not.(CompositeGrid(isouth,ng).or.NSperiodic(ng).or. & + & CompositeGrid(iwest ,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%SouthWest_Corner(tile)) THEN + FX_r(Istr-1,Jstr-1)=0.5_r8*(FX_r(Istr ,Jstr-1)+ & + & FX_r(Istr-1,Jstr )) + FE_r(Istr-1,Jstr-1)=0.5_r8*(FE_r(Istr ,Jstr-1)+ & + & FE_r(Istr-1,Jstr )) + END IF + END IF + + IF (.not.(CompositeGrid(isouth,ng).or.NSperiodic(ng).or. & + & CompositeGrid(ieast ,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%SouthEast_Corner(tile)) THEN + FX_r(Iend+1,Jstr-1)=0.5_r8*(FX_r(Iend ,Jstr-1)+ & + & FX_r(Iend+1,Jstr )) + FE_r(Iend+1,Jstr-1)=0.5_r8*(FE_r(Iend ,Jstr-1)+ & + & FE_r(Iend+1,Jstr )) + END IF + END IF + + IF (.not.(CompositeGrid(inorth,ng).or.NSperiodic(ng).or. & + & CompositeGrid(iwest ,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%NorthWest_Corner(tile)) THEN + FX_r(Istr-1,Jend+1)=0.5_r8*(FX_r(Istr-1,Jend )+ & + & FX_r(Istr ,Jend+1)) + FE_r(Istr-1,Jend+1)=0.5_r8*(FE_r(Istr-1,Jend )+ & + & FE_r(Istr ,Jend+1)) + END IF + END IF + + IF (.not.(CompositeGrid(inorth,ng).or.NSperiodic(ng).or. & + & CompositeGrid(ieast ,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%NorthEast_Corner(tile)) THEN + FX_r(Iend+1,Jend+1)=0.5_r8*(FX_r(Iend+1,Jend )+ & + & FX_r(Iend ,Jend+1)) + FE_r(Iend+1,Jend+1)=0.5_r8*(FE_r(Iend+1,Jend )+ & + & FE_r(Iend ,Jend+1)) + END IF + END IF +! +! Compute face fluxes at u and v points before taking divergence. +! +! DO j=JstrR,JendR + DO j=Jstr,Jend + DO i=Istr,Iend+1 +# if defined SED_UPWIND + cff1=0.5_r8*(1.0_r8+SIGN(1.0_r8,FX_r(i,j))) + cff2=0.5_r8*(1.0_r8-SIGN(1.0_r8,FX_r(i,j))) + FX(i,j)=0.5_r8*(1.0_r8+SIGN(1.0_r8,FX_r(i-1,j)))* & + & (cff1*FX_r(i-1,j)+ & + & cff2*(FX_r(i-1,j)+FX_r(i,j)))+ & + & 0.5_r8*(1.0_r8-SIGN(1.0_r8,FX_r(i-1,j)))* & + & (cff2*FX_r(i ,j)+ & + & cff1*0.5_r8*(FX_r(i-1,j)+FX_r(i,j))) + +# elif defined SED_WENO +! +! Long et al. (2008). Coastal Engr, 55, 167-180. +! + S1m=thirtotwelv* & + & (FX_r(i-3,j)-2.0_r8*FX_r(i-2,j)+FX_r(i-1,j))**2+ & + & 0.25_r8* & + & (FX_r(i-3,j)-4.0_r8*FX_r(i-2,j)+3.0_r8*FX_r(i-1,j))**2 + S2m=thirtotwelv* & + & (FX_r(i-2,j)-2.0_r8*FX_r(i-1,j)+FX_r(i,j))**2+ & + & 0.25_r8* & + & (FX_r(i-2,j)-FX_r(i,j))**2 + S3m=thirtotwelv* & + & (FX_r(i-1,j)-2.0_r8*FX_r(i,j)+FX_r(i+1,j))**2+ & + & 0.25_r8* & + & (3.0_r8*FX_r(i-1,j)-4.0_r8*FX_r(i,j)+FX_r(i+1,j))**2 +! + S1p=thirtotwelv* & + & (FX_r(i-2,j)-2.0_r8*FX_r(i-1,j)+FX_r(i,j))**2+ & + & 0.25_r8* & + & (FX_r(i-2,j)-4.0_r8*FX_r(i-1,j)+3.0_r8*FX_r(i,j))**2 + S2p=thirtotwelv* & + & (FX_r(i-1,j)-2.0_r8*FX_r(i,j)+FX_r(i+1,j))**2+ & + & 0.25_r8* & + & (FX_r(i-1,j)-FX_r(i+1,j))**2 +! & (-FX_r(i-1,j)+FX_r(i+1,j))**2 + S3p=thirtotwelv* & + & (FX_r(i,j)-2.0_r8*FX_r(i+1,j)+FX_r(i+2,j))**2+ & + & 0.25_r8* & + & (3.0_r8*FX_r(i,j)-4.0_r8*FX_r(i+1,j)+FX_r(i+2,j))**2 + + +! + alpha1m=0.1_r8/(S1m+eps)**2 + alpha2m=0.6_r8/(S2m+eps)**2 + alpha3m=0.3_r8/(S3m+eps)**2 +! + alpha1p=0.3_r8/(S1p+eps)**2 + alpha2p=0.6_r8/(S2p+eps)**2 + alpha3p=0.1_r8/(S3p+eps)**2 +! + alpham=alpha1m+alpha2m+alpha3m + alphap=alpha1p+alpha2p+alpha3p +! + w1m=alpha1m/alpham + w2m=alpha2m/alpham + w3m=alpha3m/alpham + w1p=alpha1p/alphap + w2p=alpha2p/alphap + w3p=alpha3p/alphap +! + q1m=oneothree*FX_r(i-3,j)-sevenosix*FX_r(i-2,j)+ & + & elevenosix*FX_r(i-1,j) + q2m=-oneosix*FX_r(i-2,j)+fiveosix*FX_r(i-1,j)+ & + & oneothree*FX_r(i,j) + q3m=oneothree*FX_r(i-1,j)+fiveosix*FX_r(i,j)- & + & oneosix*FX_r(i+1,j) +! + q1p=-oneosix*FX_r(i-2,j)+fiveosix*FX_r(i-1,j)+ & + & oneothree*FX_r(i,j) + q2p=oneothree*FX_r(i-1,j)+fiveosix*FX_r(i,j)- & + & oneosix*FX_r(i+1,j) + q3p=elevenosix*FX_r(i,j)-sevenosix*FX_r(i+1,j)+ & + & oneothree*FX_r(i+2,j) +! +! signa=(FX_r(i,j)-FX_r(i-1,j))*(h(i,j)-h(i-1,j)) + signa=FX_r(i,j) + cff=SIGN(1.0_r8,signa) + FXm=0.5_r8*(1.0_r8+cff)*(w1m*q1m+w2m*q2m+w3m*q3m) + FXp=0.5_r8*(1.0_r8-cff)*(w1p*q1p+w2p*q2p+w3p*q3p) +! + FX(i,j)=FXm+FXp +# else + FX(i,j)=0.5_r8*(FX_r(i-1,j)+FX_r(i,j)) +# endif +# ifdef SLOPE_KIRWAN + cff1=10.0_r8 + dzdx=(h(i,j)-h(i-1 ,j))/om_u(i,j) + a_slopex=(MAX(0.0_r8,abs(dzdx)-0.05_r8) & + & *SIGN(1.0_r8,dzdx)*cff1) & + & *om_r(i,j)*dt(ng) +# ifdef SED_MORPH + a_slopex=a_slopex*morph_fac(ised,ng) +# endif + FX(i,j)=FX(i,j)+a_slopex +# endif +# ifdef MASKING + FX(i,j)=FX(i,j)*umask(i,j) +# ifdef WET_DRY + FX(i,j)=FX(i,j)*umask_wet(i,j) +# endif +# endif + END DO + END DO + DO j=Jstr,Jend+1 +! DO i=IstrR,IendR + DO i=Istr,Iend +# ifdef SED_UPWIND + cff1=0.5_r8*(1.0_r8+SIGN(1.0_r8,FE_r(i,j))) + cff2=0.5_r8*(1.0_r8-SIGN(1.0_r8,FE_r(i,j))) + FE(i,j)=0.5_r8*(1.0_r8+SIGN(1.0_r8,FE_r(i,j-1)))* & + & (cff1*FE_r(i,j-1)+ & + & cff2*(FE_r(i,j-1)+FE_r(i,j)))+ & + & 0.5_r8*(1.0_r8-SIGN(1.0_r8,FE_r(i,j-1)))* & + & (cff2*FE_r(i ,j)+ & + & cff1*0.5_r8*(FE_r(i,j-1)+FE_r(i,j))) +# elif defined SED_WENO +! +! Long et al. (2008). Coastal Engr, 55, 167-180. +! + S1m=thirtotwelv* & + & (FE_r(i,j-3)-2.0_r8*FE_r(i,j-2)+FE_r(i,j-1))**2+ & + & 0.25_r8* & + & (FE_r(i,j-3)-4.0_r8*FE_r(i,j-2)+3.0_r8*FE_r(i,j-1))**2 + S2m=thirtotwelv* & + & (FE_r(i,j-2)-2.0_r8*FE_r(i,j-1)+FE_r(i,j))**2+ & + & 0.25_r8* & + & (FE_r(i,j-2)-FE_r(i,j))**2 + S3m=thirtotwelv* & + & (FE_r(i,j-1)-2.0_r8*FE_r(i,j)+FE_r(i,j+1))**2+ & + & 0.25_r8* & + & (3.0_r8*FE_r(i,j-1)-4.0_r8*FE_r(i,j)+FE_r(i,j+1))**2 +! + S1p=thirtotwelv* & + & (FE_r(i,j-2)-2.0_r8*FE_r(i,j-1)+FE_r(i,j))**2+ & + & 0.25_r8* & + & (FE_r(i,j-2)-4.0_r8*FE_r(i,j-1)+3.0_r8*FE_r(i,j))**2 + S2p=thirtotwelv* & + & (FE_r(i,j-1)-2.0_r8*FE_r(i,j)+FE_r(i,j+1))**2+ & + & 0.25_r8* & + & (FE_r(i,j-1)-FE_r(i,j+1))**2 +! & (-FE_r(i,j-1)+FE_r(i,j+1))**2 + S3p=thirtotwelv* & + & (FE_r(i,j)-2.0_r8*FE_r(i,j+1)+FE_r(i,j+2))**2+ & + & 0.25_r8* & + & (3.0_r8*FE_r(i,j)-4.0_r8*FE_r(i,j+1)+FE_r(i,j+2))**2 + + + alpha1m=0.1_r8/(S1m+eps)**2 + alpha2m=0.6_r8/(S2m+eps)**2 + alpha3m=0.3_r8/(S3m+eps)**2 +! + alpha1p=0.3_r8/(S1p+eps)**2 + alpha2p=0.6_r8/(S2p+eps)**2 + alpha3p=0.1_r8/(S3p+eps)**2 +! + alpham=alpha1m+alpha2m+alpha3m + alphap=alpha1p+alpha2p+alpha3p +! + w1m=alpha1m/alpham + w2m=alpha2m/alpham + w3m=alpha3m/alpham + w1p=alpha1p/alphap + w2p=alpha2p/alphap + w3p=alpha3p/alphap +! + q1m=oneothree*FE_r(i,j-3)-sevenosix*FE_r(i,j-2)+ & + & elevenosix*FE_r(i,j-1) + q2m=-oneosix*FE_r(i,j-2)+fiveosix*FE_r(i,j-1)+ & + & oneothree*FE_r(i,j) + q3m=oneothree*FE_r(i,j-1)+fiveosix*FE_r(i,j)- & + & oneosix*FE_r(i,j+1) +! + q1p=-oneosix*FE_r(i,j-2)+fiveosix*FE_r(i,j-1)+ & + & oneothree*FE_r(i,j) + q2p=oneothree*FE_r(i,j-1)+fiveosix*FE_r(i,j)- & + & oneosix*FE_r(i,j+1) + q3p=elevenosix*FE_r(i,j)-sevenosix*FE_r(i,j+1)+ & + & oneothree*FE_r(i,j+2) +! +! signa=(FE_r(i,j)-FE_r(i,j-1))*(h(i,j)-h(i,j-1)) + signa=FE_r(i,j) + cff=SIGN(1.0_r8,signa) + FEm=0.5_r8*(1.0_r8+cff)*(w1m*q1m+w2m*q2m+w3m*q3m) + FEp=0.5_r8*(1.0_r8-cff)*(w1p*q1p+w2p*q2p+w3p*q3p) +! + FE(i,j)=FEm+FEp + +# else + FE(i,j)=0.5_r8*(FE_r(i,j-1)+FE_r(i,j)) +# endif +# ifdef SLOPE_KIRWAN + cff1=10.0_r8 + dzdy=(h(i,j)-h(i ,j-1))/on_v(i,j) + a_slopey=(MAX(0.0_r8,abs(dzdy)-0.05_r8) & + & *SIGN(1.0_r8,dzdy)*cff1) & + & *on_r(i,j)*dt(ng) +# ifdef SED_MORPH + a_slopey=a_slopey*morph_fac(ised,ng) +# endif + FE(i,j)=FE(i,j)+a_slopey +# endif +# ifdef MASKING + FE(i,j)=FE(i,j)*vmask(i,j) +# ifdef WET_DRY + FE(i,j)=FE(i,j)*vmask_wet(i,j) +# endif +# endif + END DO + END DO +# ifdef SED_SLUMP +! +! Sed slump computation to allow slumping for wet areas everywhere +! and at the wet/dry interface. +! +! sedslopes are the critical slopes to allow slumping. +! slopefac are the scale factors for sediment movement. +! +! U-direction slumping +! + DO j=Jstr,Jend + DO i=Istr,Iend+1 + cff2=Srho(ised,ng)*(1.0_r8-bed(i,j,1,iporo)) + slopefac_dry_local=cff2*dt(ng)*slopefac_dry(ng) + slopefac_wet_local=cff2*dt(ng)*slopefac_wet(ng) +# ifdef SED_MORPH + slopefac_wet_local=slopefac_wet_local*morph_fac(ised,ng) + slopefac_dry_local=slopefac_dry_local*morph_fac(ised,ng) +# endif + dzdx=(h(i,j)-h(i-1,j))/om_u(i,j) + dzdy=(h(i,j)-h(i,j-1))/on_v(i,j) + dzdxdy=sqrt(dzdx**2.0_r8+dzdy**2.0_r8) +! For the wet part + cff=dzdxdy-sedslope_crit_wet(ng) + cff1=(0.5_r8+SIGN(0.5_r8,cff)) +!jcw +! cff=0.5_r8*cff*cff1/(pm(i,j)*pn(i,j)) +! cff2=cff*slopefac_wet_local*SIGN(1.0_r8,dzdx) +!mai + cff=ABS(dzdxdy-sedslope_crit_wet(ng))*dzdx/(dzdxdy+eps) + cff2=cff*cff1/(pm(i,j)*pn(i,j))*slopefac_wet_local +# ifdef MASKING + cff2=cff2*umask(i,j) +# ifdef WET_DRY + cff2=cff2*umask_wet(i,j) +# endif +# endif + FX(i,j)=FX(i,j)+cff2*bed_frac(i,j,1,ised) +! For the dry part +!jcw +! cff=ABS(dzdx)-sedslope_crit_dry(ng) +! cff1=(0.5_r8+SIGN(0.5_r8,cff)) +! cff=0.5_r8*cff*cff1/(pm(i,j)*pn(i,j)) +! cff2=cff*slopefac_dry_local*SIGN(1.0_r8,dzdx) +!mai + cff=dzdxdy-sedslope_crit_dry(ng) + cff1=(0.5_r8+SIGN(0.5_r8,cff)) + cff=ABS(dzdxdy-sedslope_crit_dry(ng))*dzdx/(dzdxdy+eps) + cff2=cff*cff1/(pm(i,j)*pn(i,j))*slopefac_dry_local +# ifdef MASKING + cff2=cff2*umask(i,j) +# ifdef WET_DRY + ii=MAX(i-1,1) + ip=MIN(i+1,Lm(ng)+1) + cff2=cff2*(1.0_r8-umask_wet(i,j))* & + & ((1.0_r8-umask_wet(ii,j))*umask_wet(ip,j)+ & + & (1.0_r8-umask_wet(ip,j))*umask_wet(ii,j)) +# endif +# endif + FX(i,j)=FX(i,j)+cff2*bed_frac(i,j,1,ised) + END DO + END DO +! +! V-direction slumping +! + DO j=Jstr,Jend+1 + DO i=Istr,Iend + cff2=Srho(ised,ng)*(1.0_r8-bed(i,j,1,iporo)) + slopefac_dry_local=cff2*dt(ng)*slopefac_dry(ng) + slopefac_wet_local=cff2*dt(ng)*slopefac_wet(ng) +# ifdef SED_MORPH + slopefac_wet_local=slopefac_wet_local*morph_fac(ised,ng) + slopefac_dry_local=slopefac_dry_local*morph_fac(ised,ng) +# endif + dzdy=(h(i,j)-h(i,j-1))/on_v(i,j) ! positive is downhill + dzdx=(h(i,j)-h(i-1,j))/om_u(i,j) + dzdxdy=sqrt(dzdx**2.0_r8+dzdy**2.0_r8) +! For the wet part + cff=ABS(dzdxdy)-sedslope_crit_wet(ng) + cff1=(0.5_r8+SIGN(0.5_r8,cff)) +!jcw +! cff=0.5_r8*cff*cff1/(pm(i,j)*pn(i,j)) +! cff2=cff*slopefac_wet_local*SIGN(1.0_r8,dzdy) +!mai + cff=ABS(dzdxdy-sedslope_crit_wet(ng))*dzdy/(dzdxdy+eps) + cff2=cff*cff1/(pm(i,j)*pn(i,j))*slopefac_wet_local +# ifdef MASKING + cff2=cff2*vmask(i,j) +# ifdef WET_DRY + cff2=cff2*vmask_wet(i,j) +# endif +# endif + FE(i,j)=FE(i,j)+cff2*bed_frac(i,j,1,ised) +! For the dry part +!jcw +! cff=ABS(dzdy)-sedslope_crit_dry(ng) +! cff1=(0.5_r8+SIGN(0.5_r8,cff)) +! cff=0.5_r8*cff*cff1/(pm(i,j)*pn(i,j)) +! cff2=cff*slopefac_dry_local*SIGN(1.0_r8,dzdy) +!mai + cff=dzdxdy-sedslope_crit_dry(ng) + cff1=(0.5_r8+SIGN(0.5_r8,cff)) + cff=ABS(dzdxdy-sedslope_crit_dry(ng))*dzdy/(dzdxdy+eps) + cff2=cff*cff1/(pm(i,j)*pn(i,j))*slopefac_dry_local +# ifdef MASKING + cff2=cff2*vmask(i,j) +# ifdef WET_DRY + jj=MAX(j-1,1) + jp=MIN(j+1,Mm(ng)+1) + cff2=cff2*(1.0_r8-vmask_wet(i,j))* & + & ((1.0_r8-vmask_wet(i,jj))*vmask_wet(i,jp)+ & + & (1.0_r8-vmask_wet(i,jp))*vmask_wet(i,jj)) +# endif +# endif + FE(i,j)=FE(i,j)+cff2*bed_frac(i,j,1,ised) + END DO + END DO +# endif +! +! Limit fluxes to prevent bottom from breaking thru water surface. +! + DO j=Jstr,Jend + DO i=Istr,Iend+1 +! +! Compute Total thickness available and change. +! + IF (FX(i,j).ge.0.0_r8) THEN + Dstp=z_w(i,j,1)-z_w(i,j,0) +! Dstp=z_w(i,j,N(ng))-z_w(i,j,0) + rhs_bed=FX(i,j)*pm(i,j)*pn(i,j) + bed_change=rhs_bed/(Srho(ised,ng)* & + & (1.0_r8-bed(i,j,1,iporo))) + ELSE + Dstp=z_w(i-1,j,1)-z_w(i-1,j,0) +! Dstp=z_w(i-1,j,N(ng))-z_w(i-1,j,0) + rhs_bed=ABS(FX(i,j))*pm(i-1,j)*pn(i-1,j) + bed_change=rhs_bed/(Srho(ised,ng)* & + & (1.0_r8-bed(i-1,j,1,iporo))) + END IF +! +! Limit that change to be less than available. +! +! cff=MAX(bed_change-0.75_r8*Dstp,0.0_r8) + cff=MAX(bed_change-1.00_r8*Dstp,0.0_r8) + cff1=cff/ABS(bed_change+eps) + FX(i,j)=FX(i,j)*(1.0_r8-cff1) + END DO + END DO + DO j=Jstr,Jend+1 + DO i=Istr,Iend +! +! Compute Total thickness available and change. +! + IF (FE(i,j).ge.0.0_r8) THEN + Dstp=z_w(i,j,1)-z_w(i,j,0) +! Dstp=z_w(i,j,N(ng))-z_w(i,j,0) + rhs_bed=FE(i,j)*pm(i,j)*pn(i,j) + bed_change=rhs_bed/(Srho(ised,ng)* & + & (1.0_r8-bed(i,j,1,iporo))) + ELSE + Dstp=z_w(i,j-1,1)-z_w(i,j-1,0) +! Dstp=z_w(i,j-1,N(ng))-z_w(i,j-1,0) + rhs_bed=ABS(FE(i,j))*pm(i,j-1)*pn(i,j-1) + bed_change=rhs_bed/(Srho(ised,ng)* & + & (1.0_r8-bed(i,j-1,1,iporo))) + END IF +! +! Limit that change to be less than available. +! +! cff=MAX(bed_change-0.75_r8*Dstp,0.0_r8) + cff=MAX(bed_change-1.00_r8*Dstp,0.0_r8) + cff1=cff/ABS(bed_change+eps) + FE(i,j)=FE(i,j)*(1.0_r8-cff1) + END DO + END DO +! +! Apply boundary conditions (gradient). +! + IF (.not.(CompositeGrid(isouth,ng).or.NSperiodic(ng))) THEN + IF (DOMAIN(ng)%Southern_Edge(tile)) THEN + DO i=Istr,IendR + FX(i,Jstr-1)=FX(i,Jstr) + END DO + END IF + END IF + IF (.not.(CompositeGrid(inorth,ng).or.NSperiodic(ng))) THEN + IF (DOMAIN(ng)%Northern_Edge(tile)) THEN + DO i=Istr,IendR + FX(i,Jend+1)=FX(i,Jend) + END DO + END IF + END IF + IF (.not.(CompositeGrid(iwest,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%Western_Edge(tile)) THEN + IF (LBC(iwest,isTvar(idsed(ised)),ng)%closed) THEN + DO j=JstrR,JendR + FX(Istr,j)=0.0_r8 + END DO + END IF + END IF + END IF + IF (.not.(CompositeGrid(ieast,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN + IF (LBC(ieast,isTvar(idsed(ised)),ng)%closed) THEN + DO j=JstrR,JendR + FX(Iend+1,j)=0.0_r8 + END DO + END IF + END IF + END IF +! + IF (.not.(CompositeGrid(iwest,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%Western_Edge(tile)) THEN + DO j=Jstr,JendR + FE(Istr-1,j)=FE(Istr,j) + END DO + END IF + END IF + IF (.not.(CompositeGrid(ieast,ng).or.EWperiodic(ng))) THEN + IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN + DO j=Jstr,JendR + FE(Iend+1,j)=FE(Iend,j) + END DO + END IF + END IF + IF (.not.(CompositeGrid(isouth,ng).or.NSperiodic(ng))) THEN + IF (DOMAIN(ng)%Southern_Edge(tile)) THEN + IF (LBC(isouth,isTvar(idsed(ised)),ng)%closed) THEN + DO i=IstrR,IendR + FE(i,Jstr)=0.0_r8 + END DO + END IF + END IF + END IF + IF (.not.(CompositeGrid(inorth,ng).or.NSperiodic(ng))) THEN + IF (DOMAIN(ng)%Northern_Edge(tile)) THEN + IF (LBC(inorth,isTvar(idsed(ised)),ng)%closed) THEN + DO i=IstrR,IendR + FE(i,Jend+1)=0.0_r8 + END DO + END IF + END IF + END IF +! +! Determine flux divergence and evaluate change in bed properties. +! + DO j=Jstr,Jend + DO i=Istr,Iend + cff=(FX(i+1,j)-FX(i,j)+ & + & FE(i,j+1)-FE(i,j))*pm(i,j)*pn(i,j) + bed_mass(i,j,1,nnew,ised)=MAX(bed_mass(i,j,1,nstp,ised)- & + & cff,0.0_r8) +# if !defined SUSPLOAD + DO k=2,Nbed + bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nstp,ised) + END DO +# endif + bed(i,j,1,ithck)=MAX(bed(i,j,1,ithck)- & + & cff/(Srho(ised,ng)* & + & (1.0_r8-bed(i,j,1,iporo))), & + & 0.0_r8) + END DO + END DO +! +!----------------------------------------------------------------------- +! Output bedload fluxes. +!----------------------------------------------------------------------- +! + cff=0.5_r8/dt(ng) + DO j=JstrR,JendR + DO i=Istr,IendR + bedldu(i,j,ised)=FX(i,j)*(pn(i-1,j)+pn(i,j))*cff + END DO + END DO + DO j=Jstr,JendR + DO i=IstrR,IendR + bedldv(i,j,ised)=FE(i,j)*(pm(i,j-1)+pm(i,j))*cff + END DO + END DO + END DO +! +! Need to update bed mass for the non-cohesive sediment types, becasue +! they did not partake in the bedload transport. +! + DO ised=1,NCS + DO j=Jstr,Jend + DO i=Istr,Iend + bed_mass(i,j,1,nnew,ised)=bed_mass(i,j,1,nstp,ised) +# if !defined SUSPLOAD + DO k=2,Nbed + bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nstp,ised) + END DO +# endif + END DO + END DO + END DO +! +! Update mean surface properties. +! Sd50 must be positive definite, due to BBL routines. +! Srho must be >1000, due to (s-1) in BBL routines. +! + DO j=Jstr,Jend + DO i=Istr,Iend + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,1,nnew,ised) + END DO + DO ised=1,NST + bed_frac(i,j,1,ised)=bed_mass(i,j,1,nnew,ised)/MAX(cff3,eps) + END DO +! + cff1=1.0_r8 + cff2=1.0_r8 + cff3=1.0_r8 + cff4=1.0_r8 + DO ised=1,NST + cff1=cff1*tau_ce(ised,ng)**bed_frac(i,j,1,ised) + cff2=cff2*Sd50(ised,ng)**bed_frac(i,j,1,ised) + cff3=cff3*(wsed(ised,ng)+eps)**bed_frac(i,j,1,ised) + cff4=cff4*Srho(ised,ng)**bed_frac(i,j,1,ised) + END DO + bottom(i,j,itauc)=cff1 + bottom(i,j,isd50)=MIN(cff2,Zob(ng)) + bottom(i,j,iwsed)=cff3 + bottom(i,j,idens)=MAX(cff4,1050.0_r8) + END DO + END DO +! +! Fill global arrays with local work array data. +! We cant use a global array outside of the tile. +! + DO j=Jstr,Jend + DO i=Istr,Iend + ursell_no(i,j)=ursell_nol(i,j) + RR_asymwave(i,j)=RR_asymwavel(i,j) + beta_asymwave(i,j)=beta_asymwavel(i,j) + ucrest_r(i,j)=ucrest_rl(i,j) + utrough_r(i,j)=utrough_rl(i,j) + T_crest(i,j)=T_crestl(i,j) + T_trough(i,j)=T_troughl(i,j) +# if defined BEDLOAD_VANDERA_DIRECT_UDELTA + bottom(i,j,idksd)=ksd_wbll(i,j) +# endif + bottom(i,j,idpwc)=phi_wcl(i,j) + bottom(i,j,idfdw)=fd_wbll(i,j) + END DO + END DO +! +!----------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions to property arrays. +!----------------------------------------------------------------------- +! + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & ursell_no) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & RR_asymwave) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & beta_asymwave) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & ucrest_r) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & utrough_r) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & T_crest) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & T_trough) +# if defined BEDLOAD_VANDERA_DIRECT_UDELTA + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & bottom(:,:,idksd)) +# endif + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & bottom(:,:,idpwc)) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & bottom(:,:,idfdw)) + DO ised=1,NST + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_frac(:,:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + CALL exchange_u2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & bedldu(:,:,ised)) + CALL exchange_v2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & bedldv(:,:,ised)) + END IF + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed_frac, & + & bed_mass(:,:,:,nnew,:)) + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + CALL mp_exchange3d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bedldu, bedldv) + END IF +# endif +! DO i=1,1 !dont do all MBEDP, we only changed ithck in this routine + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed(:,:,:,ithck)) +! END DO +# ifdef DISTRIBUTE + CALL mp_exchange3d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed(:,:,:,ithck)) +# endif +! CALL bc_r3d_tile (ng, tile, & +! & LBi, UBi, LBj, UBj, 1, MBOTP, & +! & bottom) +!# ifdef DISTRIBUTE +!# if defined BEDLOAD_VANDERA_DIRECT_UDELTA +! CALL mp_exchange2d (ng, tile, iNLM, 1, & +! & LBi, UBi, LBj, UBj, & +! & NghostPoints, & +! & EWperiodic(ng), NSperiodic(ng), & +! & bottom(:,:,idksd)) +!# endif +! CALL mp_exchange2d (ng, tile, iNLM, 2, & +! & LBi, UBi, LBj, UBj, & +! & NghostPoints, & +! & EWperiodic(ng), NSperiodic(ng), & +! & bottom(:,:,idpwc), & +! & bottom(:,:,idfdw)) +!# endif + + RETURN + END SUBROUTINE sed_bedload_vandera_tile +! +! Subroutines and functions required for Van der A formulation. +! + SUBROUTINE sandload_vandera( wavecycle, & + & Hs, Td, depth, RR, & + & d50, d50_mix, rhos, c_w, & + & eta, dsf, & + & T_i, T_iu, uhat_i, mag_theta_i, & + & om_ii, om_iy ) +! + USE mod_kinds + USE mod_scalars + USE mod_vandera_funcs +! + implicit none +! + real(r8), intent(in) :: wavecycle + real(r8), intent(in) :: Hs, Td, depth, RR + real(r8), intent(in) :: d50, d50_mix, rhos, c_w + real(r8), intent(in) :: eta, dsf + real(r8), intent(in) :: T_i, T_iu + real(r8), intent(in) :: uhat_i, mag_theta_i + real(r8), intent(out):: om_ii, om_iy +! +! local variables +! + real(r8), parameter :: m_fac=11.0_r8, n_fac=1.2_r8 + real(r8), parameter :: alpha_fac=8.2_r8 + real(r8), parameter :: xi=1.7_r8 ! Based on Santoss_core.m + real(r8), parameter :: eps=1.0E-14_r8 + real(r8) :: eps_eff + real(r8) :: om_i + real(r8) :: theta_diff, theta_ieff, theta_cr + real(r8) :: w_s + real(r8) :: ws_eta, ws_dsf + real(r8) :: w_sc_eta, w_sc_dsf + real(r8) :: cff, cff1_eta, cff1_dsf + real(r8) :: P +! +! Find settling velocity based on Soulsby (1997). +! VA2013 Use 0.8*d50 for settling velocity (text under equation 28). +! + w_s=w_s_calc(0.8_r8*d50, rhos) +! +! VA2013 Equation 29, for crest cycle +! + ws_eta=w_sc_calc(Hs, Td, depth, RR, w_s, eta) + ws_dsf=w_sc_calc(Hs, Td, depth, RR, w_s, dsf) + IF(wavecycle.eq.1.0_r8) THEN + w_sc_eta=MAX(w_s+ws_eta,0.0_r8) + w_sc_dsf=MAX(w_s+ws_dsf,0.0_r8) + ENDIF +! +! VA2013 Equation 30, for trough cycle +! + IF(wavecycle.eq.-1.0_r8) THEN +! w_sc_eta=(w_s-ws_eta) +! w_sc_dsf=(w_s-ws_dsf) + w_sc_eta=MAX(w_s-ws_eta,0.36*w_s) + w_sc_dsf=MAX(w_s-ws_dsf,0.36*w_s) +! w_sc_eta=MIN(w_s-ws_eta,0.0_r8) +! w_sc_dsf=MIN(w_s-ws_dsf,0.0_r8) + ENDIF +! +! VA2013 Equation 33, Phase lag parameter +! + cff=1.0_r8-(wavecycle*xi*uhat_i/c_w) +! + IF( (T_i-T_iu).eq.0.0_r8 ) THEN + cff1_eta=0.0_r8 + cff1_dsf=0.0_r8 + ELSE + cff1_eta=(1.0_r8/(2.0_r8*(T_i-T_iu)*w_sc_eta)) + cff1_dsf=(1.0_r8/(2.0_r8*(T_i-T_iu)*w_sc_dsf)) + ENDIF +! + IF(eta.gt.0.0_r8) THEN +! +! For ripple regime +! + P=alpha_fac*eta*cff*cff1_eta + ELSEIF(eta.eq.0.0_r8)THEN +! +! For sheet flow regime +! + P=alpha_fac*dsf*cff*cff1_dsf + ENDIF +! + eps_eff=(d50/d50_mix)**0.25_r8 +! +! CRS for multiple sed types +! +! eps_eff=1.0_r8 + theta_ieff=eps_eff*mag_theta_i +! +! Find critical Shields parameters based on Soulsby (1997). +! + theta_cr=theta_cr_calc(d50, rhos) +! +! Sand load entrained in the flow during each half-cycle +! + theta_diff=MAX((theta_ieff-theta_cr),0.0_r8) + om_i=m_fac*(theta_diff)**n_fac +! +! VA2013 Equation 23-26, Sandload entrained during half cycle + + IF(P.lt.eps) THEN + +! This is Taran's addition if there are no waves then phase lag=0.0 +! + om_ii=1.0_r8 + om_iy=0.0_r8 + ELSEIF(P.gt.eps.and.P.lt.1.0_r8) THEN + om_ii=om_i + om_iy=0.0_r8 + ELSE + om_ii=om_i/P + cff=1.0_r8/P + om_iy=om_i*(1.0_r8-cff) + ENDIF +! + RETURN + END SUBROUTINE sandload_vandera +! + SUBROUTINE full_wave_cycle_stress_factors( ng, d50, d90, osmgd, & + & Td, depth, & + & umag_curr, phi_curwave, & + & RR, uhat, ahat, & + & umax, umin, & + & mag_bstrc, & + & alphac, alphaw, & + & T_c, T_t, T_cu, T_tu, & + & ksd, & + & udelta, fd, & + & alpha, eta, ksw, tau_wRe ) +! +!********************************************************************** +! This subroutine returns the following: +! eta : ripple height +! udelta : current velocity at the wave boundary layer +! fd : current friction factor +! tau_wRe : Wave averaged Reynolds stress +! T_c, T_t, T_cu, T_tu: Updated time periods in half cycles +! based on current velocity +!********************************************************************** +! + USE mod_grid + USE mod_kinds + USE mod_scalars + USE mod_sediment + USE mod_sedbed + USE mod_vandera_funcs +! + implicit none +! +! Imported variable declarations. +! + integer, intent(in) :: ng +! +! Input the crest or trough half cycle velocity +! d50 -- grain size in meters +! Different for crest and trough half cycles +! + real(r8), intent(in) :: d50, d90, osmgd + real(r8), intent(in) :: Td, depth + real(r8), intent(in) :: umag_curr, phi_curwave + real(r8), intent(in) :: RR, uhat, ahat + real(r8), intent(in) :: umax, umin + real(r8), intent(in) :: mag_bstrc + real(r8), intent(in) :: alphac, alphaw + real(r8), intent(inout) :: T_c, T_t, T_cu, T_tu, fd, ksd + real(r8), intent(in) :: udelta + real(r8), intent(inout) :: alpha, eta, ksw, tau_wRe +! +! Local variables +! + integer :: iter + integer, parameter :: total_iters=15 + real(r8), parameter :: tol=0.001_r8, von_k=0.41_r8 + real(r8), parameter :: eps=1.0E-14_r8 + real(r8), parameter :: crs_fac=1.0_r8 + real(r8) :: theta_timeavg_old, theta_timeavg, theta_hat_i + real(r8) :: k_wn + real(r8) :: psi ! maximum mobility number + real(r8) :: rlen ! ripple length + real(r8) :: omega +! real(r8) :: ksd + real(r8) :: fw + real(r8) :: alpha_w, fwd, c_w + real(r8) :: ustarw +! +! Iterative solution to obtain current and wave related bed roughness +! VA2013 Apendix A, Shields parameter (Stress) depends on bed roughness +! Bed roughness computed from converged Shields parameter +! +! Maximum mobility number at crest and trough +! For irregular waves, use Rayleigh distributed maximum value +! VA, text under equation Appendix B.4 +! + psi=(1.27_r8*uhat)**2*osmgd +! +! Use Appendix B eqn B.1 and B.2 to get ripple height and length +! + CALL ripple_dim(psi, d50, eta, rlen) +! + eta=eta*ahat + rlen=rlen*ahat +! + omega=2.0_r8*pi/Td +! +! Initiliaze with theta_timeavg=0 and theta_hat_i=theta_timeavg +! + theta_timeavg=0.0_r8 + theta_timeavg_old=0.0_r8 + fd=0.0_r8 +! +# if defined BEDLOAD_VANDERA_MADSEN_UDELTA + fd=fd_calc_madsen(udelta, mag_bstrc) +# endif +! + DO iter=1,total_iters +! +! Calculate wave related bed roughness from VA2013 A.5 +! + ksw=ksw_calc(d50, mu_calc(d50), theta_timeavg, eta, rlen) +! +! Calculate full-cycle wave friction factor VA2013 Appendix Eqn. A.4 +! + fw=fw_calc(ahat, ksw) +! +# if defined BEDLOAD_VANDERA_DIRECT_UDELTA +! +! Calculate current-related bed roughness from VA2013 Appendix A.1 +! dont need ksd if fd is directly computed from mag_bustrc + ksd=ksd_calc(d50, d90, mu_calc(d50), theta_timeavg, eta, rlen) +! +! Calculate friction factor from ksd, udelta, delta +! + fd=fd_calc_santoss(udelta, sg_zwbl(ng), ksd) +! +# endif +! +! Calculate Time-averaged absolute Shields stress VA2013 Appendix Eq. A.3 +! +! theta_timeavg=osmgd*(0.5_r8*fd*udelta**2.0_r8+ & +! & 0.25_r8*fw*uhat**2.0_r8) + theta_timeavg=osmgd*(0.5_r8*fd*alphac*udelta**2.0_r8+ & + & 0.25_r8*fw*alphaw*uhat**2.0_r8) +! + IF(ABS(theta_timeavg-theta_timeavg_old).lt.tol) THEN + EXIT + ENDIF + theta_timeavg_old=theta_timeavg + END DO +! +! Calculate full-cycle current friction factor from VA2013 Eqn. 20 +! use the stress from COAWST and corresponding current velocity +! + alpha=udelta/(udelta+uhat+eps) +! fwd=alpha*fd+(1.0-alpha)*fw + fwd=alpha*fd*alphac+(1.0-alpha)*fw*alphaw +! + k_wn=kh(Td,depth)/depth ! Wave number + c_w=2.0_r8*pi/(k_wn*Td) ! Wave speed + alpha_w=0.424_r8 +! +# ifdef BEDLOAD_VANDERA_WAVE_AVGD_STRESS + tau_wRe=MAX((rho0*fwd*alpha_w*uhat**3.0_r8/(2.0_r8*c_w)),eps) +# else + tau_wRe=0.0_r8 +# endif +! +! Compute the change in time period based on converged udelta +! (current velocity at wave boundary layer) +! + CALL current_timeperiod(udelta, phi_curwave, umax, umin, RR, & + & T_c, T_t, Td) +! +# ifdef BEDLOAD_VANDERA_SURFACE_WAVE +! +! Calculate the effect of surface waves +! + CALL surface_wave_mod(Td, depth, uhat, T_c, T_cu, T_t, T_tu) +# endif +! + END SUBROUTINE full_wave_cycle_stress_factors +! + SUBROUTINE half_wave_cycle_stress_factors( T_iu, T_i, ahat, ksw, & + & fd, alpha, & + & alphac, alphaw, & + & d50, osmgd, & + & ui_r, uhat_i, udelta, phi_curwave,& + & tau_wRe, & + & dsf, theta_ix, theta_iy, mag_theta_i ) +! +!********************************************************************** +! This subroutine returns the following: +! dsf : sheetflow thickness +! theta_ix, theta_iy : Shields parameter in x and y dir. +! mag_theta_i : Magnitude of Shields parameter for half cycle +!********************************************************************** +! + USE mod_kinds + USE mod_scalars + USE mod_vandera_funcs +! + implicit none +! +! Input the crest or trough half cycle velocity +! d50 -- grain size in meters +! Different for crest and trough half cycles +! + real(r8), intent(in) :: T_iu, T_i, ahat, ksw + real(r8), intent(in) :: fd, alpha + real(r8), intent(in) :: alphac, alphaw + real(r8), intent(in) :: d50, osmgd + real(r8), intent(in) :: ui_r, uhat_i, udelta, phi_curwave + real(r8), intent(in) :: tau_wRe + real(r8), intent(inout) :: dsf, theta_ix, theta_iy, mag_theta_i +! +! Local variables +! + real(r8), parameter :: eps = 1.0E-14_r8 + real(r8) :: fw_i, fwd_i + real(r8) :: alpha_w, fwd, k, c_w + real(r8) :: theta_hat_i + real(r8) :: ui_rx, ui_ry, mag_ui +! +! Wave friction factor for wave and crest half cycle VA2013 Eqn. 21 +! + fw_i=fwi_calc(T_iu, T_i, ahat, ksw) +! +! Wave current friction factor (Madsen and Grant) VA2013 Eqn. 18 +! Different for crest and trough +! +! fwd_i=alpha*fd+(1.0_r8-alpha)*fw_i + fwd_i=alpha*fd*alphac+(1.0_r8-alpha)*fw_i*alphaw +! +! VA2013-Magnitude of Shields parameter Eqn. 17 +! + theta_hat_i=0.5_r8*fwd_i*uhat_i**2*osmgd +! +! Sheet flow thickness VA2013 Appendix C C.1 +! Update from initial value +! + dsf=dsf_calc(d50, theta_hat_i) !this dsf is in m +! +! Calculated the velocity magnitude based on representative velocities +! equation 12 from Van der A, 2013 +! +!----------------------------------------------------------------------- +! Get the representative trough half cycle water particle velocity +! as well as full cycle orbital velocity and excursion +!----------------------------------------------------------------------- +! + ui_rx=udelta*COS(phi_curwave)*alphac+ui_r*alphaw + ui_ry=udelta*SIN(phi_curwave)*alphac +! +! mag_ui is set to a min value to avoid non-zero division +! + mag_ui=MAX( SQRT(ui_rx*ui_rx+ui_ry*ui_ry), eps ) +! +! VA2013-Magnitude of Shields parameter Eqn. 17 +! + mag_theta_i=MAX(0.5_r8*fwd_i*osmgd*(mag_ui**2), 0.0_r8) +! +!----------------------------------------------------------------------- +! Shields parameter in crest cycle +! rho0 is required for non-dimensionalizing +!----------------------------------------------------------------------- +! + theta_ix=ABS(mag_theta_i)*ui_rx/(mag_ui)+tau_wRe*osmgd/rho0 + theta_iy=ABS(mag_theta_i)*ui_ry/(mag_ui) +! +! mag_theta_i is set to a min value to avoid non-zero division +! + mag_theta_i=MAX( sqrt(theta_ix*theta_ix+theta_iy*theta_iy),eps ) +! +! + END SUBROUTINE half_wave_cycle_stress_factors +! + SUBROUTINE current_timeperiod(unet, phi_curwave, umax, umin, & + & RR, T_c, T_t, Td) +! +!********************************************************************** +! This subroutine returns the following: +! T_c, T_t : Time period in crest and trough cycle +!********************************************************************** +! +! Modify the crest and trough time periods based on current velocity +! This function was developed by Chris Sherwood and Tarandeep Kalra +! +! The basis for these formulations are formed from Appendix A.3 +! in SANTOSS report. +! Report number: SANTOSS_UT_IR3 Date: January 2010 +! + USE mod_kinds + USE mod_scalars +! + implicit none +! + real(r8), intent(in) :: unet, phi_curwave + real(r8), intent(in) :: umax, umin + real(r8), intent(in) :: RR, Td + real(r8), intent(inout) :: T_c, T_t +! +! Local variables +! + real(r8) :: unet_xdir, udelta, delt +! + unet_xdir=unet*cos(phi_curwave) + + IF(RR.eq.0.5_r8) THEN + T_c=0.5_r8*Td + T_t=0.5_r8*Td + IF(unet_xdir.ge.umax) THEN + T_c=Td + T_t=0.0_r8 + ELSEIF(unet_xdir.le.umin) THEN + T_c=0.0_r8 + T_t=Td + ELSEIF(unet_xdir.lt.0.0_r8.and.unet_xdir.gt.umin) THEN + delt=ASIN(-unet/umin)/pi + T_t=T_t*(1.0_r8-2.0_r8*delt) + T_c=Td-T_t + ELSEIF(unet_xdir.gt.0.0_r8.and.unet_xdir.lt.umax) THEN + delt=ASIN(unet_xdir/(-umax))/pi + T_c=T_c*(1.0_r8-2.0_r8*delt) + T_t=Td-T_c + ELSEIF(unet_xdir.eq.0.0_r8) THEN + T_c=T_c + T_t=T_t + ENDIF + ELSEIF(RR.gt.0.5_r8) THEN + T_c=T_c + T_t=T_t + IF(unet_xdir.ge.umax) THEN + T_c=Td + T_t=0.0_r8 + ELSEIF(unet_xdir<=umin) THEN + T_c=0.0_r8 + T_t=Td + ELSEIF(unet_xdir.lt.0.0_r8.and.unet_xdir.gt.umin) THEN + delt=ASIN(-unet_xdir/umin)/pi + T_t=T_t*(1.0_r8-2.0_r8*delt) + T_c=Td-T_t + ELSEIF(unet_xdir.gt.0.0_r8.and.unet_xdir.lt.umax) THEN + delt=ASIN(unet_xdir/(-umax))/pi + T_c=T_c*(1.0_r8-2.0_r8*delt) + T_t=Td-T_c + ELSEIF(unet_xdir.eq.0.0_r8) THEN + T_c=T_c + T_t=T_t + ENDIF + ENDIF + T_c=MAX(T_c,0.0_r8) + T_t=MAX(T_t,0.0_r8) +! + END SUBROUTINE current_timeperiod +! + SUBROUTINE surface_wave_mod(Td, depth, uhat, & + & T_c, T_cu, T_t, T_tu) +! +!********************************************************************** +! This subroutine returns the following: +! T_c, T_cu, T_t, T_tu : Change in time period in crest and +! trough cycle due to particle displacement +! under surface waves. +!********************************************************************** +! +! Crest period extension for horizontal particle displacement. +! Tuning factor eps_eff = 0.55 from measurements GWK Schretlen 2010 +! Equations in Appendix B of SANTOSS Report +! Report number: SANTOSS_UT_IR3 Date: January 2010 +! + USE mod_kinds + USE mod_scalars + USE mod_vandera_funcs +! + implicit none +! + real(r8), intent(in) :: Td, depth, uhat + real(r8), intent(inout) :: T_c, T_cu, T_t, T_tu +! +! Local variables +! + real(r8), parameter :: eps = 1.0E-14_r8 + real(r8) :: k_wn, eps_eff, c + real(r8) :: delta_Tc, delta_Tt + real(r8) :: T_c_new, T_cu_new + real(r8) :: T_t_new, T_tu_new +! + k_wn=kh(Td,depth)/depth + c=2.0_r8*pi/(k_wn*Td) +! + eps_eff=0.55_r8 +! + delta_Tc=eps_eff*uhat/(c*pi-eps_eff*2.0*uhat) + T_c_new=T_c+delta_Tc +! +! Avoid non zero values for time periods +! + T_c_new=MAX( T_c_new, 0.0_r8) + T_cu_new=MAX( T_cu*T_c_new/(T_c+eps), 0.0_r8 ) +! + delta_Tt=eps_eff*uhat/(c*pi+eps_eff*2.0*uhat) + T_t_new=T_t-delta_Tt + T_t_new=MAX( T_t_new, 0.0_r8) + T_tu_new=MAX( T_tu*T_t_new/(T_t+eps), 0.0_r8 ) +! + T_c=T_c_new + T_cu=T_cu_new + T_t=T_t_new + T_tu=T_tu_new +! + END SUBROUTINE surface_wave_mod +! + SUBROUTINE ripple_dim(psi, d50, eta, rlen) +! +!********************************************************************** +! This subroutine returns the following: +! eta, rlen : Ripple dimensions: (height and length) +!********************************************************************** +! +! Calculate ripple dimensions of O'Donoghue et al. 2006 +! based on VA2013 Appendix B +! + USE mod_kinds + USE mod_scalars + + implicit none +! + real(r8), intent(in) :: psi, d50 + real(r8), intent(out) :: eta, rlen +! + real(r8) :: d50_mm + real(r8) :: m_eta, m_lambda, n_eta, n_lambda + real(r8), parameter :: eps=1.0E-14_r8 +! + d50_mm=0.001_r8*d50 + IF(d50_mm.lt.0.22_r8) THEN + m_eta=0.55_r8 + m_lambda=0.73_r8 + ELSEIF(d50_mm.ge.0.22_r8.and.d50_mm.lt.0.30_r8) THEN + m_eta=0.55_r8+(0.45_r8*(d50_mm-0.22_r8)/(0.30_r8-0.22_r8)) + m_lambda=0.73_r8+(0.27_r8*(d50_mm-0.22_r8)/(0.30_r8-0.22_r8)) + ELSE + m_eta=1.0_r8 + m_lambda=1.0_r8 + ENDIF +! +! Smooth transition between ripple regime and bed sheet flow regime +! + IF(psi.le.190.0_r8) THEN + n_eta=1.0_r8 + ELSEIF(psi.gt.190.0_r8.and.psi.lt.240.0_r8) THEN + n_eta=0.5_r8*(1.0_r8+cos(pi*(psi-190.0_r8)/(50.0_r8))) + ELSEIF(psi.ge.240.0_r8) THEN + n_eta=0.0_r8 + ENDIF + n_lambda=n_eta +! + eta=MAX(0.0_r8,m_eta*n_eta*(0.275_r8-0.022*psi**0.42_r8)) +! rlen=MAX(0.0_r8,m_lambda*n_lambda* & +! & (1.97_r8-0.44_r8*psi**0.21_r8)) + rlen=MAX(eps,m_lambda*n_lambda* & + & (1.97_r8-0.44_r8*psi**0.21_r8)) +! + RETURN + END SUBROUTINE ripple_dim +! + SUBROUTINE skewness_params( H_s, T, depth, r, phi, Ur ) +! +! Ruessink et al. provides equations for calculating skewness parameters +! Uses Malarkey and Davies equations to get "bb" and "r" +! Given input of H_s, T and depth +! r - skewness/asymmetry parameter r=2b/(1+b^2) [value] +! phi - skewness/asymmetry parameter [value] +! Su - umax/(umax-umin) [value] +! Au - amax/(amax-amin) [value] +! alpha - tmax/pi [value] +! + USE mod_kinds + USE mod_scalars + USE mod_vandera_funcs +! + implicit none +! + real(r8), intent(in) :: H_s, T, depth + real(r8), intent(inout) :: Ur + real(r8), intent(out) :: r, phi +! +! Local variables +! + real(r8), parameter :: p1=0.0_r8 + real(r8), parameter :: p2=0.857_r8 + real(r8), parameter :: p3=-0.471_r8 + real(r8), parameter :: p4=0.297_r8 + real(r8), parameter :: p5=0.815_r8 + real(r8), parameter :: p6=0.672_r8 + real(r8), parameter :: eps=1.0E-14_r8 + real(r8) :: a_w + real(r8) :: B, psi, bb + real(r8) :: k_wn, cff +! real(r8) :: kh_calc + real(r8) :: Su, Au +! +! Ruessink et al., 2012, Coastal Engineering 65:56-63. +! +! k is the local wave number computed with linear wave theory. +! + k_wn=kh(T,depth)/depth +! + a_w=0.5_r8*H_s + Ur=0.75_r8*a_w*k_wn/((k_wn*depth)**3.0_r8)+eps +! +! Ruessink et al., 2012 Equation 9. +! + cff=EXP((p3-log10(Ur))/p4) + B=p1+((p2-p1)/(1.0_r8+cff)) +! + psi=-90.0_r8*deg2rad*(1.0_r8-TANH(p5/Ur**p6)) +! +# ifdef BEDLOAD_VANDERA_ASYM_LIMITS + B=MIN(B,0.8554_r8) ! according to fig.2, max values w.r.t Ur=24 + psi=MAX(psi,-1.4233_r8) +# endif +! +! Markaley and Davies, equation provides bb which is "b" in paper +! Check from where CRS found these equations +! + bb=sqrt(2.0_r8)*B/(sqrt(2.0_r8*B**2.0_r8+9.0_r8)) + r=2.0_r8*bb/(bb**2.0_r8+1.0_r8) +! +! Ruessink et al., 2012 under Equation 12. +! + phi=-psi-0.5_r8*pi +! +! Where are these asymmetry Su, Au utilized +! recreate the asymetry +! + Su=B*cos(psi) + Au=B*sin(psi) +! + RETURN + END SUBROUTINE skewness_params + + SUBROUTINE abreu_points( r, phi, Uw, T, T_c, T_t, & + & T_cu, T_tu, umax, umin, RR, beta ) +! +! Calculate umax, umin, and phases of asymmetrical wave orbital velocity +! +! Use the asymmetry parameters from Ruessink et al, 2012 +! to get the umax, umin and phases of asymettrical wave +! orbital velocity to be used by Van Der A. +! T_c is duration of crest +! T_cu Duration of accerating flow within crest half cycle +! + USE mod_kinds + USE mod_scalars +! + implicit none +! + real(r8), intent(in) :: r, phi, Uw, T + real(r8), intent(out) :: T_c, T_t, T_cu, T_tu + real(r8), intent(out) :: umax, umin, RR, beta +! +! Local variables +! + real(r8) :: b, c, ratio, tmt, tmc, tzd, tzu + real(r8) :: omega, w, phi_new + real(r8) :: P, F0, betar_0 +! real(r8) :: T_tu, T_cu, T_c, T_t + real(r8) :: cff1, cff2, cff + real(r8) :: Sk, Ak +! + omega=2.0_r8*pi/T +! + phi_new=-phi + +! Malarkey and Davies (Under equation 16b) + P=SQRT(1.0_r8-r*r) +! +! Malarkey and Davies (Under equation 16b) +! + b=r/(1.0_r8+P) +! +! Appendix E of Malarkey and Davies +! + c=b*SIN(phi_new) +! + cff1=4.0_r8*c*(b*b-c*c)+(1.0_r8-b*b)*(1.0_r8+b*b-2.0_r8*c*c) + cff2=(1.0_r8+b*b)**2.0_r8-4.0_r8*c*c + ratio=cff1/cff2 +! +! These if conditionals prevent ASIN to be between [-1,1] and prevent NaNs +! Not a problem in the MATLAB code +! + IF(ratio.gt.1.0_r8)THEN + ratio=1.0_r8 + ENDIF + IF(ratio.lt.-1.0_r8)THEN + ratio=-1.0_r8 + ENDIF + tmc=ASIN(ratio) +! +! + cff1=4.0_r8*c*(b*b-c*c)-(1.0_r8-b*b)*(1.0_r8+b*b-2.0_r8*c*c) + cff2=(1.0_r8+b*b)**2.0_r8-4.0_r8*c*c + ratio=cff1/cff2 + IF(ratio.gt.1.0_r8)THEN + ratio=1.0_r8 + ENDIF + IF(ratio.lt.-1.0_r8)THEN + ratio=-1.0_r8 + ENDIF + tmt=ASIN(ratio) +! + IF(tmc.lt.0.0_r8) THEN + tmc=tmc+2.0_r8*pi + ENDIF + IF(tmt.lt.0.0_r8) THEN + tmt=tmt+2.0_r8*pi + ENDIF +! +! Non dimensional umax and umin, under E5 in Malarkey and Davies +! + umax=1.0_r8+c + umin=umax-2.0_r8 +! +! Dimensionalize +! + umax=umax*Uw + umin=umin*Uw +! +! phase of zero upcrossing and downcrossing (radians) +! + tzu=ASIN(b*SIN(phi_new)) + tzd=2.0_r8*ACOS(c)+tzu +! +! MD, equation 17 +! + RR=0.5_r8*(1.0_r8+b*SIN(phi_new)) +! +! MD, under equation 18 +! + IF(r.le.0.5_r8) THEN + F0=1.0_r8-0.27_r8*(2.0_r8*r)**(2.1_r8) + ELSE + F0=0.59_r8+0.14_r8*(2.0_r8*r)**(-6.2_r8) + ENDIF +! +! MD, Equation 15a,b +! + IF(r.ge.0.0_r8.and.r.lt.0.5)THEN + betar_0=0.5_r8*(1.0_r8+r) + ELSEIF(r.gt.0.5_r8.and.r.lt.1.0_r8)THEN + cff1=4.0_r8*r*(1.0_r8+r) + cff2=cff1+1.0_r8 + betar_0=cff1/cff2 + ENDIF +! +! MD, Equation 18 +! + cff=SIN((0.5_r8*pi-ABS(phi_new))*F0)/SIN(0.5_r8*pi*F0) + beta=0.5_r8+(betar_0-0.5_r8)*cff +! +! MD, Table 1, get asymmetry parameterization +! using GSSO (10a,b) +! + cff=SQRT(2.0_r8*(1.0_r8+b*b)**3.0_r8) + Sk=3.0_r8*SIN(phi_new)/cff + Ak=-3.0_r8*COS(phi_new)/cff +! +! These are the dimensional fractions of wave periods needed by Van der A eqn. +! + w=1.0_r8/omega + T_c=(tzd-tzu)*w + T_t=T-T_c + T_cu=(tmc-tzu)*w + T_tu=(tmt-tzd)*w +! + RETURN + END SUBROUTINE abreu_points +! +#endif + END MODULE sed_bedload_vandera_mod + + + diff --git a/ROMS/Nonlinear/Sediment/sed_biodiff.F b/ROMS/Nonlinear/Sediment/sed_biodiff.F new file mode 100644 index 00000000..c16d2c7b --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sed_biodiff.F @@ -0,0 +1,410 @@ +#include "cppdefs.h" + + MODULE sed_biodiff_mod + +#if defined NONLINEAR && defined SEDIMENT && defined SED_BIODIFF +! +!git $Id$ +!==================================================== C. R. Sherwood === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Hernan G. Arango ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! This routine computes sediment bed layer mixing (biodiffusion) ! +! ! +! ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: sed_biodiff + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sed_biodiff (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_sedbed + USE mod_stepping +# ifdef BBL_MODEL + USE mod_bbl +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL sed_biodiff_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & +# ifdef WET_DRY + & GRID(ng) % rmask_wet, & +# endif + & OCEAN(ng) % t, & +# if defined SED_MORPH + & SEDBED(ng) % bed_thick, & +# endif + & SEDBED(ng) % bed, & + & SEDBED(ng) % bed_frac, & + & SEDBED(ng) % bed_mass, & + & SEDBED(ng) % bottom) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE sed_biodiff +! +!*********************************************************************** + SUBROUTINE sed_biodiff_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & +# ifdef WET_DRY + & rmask_wet, & +# endif + & t, & +# if defined SED_MORPH + & bed_thick, & +# endif + & bed, bed_frac, bed_mass, & + & bottom) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment +! + USE bc_3d_mod, ONLY : bc_r3d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:,LBj:) +# endif +# if defined SED_MORPH + real(r8), intent(inout):: bed_thick(LBi:,LBj:,:) +# endif + real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bottom(LBi:,LBj:,:) +# else +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj) +# endif +# if defined SED_MORPH + real(r8), intent(inout):: bed_thick(LBi:UBi,LBj:UBj,3) +# endif + real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng)) + real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) + real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) + real(r8), intent(inout) :: bottom(LBi:UBi,LBj:UBj,MBOTP) +# endif +! +! Local variable declarations. +! + integer :: i, j, k, ised + real(r8), parameter :: eps = 1.0E-14_r8 + real(r8), parameter :: cmy2ms = 3.1688765E-12_r8 ! multiply cm2/yr by this to get m2/s + + real(r8) :: cff, cff1, cff2, cff3 + + real(r8), dimension(IminS:ImaxS,NST) :: dep_mass + + integer :: iu,il,lp,ii +! real(r8) :: rtemp, Dbmx, Dbmm, zs, zm, zp + real(r8) :: rtemp + real(r8), dimension(Nbed) :: zb + real(r8), dimension(Nbed) :: zc + real(r8), dimension(Nbed) :: dzui + real(r8), dimension(Nbed) :: dzli + real(r8), dimension(Nbed) :: dzmi + real(r8), dimension(Nbed) :: Db + real(r8), dimension(Nbed) :: Dc + real(r8), dimension(Nbed) :: a + real(r8), dimension(Nbed) :: d + real(r8), dimension(Nbed) :: b + real(r8), dimension(Nbed) :: cc + real(r8), dimension(Nbed) :: dd + + +# include "set_bounds.h" + +! +!----------------------------------------------------------------------- +! Compute sediment bed layer stratigraphy. +!----------------------------------------------------------------------- +! +! print *, 'Mixing...' + J_LOOP : DO j=Jstr,Jend + I_LOOP : DO i=Istr,Iend +! +! Set mixing coefficient profile +! (hardwire uniform mixing) +! +! DO k=1,Nbed +! Db(k)=1.0E-8_r8 +! ENDDO + + IF (Nbed.GT.2) THEN +! Compute cumulative depth + zb(1)=bed(i,j,1,ithck) + DO k=2,Nbed + zb(k)=zb(k-1)+bed(i,j,k,ithck) + END DO +! Compute depths of bed centers + zc(1)=0.5_r8*(bed(i,j,1,ithck)) + DO k=2,Nbed + zc(k)=zb(k-1)+0.5_r8*bed(i,j,k,ithck) + END DO +! +! Set biodiffusivity profile +# if defined DB_PROFILE +! Depth-varying biodiffusivity profile +! +!ALF Dbmx = bottom(i,j,idbmx) +!ALF Dbmm = bottom(i,j,idbmm) +!ALF zs = bottom(i,j,idbzs) +!ALF zm = bottom(i,j,idbzm) +!ALF zp = bottom(i,j,idbzp) + DO k=1,Nbed + Db(k)= Dbmx(ng) +! IF( zb(k).GT.Dbzp(ng))THEN ! should be .GE. ? + IF( zb(k).GE.Dbzp(ng))THEN + Db(k)=0.0_r8 + ELSE + IF((zb(k) .GT. Dbzs(ng)).AND. & + & (zb(k) .LE. Dbzm(ng))) THEN + rtemp= LOG(Dbmm(ng)/Dbmx(ng))/(-Dbzm(ng)-Dbzs(ng)) + Db(k)=Dbmx(ng)*exp(rtemp*(-zb(k)-Dbzs(ng))) + ELSEIF((zb(k).GT.Dbzm(ng)).AND. & + & (zb(k).LT.Dbzp(ng)) ) THEN + Db(k)=(Dbmm(ng)-(Dbmm(ng)/(Dbzp(ng)-Dbzm(ng))))* & + & (zb(k)-Dbzm(ng)) + ENDIF + ENDIF + END DO +# else +! Uniform biodiffusivity profile at max value +! + DO k=1,Nbed + Db(k)=Dbmx(ng) +! Db(k)=bottom(i,j,idbmx) + ENDDO +# endif /* defined DB_PROFILE */ +! write(*,*) 'Db',Db +! Calculate finite differences + dzui(1)=1.0_r8/(zc(2)-zc(1)) + dzli(1)=1.E35_r8 ! should not be needed + dzmi(1)=1.0_r8/bed(i,j,1,ithck) + DO k=2,Nbed-1 + dzui(k)=1.0_r8/(zc(k+1)-zc(k)) + dzli(k)=1.0_r8/(zc(k)-zc(k-1)) + !dzmi(k)=1.0_r8/(zb(k+1)-zb(k)) + ! equivalent: + dzmi(k)=1.0/bed(i,j,k,ithck) +! Tridiagonal terms + b(k)= -dt(ng)*dzmi(k)*Db(k-1)*dzli(k) + d(k)=1.0_r8+dt(ng)*dzmi(k)* & + & ( Db(k-1)*dzli(k)+Db(k)*dzui(k) ) + a(k)= -dt(ng)*dzmi(k)*Db(k)*dzui(k) + ENDDO + dzui(Nbed)=1.0E35_r8 ! should not be needed + dzli(Nbed)=1.0_r8/(zc(Nbed)-zc(Nbed-1)) + dzmi(Nbed)=1.0_r8/bed(i,j,Nbed,ithck) +! No-flux boundary conditions + b(1) = 999.9_r8 ! should not be needed + d(1)= 1.0_r8 +dt(ng)*dzmi(1)*Db(1)*dzui(1) + a(1)= -dt(ng)*dzmi(1)*Db(1)*dzui(1) + b(Nbed)= -dt(ng)*dzmi(Nbed)*Db(Nbed-1)*dzli(Nbed) + d(Nbed)=1.0_r8+dt(ng)*dzmi(Nbed)*Db(Nbed-1)*dzli(Nbed) + a(Nbed)=999.9_r8 ! should not be needed +! +! Calculate mixing for each size fraction + DO ised=1,NST +! ...make working copies + DO k=1,Nbed + cc(k) = bed_frac(i,j,k,ised) + dd(k)= d(k) + ENDDO +! Solve a tridiagonal system of equations using Thomas' algorithm +! Anderson, Tannehill, and Pletcher (1984) pp. 549-550 +! ...establish upper triangular matrix + il = 1 + iu = Nbed + lp = il+1 + DO k = lp,iu + rtemp = b(k)/dd(k-1) + dd(k)= dd(k)-rtemp*a(k-1); + cc(k)= cc(k)-rtemp*cc(k-1); + ENDDO +! ...back substitution + cc(iu) = cc(iu)/dd(iu) + DO k = lp,iu + ii = iu-k+il; + cc(ii) = (cc(ii)-a(ii)*cc(ii+1))/dd(ii); + ENDDO +! ...solution stored in cc; copy out + DO k = 1,Nbed + bed_frac(i,j,k,ised)=cc(k) + ENDDO + ENDDO +! TODO - Mix porosity or assign it as f(depth)? +! TODO - Mix age? +# if defined SEDBIO_COUP && defined OXYGEN && defined ODU +! +! Calculate mixing for each porewater constituent + DO ised=iboxy,ibodu +! +! Set new biodiffusivity profile +! Assume uniform biodiffusivity profile +! + DO k=1,Nbed + Db(k)=Dbmx(ng) + IF (ised.eq.iboxy) Db(k)=11.99d-10 + IF (ised.eq.ibno3) Db(k)=9.80d-10 + IF (ised.eq.ibnh4) Db(k)=4.36d-10 + IF (ised.eq.ibodu) Db(k)=4.01d-10 + ENDDO +! Calculate finite differences + dzui(1)=1.0_r8/(zc(2)-zc(1)) + dzli(1)=1.E35_r8 ! should not be needed + dzmi(1)=1.0_r8/bed(i,j,1,ithck) + DO k=2,Nbed-1 + dzui(k)=1.0_r8/(zc(k+1)-zc(k)) + dzli(k)=1.0_r8/(zc(k)-zc(k-1)) + !dzmi(k)=1.0_r8/(zb(k+1)-zb(k)) + ! equivalent: + dzmi(k)=1.0/bed(i,j,k,ithck) +! Tridiagonal terms + b(k)= -dt(ng)*dzmi(k)*Db(k-1)*dzli(k) + d(k)=1.0_r8+dt(ng)*dzmi(k)* & + & ( Db(k-1)*dzli(k)+Db(k)*dzui(k) ) + a(k)= -dt(ng)*dzmi(k)*Db(k)*dzui(k) + ENDDO + dzui(Nbed)=1.0E35_r8 ! should not be needed + dzli(Nbed)=1.0_r8/(zc(Nbed)-zc(Nbed-1)) + dzmi(Nbed)=1.0_r8/bed(i,j,Nbed,ithck) +! No-flux boundary conditions + b(1) = 999.9_r8 ! should not be needed + d(1)= 1.0_r8 +dt(ng)*dzmi(1)*Db(1)*dzui(1) + a(1)= -dt(ng)*dzmi(1)*Db(1)*dzui(1) + b(Nbed)= -dt(ng)*dzmi(Nbed)*Db(Nbed-1)*dzli(Nbed) + d(Nbed)=1.0_r8+dt(ng)*dzmi(Nbed)*Db(Nbed-1)*dzli(Nbed) + a(Nbed)=999.9_r8 ! should not be needed +! +! ...make working copies + DO k=1,Nbed + cc(k) = bed(i,j,k,ised)/bed(i,j,k,ithck)/ & + & bed(i,j,k,iporo) + dd(k)= d(k) + ENDDO +! Solve a tridiagonal system of equations using Thomas' algorithm +! Anderson, Tannehill, and Pletcher (1984) pp. 549-550 +! ...establish upper triangular matrix + il = 1 + iu = Nbed + lp = il+1 + DO k = lp,iu + rtemp = b(k)/dd(k-1) + dd(k)= dd(k)-rtemp*a(k-1); + cc(k)= cc(k)-rtemp*cc(k-1); + ENDDO +! ...back substitution + cc(iu) = cc(iu)/dd(iu) + DO k = lp,iu + ii = iu-k+il; + cc(ii) = (cc(ii)-a(ii)*cc(ii+1))/dd(ii); + ENDDO +! ...solution stored in cc; copy out + DO k = 1,Nbed + bed(i,j,k,ised)=cc(k)*bed(i,j,k,ithck)*bed(i,j,k,iporo) + ENDDO + ENDDO + +# endif +! Recompute bed masses + DO k=1,Nbed +! debugging: ensure fracs add up to 1 + cff3 = 0.0_r8 + DO ised=1,NST + cff3 = cff3+bed_frac(i,j,k,ised) + ENDDO + if( abs(1.0_r8-cff3).GT.1e-6 ) & + & write(*,*) 'error: sum_frac: ',cff3 + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,k,nnew,ised) + ENDDO + DO ised=1,NST + bed_mass(i,j,k,nnew,ised)=bed_frac(i,j,k,ised)*cff3 + ENDDO + ENDDO + + + END IF !NBED.GT.2 + END DO I_LOOP + END DO J_LOOP +! +!----------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions to property arrays. +!----------------------------------------------------------------------- +! + DO ised=1,NST + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_frac(:,:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, EWperiodic(ng), NSperiodic(ng), & + & bed_frac, & + & bed_mass(:,:,:,nnew,:)) +# endif + + DO i=1,MBEDP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed(:,:,:,i)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, MBEDP, & + & NghostPoints, EWperiodic(ng), NSperiodic(ng), & + & bed) +# endif + + RETURN + END SUBROUTINE sed_biodiff_tile +#endif + END MODULE sed_biodiff_mod diff --git a/ROMS/Nonlinear/Sediment/sed_flocs.F b/ROMS/Nonlinear/Sediment/sed_flocs.F new file mode 100644 index 00000000..5396c1f6 --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sed_flocs.F @@ -0,0 +1,980 @@ +#include "cppdefs.h" + + MODULE sed_flocs_mod + +#if defined NONLINEAR && defined SEDIMENT && defined SUSPLOAD && defined SED_FLOCS +! +!git $Id$ +!======================================================================= +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.txt Alexander F. Shchepetkin ! +!==================================================== John C. Warner === +! ! +! This routine computes floc transformation. ! +! ! +! References: ! +! ! +! Verney, R., Lafite, R., Claude Brun-Cottan, J., & Le Hir, P. (2011).! +! Behaviour of a floc population during a tidal cycle: laboratory ! +! experiments and numerical modelling. Continental Shelf Research, ! +! 31(10), S64-S83. ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: sed_flocmod + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sed_flocmod (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_mixing + USE mod_ocean + USE mod_stepping + USE mod_bbl + USE mod_sedflocs +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL sed_flocmod_tile (ng, tile, & + & LBi, UBi, LBj, UBj, N(ng), NT(ng), & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & + & GRID(ng) % z_r, & + & GRID(ng) % z_w, & + & GRID(ng) % Hz, & +# ifdef BBL_MODEL + & BBL(ng) % bustrcwmax, & + & BBL(ng) % bvstrcwmax, & + & FORCES(ng) % Pwave_bot, & +# endif + & FORCES(ng) % bustr, & + & FORCES(ng) % bvstr, & + & MIXING(ng) % Akt, & + & MIXING(ng) % Akv, & + & MIXING(ng) % Lscale, & + & MIXING(ng) % gls, & + & MIXING(ng) % tke, & + & OCEAN(ng) % t, & + & SEDFLOCS(ng) % f_mass, & + & SEDFLOCS(ng) % f_diam) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE sed_flocmod +! +!*********************************************************************** + SUBROUTINE sed_flocmod_tile (ng, tile, & + & LBi, UBi, LBj, UBj, UBk, UBt, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, z_r, z_w, Hz, & +# ifdef BBL_MODEL + & bustrcwmax, & + & bvstrcwmax, & + & Pwave_bot, & +# endif + & bustr, & + & bvstr, & + & Akt,Akv,Lscale,gls,tke, & + & t, & + & f_mass,f_diam) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment + USE mod_sedflocs +! + implicit none +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: z_r(LBi:,LBj:,:) + real(r8), intent(in) :: z_w(LBi:,LBj:,0:) + real(r8), intent(in) :: Hz(LBi:,LBj:,:) +# ifdef BBL_MODEL + real(r8), intent(in) :: bustrcwmax(LBi:,LBj:) + real(r8), intent(in) :: bvstrcwmax(LBi:,LBj:) + real(r8), intent(in) :: Pwave_bot(LBi:,LBj:) +# endif + real(r8), intent(in) :: bustr(LBi:,LBj:) + real(r8), intent(in) :: bvstr(LBi:,LBj:) + real(r8), intent(in) :: Akt(LBi:,LBj:,0:,:) + real(r8), intent(in) :: Akv(LBi:,LBj:,0:) + real(r8), intent(in) :: Lscale(LBi:,LBj:,0:) + real(r8), intent(in) :: tke(LBi:,LBj:,0:,:) + real(r8), intent(in) :: gls(LBi:,LBj:,0:,:) + real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:) +# else + real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng)) + real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng)) +# ifdef BBL_MODEL + real(r8), intent(in) :: bustrcwmax(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstrcwmax(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Pwave_bot(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(in) :: bustr(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: bvstr(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Akt(LBi:UBi,LBj:UBj,0:UBk,3) + real(r8), intent(in) :: Akv(LBi:UBi,LBj:UBj,0:UBk,3) + real(r8), intent(in) :: Lscale(LBi:UBi,LBj:UBj,0:UBk,3) + real(r8), intent(in) :: tke(LBi:UBi,LBj:UBj,0:UBk,3) + real(r8), intent(in) :: gls(LBi:UBi,LBj:UBj,0:UBk,3) + real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt) +# endif + real(r8), intent(in) :: f_mass(0:NCS+1) + real(r8), intent(in) :: f_diam(NCS) +! +! Local variable declarations. +! + integer :: i, indx, ised, j, k, ks +! +! Variable declarations for floc model +! + integer :: iv1 + real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv + real(r8) :: Gval,diss,mneg,dttemp,f_dt + real(r8) :: dt1,f_csum,epsilon8 + real(r8) :: cvtotmud,tke_av, gls_av, exp1, exp2, exp3, ustr2,effecz + real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: susmud + real(r8), dimension(N(ng),IminS:ImaxS,JminS:JmaxS) :: f_davg + real(r8), dimension(N(ng),IminS:ImaxS,JminS:JmaxS) :: f_d50 + real(r8), dimension(N(ng),IminS:ImaxS,JminS:JmaxS) :: f_d90 + real(r8), dimension(N(ng),IminS:ImaxS,JminS:JmaxS) :: f_d10 + real(r8),dimension(1:NCS) :: cv_tmp,NNin,NNout +! f_mneg_param : negative mass tolerated to avoid small sub time step (g/l) + real(r8), parameter :: f_mneg_param=0.000_r8 +#include "set_bounds.h" + + epsilon8=epsilon(1.0) +! epsilon8=1.e-8 +! +!-------------------------------------------------------------------------- +! * Executable part +! + J_LOOP : DO j=Jstr,Jend +! +! Extract mud variables from tracer arrays, place them into +! scratch arrays, and restrict their values to be positive definite. + DO k=1,N(ng) + DO i=Istr,Iend + Hz_inv(i,k)=1.0_r8/Hz(i,j,k) + END DO + END DO + DO ised=1,NCS + indx = idsed(ised) + DO k=1,N(ng) + DO i=Istr,Iend +! susmud(i,k,ised)=MAX(t(i,j,k,nstp,indx),0.0_r8) + susmud(i,k,ised)=t(i,j,k,nnew,indx)*Hz_inv(i,k) + ENDDO + ENDDO + ENDDO + +! min concentration below which flocculation processes are not calculated +! f_clim=0.001_r8 + exp1 = 3.0_r8+gls_p(ng)/gls_n(ng) + exp2 = 1.5_r8+gls_m(ng)/gls_n(ng) + exp3 = -1.0_r8/gls_n(ng) + + DO i=Istr,Iend + DO k=1,N(ng) + + f_dt=dt(ng) + dttemp=0.0_r8 + + ! concentration of all mud classes in one grid cell + cvtotmud=0.0_r8 + DO ised=1,NCS + cv_tmp(ised)=susmud(i,k,ised) + cvtotmud=cvtotmud+cv_tmp(ised) + + NNin(ised)=cv_tmp(ised)/f_mass(ised) + ENDDO + + DO iv1=1,NCS + IF (NNin(iv1).lt.0.0_r8) THEN + WRITE(*,*) '***************************************' + WRITE(*,*) 'CAUTION, negative mass at cell i,j,k :', & + & i,j,k + WRITE(*,*) '***************************************' + ENDIF + ENDDO + + IF (cvtotmud .gt. f_clim) THEN + +# if defined FLOC_TURB_DISS && !defined FLOC_BBL_DISS +! +!ALA dissipation from turbulence clossure +! + IF (k.eq.1) THEN + tke_av = tke(i,j,k,nnew) + gls_av = gls(i,j,k,nnew) + ELSEIF (k.eq.N(ng)) THEN + tke_av = tke(i,j,k,nnew) + gls_av = gls(i,j,k,nnew) + ELSE + tke_av = 0.5_r8*(tke(i,j,k-1,nnew)+tke(i,j,k,nnew)) + gls_av = 0.5_r8*(gls(i,j,k-1,nnew)+gls(i,j,k,nnew)) + ENDIF +! exp1 = 3.0_r8+gls_p(ng)/gls_n(ng) +! exp2 = 1.5_r8+gls_m(ng)/gls_n(ng) +! exp3 = -1.0_r8/gls_n(ng) + diss = gls_cmu0(ng)**exp1*tke_av**exp2*gls_av**exp3 +# elif defined FLOC_BBL_DISS && !defined FLOC_TURB_DISS +! +!ALA dissipation from wavecurrent bottom stress +! NOT READY FOR PRIME TIME +! NEEDS VERTICAL DISTRIBUTION +! As first cut, use turbulence closure +! + IF (k.eq.1) THEN + tke_av = tke(i,j,k,nnew) + gls_av = gls(i,j,k,nnew) + ELSEIF (k.eq.N(ng)) THEN + tke_av = tke(i,j,k,nnew) + gls_av = gls(i,j,k,nnew) + ELSE + tke_av = 0.5_r8*tke(i,j,k-1,nnew)+ & + & 0.5_r8*tke(i,j,k,nnew) + gls_av = 0.5_r8*gls(i,j,k-1,nnew)+ & + & 0.5_r8*gls(i,j,k,nnew) + ENDIF + diss = gls_cmu0(ng)**exp1*tke_av**exp2*gls_av**exp3 +! +! MODIFY THE BOTTOM LAYER TO INCLUDE WAVECURRENT STRESS +! + IF (k.eq.1) THEN +# ifdef BBL_MODEL + ustr2 =sqrt((bustrcwmax(i,j)**2.0_r8+ & + & bvstrcwmax(i,j)**2.0_r8 )) + effecz = (ustr2**0.5_r8)*Pwave_bot(i,j)*0.5_r8/pi + diss = MAX((ustr2**(1.5_r8))/(vonKar*effecz),diss) +# else + ustr2 =sqrt((bustr(i,j)**2.0_r8+bvstr(i,j)**2.0_r8 )) + diss = MAX((ustr2**(1.5_r8))/(vonKar* & + & (z_r(i,j,1)-zw(i,j,0))),diss) +# endif + ENDIF +# else + diss = epsilon8 + IF (l_testcase) THEN +! if (j.eq.1.and.i.eq.1.and.k.eq.1) then +! WRITE(*,*) 'VERNEY ET AL TESTCASE FOR FLOCS' +! endif + ELSE + WRITE(*,*) 'CAUTION :' + WRITE(*,*) 'CHOOSE A DISSIPATION MODEL FOR FLOCS' + WRITE(*,*) 'SIMULATION STOPPED' + STOP + ENDIF +# endif + CALL flocmod_comp_g(k,i,j,Gval,diss,ng) + + DO WHILE (dttemp .le. dt(ng)) + + CALL flocmod_comp_fsd(NNin,NNout,Gval,f_dt,ng) + CALL flocmod_mass_control(NNout,mneg,ng) + IF (mneg .gt. f_mneg_param) THEN + DO WHILE (mneg .gt. f_mneg_param) + f_dt=MIN(f_dt/2.0_r8,dt(ng)-dttemp) + IF (f_dt.lt.epsilon8) THEN + CALL flocmod_mass_redistribute(NNin,ng) + dttemp=dt(ng) + exit + ENDIF + CALL flocmod_comp_fsd(NNin,NNout,Gval,f_dt,ng) + CALL flocmod_mass_control(NNout,mneg,ng) + ENDDO + ELSE + + IF (f_dt.lt.dt(ng)) THEN + DO while (mneg .lt.f_mneg_param) + IF (dttemp+f_dt .eq. dt(ng)) THEN + CALL flocmod_comp_fsd(NNin,NNout,Gval,f_dt,ng) + exit + ELSE + dt1=f_dt + f_dt=MIN(2.0_r8*f_dt,dt(ng)-dttemp) + CALL flocmod_comp_fsd(NNin,NNout,Gval,f_dt,ng) + CALL flocmod_mass_control(NNout,mneg,ng) + IF (mneg .gt. f_mneg_param) THEN + f_dt=dt1 + CALL flocmod_comp_fsd(NNin,NNout,Gval,f_dt,ng) + exit + ENDIF + ENDIF + ENDDO + ENDIF + ENDIF + dttemp=dttemp+f_dt + + NNin(:)=NNout(:) ! update new Floc size distribution + ! redistribute negative masses IF any on positive classes, + ! depends on f_mneg_param + CALL flocmod_mass_redistribute(NNin,ng) + + IF (dttemp.eq.dt(ng)) exit + + ENDDO ! loop on full dt + + ENDIF ! only if cvtotmud > f_clim + + + ! update mass concentration for all mud classes + DO ised=1,NCS + susmud(i,k,ised)=NNin(ised)*f_mass(ised) + ENDDO + ENDDO + ENDDO +! +!----------------------------------------------------------------------- +! Update global tracer variables. +!----------------------------------------------------------------------- +! + DO ised=1,NCS + indx = idsed(ised) + DO k=1,N(ng) + DO i=Istr,Iend + t(i,j,k,nnew,indx)=susmud(i,k,ised)*Hz(i,j,k) + ENDDO + ENDDO + ENDDO + + + END DO J_LOOP +! WRITE(*,*) 'END flocmod_main' + END SUBROUTINE sed_flocmod_tile + + + +!!=========================================================================== + SUBROUTINE flocmod_collfrag(Gval,ng,f_g4,f_l4) + + !&E-------------------------------------------------------------------------- + !&E *** ROUTINE flocmod_collfrag *** + !&E + !&E ** Purpose : computation of collision fragmentation term, + !&E based on McAnally and Mehta, 2001 + !&E + !&E ** Description : + !&E + !&E ** Called by : flocmod_comp_fsd + !&E + !&E ** External calls : + !&E + !&E ** Reference : + !&E + !&E ** History : + !&E ! 2013-09 (Romaric Verney) + !&E + !&E-------------------------------------------------------------------------- + !! * Modules used + USE mod_sedflocs + USE mod_param + USE mod_scalars +! + implicit none + integer, intent(in) :: ng + real(r8),intent(in) :: Gval + + !! * Local declarations + integer :: iv1,iv2,iv3 + real(r8) :: f_fp,f_fy,f_cfcst,gcolfragmin,gcolfragmax + real(r8) :: gcolfragiv1,gcolfragiv2,f_weight,mult + real(r8) :: cff1, cff2 + real(r8),DIMENSION(NCS,NCS,NCS) :: f_g4 + real(r8),DIMENSION(NCS,NCS) :: f_l4 + real(r8),DIMENSION(NCS) :: fdiam,fmass +! shorten names + fdiam=SEDFLOCS(ng)%f_diam + fmass=SEDFLOCS(ng)%f_mass +! !!-------------------------------------------------------------------------- + !! * Executable part + + f_fp=0.1_r8 + f_fy=1e-10 + f_cfcst=3.0_r8/16.0_r8 + f_g4(1:NCS,1:NCS,1:NCS)=0.0_r8 + f_l4(1:NCS,1:NCS)=0.0_r8 + cff1=2.0_r8/(3.0_r8-f_nf) + cff2=1.0_r8/rhoref + + DO iv1=1,NCS + DO iv2=1,NCS + DO iv3=iv2,NCS + ! fragmentation after collision probability based on + ! Gval for particles iv2 and iv3 + ! gcolfrag=(collision induced shear) / (floc strength) + + gcolfragmin=2.0_r8*(Gval*(fdiam(iv2)+fdiam(iv3))) & + & **2.0_r8*fmass(iv2)*fmass(iv3)/(pi*f_fy*f_fp* & + & fdiam(iv3)**2.0_r8*(fmass(iv2)+fmass(iv3)) & + & *((SEDFLOCS(ng)%f_rho(iv3)-rhoref)*cff2)**cff1) + + gcolfragmax=2.0_r8*(Gval*(fdiam(iv2)+fdiam(iv3))) & + & **2.0_r8*fmass(iv2)*fmass(iv3)/(pi*f_fy*f_fp* & + & fdiam(iv2)**2.0_r8*(fmass(iv2)+fmass(iv3)) & + & *((SEDFLOCS(ng)%f_rho(iv2)-rhoref)*cff2)**cff1) + + + ! first case : iv3 not eroded, iv2 eroded forming 2 particles + ! : iv3+f_cfcst*iv2 / iv2-f_cfcst*iv2 + IF (gcolfragmin.lt.1.0_r8 .and. gcolfragmax.ge.1.0_r8) THEN + + IF (((fmass(iv3)+f_cfcst*fmass(iv2)).gt.fmass(iv1-1)) & + & .and. ((fmass(iv3)+f_cfcst*fmass(iv2)).le. & + & fmass(iv1))) THEN + + f_weight=((fmass(iv3)+f_cfcst*fmass(iv2)- & + & fmass(iv1-1))/(fmass(iv1)-fmass(iv1-1))) + + ELSEIF (fmass(iv3)+f_cfcst*fmass(iv2).gt.fmass(iv1) & + & .and. fmass(iv3)+f_cfcst*fmass(iv2).lt. & + & fmass(iv1+1)) THEN + + IF (iv1.eq.NCS) THEN + f_weight=1.0_r8 + ELSE + + f_weight=1.0_r8-((fmass(iv3)+f_cfcst*fmass(iv2)- & + & fmass(iv1))/(fmass(iv1+1)-fmass(iv1))) + ENDIF + + ELSE + f_weight=0.0_r8 + ENDIF + + f_g4(iv2,iv3,iv1)=f_g4(iv2,iv3,iv1)+f_weight* & + & (SEDFLOCS(ng)%f_coll_prob_sh(iv2,iv3))*(fmass(iv3)+ & + & f_cfcst*fmass(iv2))/fmass(iv1) + + IF (fmass(iv2)-f_cfcst*fmass(iv2).gt.fmass(iv1-1) & + & .and. fmass(iv2)-f_cfcst*fmass(iv2).le. & + & fmass(iv1)) THEN + + f_weight=((fmass(iv2)-f_cfcst*fmass(iv2)- & + & fmass(iv1-1))/(fmass(iv1)-fmass(iv1-1))) + + ELSEIF (fmass(iv2)-f_cfcst*fmass(iv2).gt.fmass(iv1) & + & .and. fmass(iv2)-f_cfcst*fmass(iv2).lt. & + & fmass(iv1+1)) THEN + + IF (iv1.eq.NCS) THEN + f_weight=1.0_r8 + ELSE + + f_weight=1.0_r8-((fmass(iv2)-f_cfcst*fmass(iv2)- & + & fmass(iv1))/(fmass(iv1+1)-fmass(iv1))) + ENDIF + + ELSE + f_weight=0.0_r8 + ENDIF + + f_g4(iv2,iv3,iv1)=f_g4(iv2,iv3,iv1)+f_weight* & + & (SEDFLOCS(ng)%f_coll_prob_sh(iv2,iv3))*(fmass(iv2)- & + & f_cfcst*fmass(iv2))/fmass(iv1) + + + ! second case : iv3 eroded and iv2 eroded forming 3 particles : + !iv3-f_cfcst*iv3 / iv2-f_cfcst*iv2 / f_cfcst*iv3+f_cfcst*iv2 + ELSEIF (gcolfragmin.ge.1.0_r8 .and. gcolfragmax.ge. & + & 1.0_r8) THEN + + IF (f_cfcst*fmass(iv2)+f_cfcst*fmass(iv3).gt. & + & fmass(iv1-1) .and. f_cfcst*fmass(iv2)+f_cfcst* & + & fmass(iv3).le.fmass(iv1)) THEN + + f_weight=((f_cfcst*fmass(iv2)+f_cfcst*fmass(iv3)- & + & fmass(iv1-1))/(fmass(iv1)-fmass(iv1-1))) + + ELSEIF (f_cfcst*fmass(iv2)+f_cfcst*fmass(iv3).gt. & + & fmass(iv1) .and. f_cfcst*fmass(iv2)+f_cfcst* & + & fmass(iv3).lt.fmass(iv1+1)) THEN + + IF (iv1.eq.NCS) THEN + f_weight=1.0_r8 + ELSE + + f_weight=1.0_r8-((f_cfcst*fmass(iv2)+f_cfcst* & + & fmass(iv3)-fmass(iv1))/(fmass(iv1+1)- & + & fmass(iv1))) + ENDIF + + ELSE + f_weight=0.0_r8 + ENDIF + + f_g4(iv2,iv3,iv1)=f_g4(iv2,iv3,iv1)+f_weight* & + & (SEDFLOCS(ng)%f_coll_prob_sh(iv2,iv3))*(f_cfcst* & + & fmass(iv2)+f_cfcst*fmass(iv3))/fmass(iv1) + + IF ((1.0_r8-f_cfcst)*fmass(iv2).gt.fmass(iv1-1) & + & .and. (1.0_r8-f_cfcst)*fmass(iv2).le. & + & fmass(iv1)) THEN + + f_weight=((1.0_r8-f_cfcst)*fmass(iv2)- & + & fmass(iv1-1))/(fmass(iv1)-fmass(iv1-1)) + + ELSEIF ((1.0_r8-f_cfcst)*fmass(iv2).gt.fmass(iv1) & + & .and. (1.0_r8-f_cfcst)*fmass(iv2).lt. & + & fmass(iv1+1)) THEN + + IF (iv1.eq.NCS) THEN + f_weight=1.0_r8 + ELSE + + f_weight=1.0_r8-(((1.0_r8-f_cfcst)*fmass(iv2)- & + & fmass(iv1))/(fmass(iv1+1)-fmass(iv1))) + ENDIF + + ELSE + f_weight=0.0_r8 + ENDIF + + f_g4(iv2,iv3,iv1)=f_g4(iv2,iv3,iv1)+f_weight* & + & (SEDFLOCS(ng)%f_coll_prob_sh(iv2,iv3))* & + & ((1.0_r8-f_cfcst)*fmass(iv2))/fmass(iv1) + + + IF ((1.0_r8-f_cfcst)*fmass(iv3).gt.fmass(iv1-1) .and. & + & (1.0_r8-f_cfcst)*fmass(iv3).le.fmass(iv1)) THEN + + f_weight=((1.0_r8-f_cfcst)*fmass(iv3)-fmass(iv1-1)) & + & /(fmass(iv1)-fmass(iv1-1)) + + ELSEIF ((1.0_r8-f_cfcst)*fmass(iv3).gt.fmass(iv1) & + & .and. (1.0_r8-f_cfcst)*fmass(iv3).lt. & + & fmass(iv1+1)) THEN + + IF (iv1.eq.NCS) THEN + f_weight=1.0_r8 + ELSE + + f_weight=1.0_r8-(((1.0_r8-f_cfcst)*fmass(iv3)- & + & fmass(iv1))/(fmass(iv1+1)-fmass(iv1))) + ENDIF + + ELSE + f_weight=0.0_r8 + ENDIF + + f_g4(iv2,iv3,iv1)=f_g4(iv2,iv3,iv1)+f_weight* & + & (SEDFLOCS(ng)%f_coll_prob_sh(iv2,iv3))* & + & ((1.0_r8-f_cfcst)*fmass(iv3))/fmass(iv1) + + + ENDIF ! end collision test case + ENDDO + ENDDO + ENDDO + + DO iv1=1,NCS + DO iv2=1,NCS + + gcolfragiv1=2.0_r8*(Gval*(fdiam(iv1)+fdiam(iv2)))**2.0_r8* & + & fmass(iv1)*fmass(iv2)/(pi*f_fy*f_fp*fdiam(iv1) & + & **2.0_r8*(fmass(iv1)+fmass(iv2))* & + & ((SEDFLOCS(ng)%f_rho(iv1)- & + & rhoref)*cff2)**cff1) + + gcolfragiv2=2.0_r8*(Gval*(fdiam(iv1)+fdiam(iv2)))**2.0_r8* & + & fmass(iv1)*fmass(iv2)/(pi*f_fy*f_fp*fdiam(iv2) & + & **2.0_r8*(fmass(iv1)+fmass(iv2))* & + & ((SEDFLOCS(ng)%f_rho(iv2)- & + & rhoref)*cff2)**cff1) + + mult=1.0_r8 + IF (iv1.eq.iv2) mult=2.0_r8 + + IF (iv1.eq.MAX(iv1,iv2) .and. gcolfragiv1.ge.1.0_r8) THEN + f_l4(iv2,iv1)=f_l4(iv2,iv1)+mult* & + & (SEDFLOCS(ng)%f_coll_prob_sh(iv1,iv2)) + ELSEIF (iv1.eq.MIN(iv1,iv2) .and. gcolfragiv2.ge.1.0_r8) THEN + f_l4(iv2,iv1)=f_l4(iv2,iv1)+mult* & + & (SEDFLOCS(ng)%f_coll_prob_sh(iv1,iv2)) + ENDIF + + ENDDO + ENDDO + + f_g4(1:NCS,1:NCS,1:NCS)= & + & f_g4(1:NCS,1:NCS,1:NCS)*f_collfragparam + f_l4(1:NCS,1:NCS)=f_l4(1:NCS,1:NCS)*f_collfragparam + + RETURN + END SUBROUTINE flocmod_collfrag + +!!=========================================================================== + SUBROUTINE flocmod_comp_fsd(NNin,NNout,Gval,f_dt,ng) + + !&E-------------------------------------------------------------------------- + !&E *** ROUTINE flocmod_comp_fsd *** + !&E + !&E ** Purpose : computation of floc size distribution + !&E + !&E ** Description : + !&E + !&E ** Called by : flocmod_main + !&E + !&E ** External calls : + !&E + !&E ** Reference : + !&E + !&E ** History : + !&E ! 2013-09 (Romaric Verney) + !&E + !&E-------------------------------------------------------------------------- + !! * Modules used + USE mod_param + USE mod_scalars + USE mod_sedflocs +! + implicit none + + !! * Arguments + integer, intent(in) :: ng + real(r8),intent(in) :: Gval + real(r8),dimension(1:NCS),intent(in) :: NNin + real(r8),dimension(1:NCS),intent(out) :: NNout + real(r8),intent(in) :: f_dt + + !! * Local declarations + integer :: iv1,iv2,iv3 + real(r8) :: tmp_g1,tmp_g3,tmp_l1,tmp_l3,tmp_l4,tmp_g4 + real(r8),dimension(1:NCS,1:NCS,1:NCS) :: f_g1_tmp,f_g4 + real(r8),dimension(1:NCS,1:NCS) :: f_l1_tmp,f_l4 + + !!-------------------------------------------------------------------------- + !! * Executable part + + tmp_g1=0.0_r8 + tmp_g3=0.0_r8 + tmp_g4=0.0_r8 + tmp_l1=0.0_r8 + tmp_l3=0.0_r8 + tmp_l4=0.0_r8 + f_g1_tmp(1:NCS,1:NCS,1:NCS)=0.0_r8 + f_l1_tmp(1:NCS,1:NCS)=0.0_r8 + + IF (l_COLLFRAG) CALL flocmod_collfrag(Gval,ng,f_g4,f_l4) + + DO iv1=1,NCS + DO iv2=1,NCS + DO iv3=1,NCS + IF (l_ASH) THEN + f_g1_tmp(iv2,iv3,iv1)=f_g1_tmp(iv2,iv3,iv1)+ & + & SEDFLOCS(ng)%f_g1_sh(iv2,iv3,iv1)*Gval + ENDIF + IF (l_ADS) THEN + f_g1_tmp(iv2,iv3,iv1)=f_g1_tmp(iv2,iv3,iv1)+ & + & SEDFLOCS(ng)%f_g1_ds(iv2,iv3,iv1) + ENDIF + + tmp_g1=tmp_g1+(NNin(iv3)*(f_g1_tmp(iv2,iv3,iv1))*NNin(iv2)) + + IF (l_COLLFRAG) THEN + tmp_g4=tmp_g4+(NNin(iv3)* & + & (SEDFLOCS(ng)%f_g4(iv2,iv3,iv1)*Gval)*NNin(iv2)) + ENDIF + ENDDO + + tmp_g3=tmp_g3+SEDFLOCS(ng)%f_g3(iv2,iv1)*NNin(iv2)* & + & Gval**1.5_r8 + + IF (l_ASH) THEN + f_l1_tmp(iv2,iv1)=f_l1_tmp(iv2,iv1)+ & + & SEDFLOCS(ng)%f_l1_sh(iv2,iv1)*Gval + ENDIF + IF (l_ADS) THEN + f_l1_tmp(iv2,iv1)=f_l1_tmp(iv2,iv1)+ & + & SEDFLOCS(ng)%f_l1_ds(iv2,iv1)*Gval + ENDIF + + tmp_l1=tmp_l1+(f_l1_tmp(iv2,iv1))*NNin(iv2) + + IF (l_COLLFRAG) THEN + tmp_l4=tmp_l4+(SEDFLOCS(ng)%f_l4(iv2,iv1)*Gval)*NNin(iv2) + ENDIF + ENDDO + + tmp_l1=tmp_l1*NNin(iv1) + tmp_l4=tmp_l4*NNin(iv1) + tmp_l3=SEDFLOCS(ng)%f_l3(iv1)*Gval**1.5_r8*NNin(iv1) + + NNout(iv1)=NNin(iv1)+ f_dt*(tmp_g1+tmp_g3+tmp_g4-(tmp_l1+ & + & tmp_l3+tmp_l4)) + + tmp_g1=0.0_r8 + tmp_g3=0.0_r8 + tmp_g4=0.0_r8 + tmp_l1=0.0_r8 + tmp_l3=0.0_r8 + tmp_l4=0.0_r8 + ENDDO + + RETURN + END SUBROUTINE flocmod_comp_fsd + + + +!!=========================================================================== + SUBROUTINE flocmod_mass_control(NN,mneg,ng) + + !&E-------------------------------------------------------------------------- + !&E *** ROUTINE flocmod_mass_control *** + !&E + !&E ** Purpose : Compute mass in every class after flocculation and + !&E returns negative mass if any + !&E + !&E ** Description : + !&E + !&E ** Called by : flocmod_main + !&E + !&E ** External calls : + !&E + !&E ** Reference : + !&E + !&E ** History : + !&E ! 2013-09 (Romaric Verney) + !&E + !&E-------------------------------------------------------------------------- + !! * Modules used + USE mod_sedflocs + USE mod_param + USE mod_scalars +! + implicit none + integer, intent(in) :: ng + + !! * Local declarations + integer :: iv1 + real(r8),intent(out) :: mneg + real(r8),dimension(1:NCS),intent(in) :: NN + !real(r8),DIMENSION(0:NCS+1) :: f_mass + + !!-------------------------------------------------------------------------- + !! * Executable part + + mneg=0.0_r8 + + DO iv1=1,NCS + IF (NN(iv1).lt.0.0_r8) THEN + mneg=mneg-NN(iv1)*SEDFLOCS(ng)%f_mass(iv1) + ENDIF + ENDDO + + RETURN + END SUBROUTINE flocmod_mass_control + +!!=========================================================================== + SUBROUTINE flocmod_mass_redistribute(NN,ng) + + !&E-------------------------------------------------------------------------- + !&E *** ROUTINE flocmod_mass_redistribute *** + !&E + !&E ** Purpose : based on a tolerated negative mass parameter, negative masses + !&E are redistributed linearly towards remaining postive masses + !&E and negative masses are set to 0 + !&E + !&E ** Description : + !&E + !&E ** Called by : flocmod_main + !&E + !&E ** External calls : + !&E + !&E ** Reference : + !&E + !&E ** History : + !&E ! 2013-09 (Romaric Verney) + !&E + !&E-------------------------------------------------------------------------- + !! * Modules used + USE mod_param + USE mod_scalars + USE mod_sedflocs +! + implicit none + integer, intent(in) :: ng + + + !! * Local declarations + integer :: iv + real(r8) :: npos + real(r8) :: mneg + real(r8),dimension(1:NCS),intent(inout) :: NN + real(r8),dimension(1:NCS) :: NNtmp + !real(r8),DIMENSION(0:NCS+1) :: f_mass + !!-------------------------------------------------------------------------- + !! * Executable part + + mneg=0.0_r8 + npos=0.0_r8 + NNtmp(:)=NN(:) + + DO iv=1,NCS + IF (NN(iv).lt.0.0_r8) THEN + mneg=mneg-NN(iv)*SEDFLOCS(ng)%f_mass(iv) + NNtmp(iv)=0.0_r8 + ELSE + npos=npos+1.0_r8 + ENDIF + ENDDO + + IF (mneg.gt.0.0_r8) THEN + IF (npos.eq.0.0_r8) THEN + WRITE(*,*) 'CAUTION : all floc sizes have negative mass!' + WRITE(*,*) 'SIMULATION STOPPED' + STOP + ELSE + DO iv=1,NCS + IF (NN(iv).gt.0.0_r8) THEN + NN(iv)=NN(iv)-mneg/sum(NNtmp)*NN(iv)/ & + & SEDFLOCS(ng)%f_mass(iv) + ELSE + NN(iv)=0.0_r8 + ENDIF + + ENDDO + + ENDIF + ENDIF + + RETURN + END SUBROUTINE flocmod_mass_redistribute + +!!=========================================================================== + SUBROUTINE flocmod_comp_g(k,i,j,Gval,diss,ng) + + !&E-------------------------------------------------------------------------- + !&E *** ROUTINE flocmod_comp_g *** + !&E + !&E ** Purpose : compute shear rate to estimate shear aggregation and erosion + !&E + !&E ** Description : + !&E + !&E ** Called by : flocmod_main + !&E + !&E ** External calls : + !&E + !&E ** Reference : + !&E + !&E ** History : + !&E ! 2013-09 (Romaric Verney) + !&E + !&E-------------------------------------------------------------------------- + !! * Modules used + USE mod_sedflocs + USE mod_param + USE mod_scalars +! + implicit none + + !! * Local declarations + integer, intent(in) :: k,i,j + integer, intent(in) :: ng + real(r8),intent(out) :: Gval + real(r8) :: htn,ustar,z,diss,nueau +! l_testcase - if .TRUE. sets G(t) to values from lab experiment +! logical, parameter :: l_testcase = .TRUE. + !!-------------------------------------------------------------------------- + !! * Executable part + ! nueau=1.06e-6_r8 + ! ustar=sqrt(tenfon(i,j)/rhoref) + ! htn=h0(i,j)+ssh(i,j) + ! z=(1.0_r8+sig(k))*htn + +! +! ALA from CRS +! + nueau = 1.5E-6_r8 + IF (l_testcase) THEN + ! reproducing flocculation experiment Verney et al., 2011 + Gval=0.0_r8 + IF (time(ng) .lt. 7201.0_r8) THEN + Gval=1.0_r8 + ELSEIF (time(ng) .lt. 8401.0_r8) THEN + Gval=2.0_r8 + ELSEIF (time(ng) .lt. 9601.0_r8) THEN + Gval=3.0_r8 + ELSEIF (time(ng) .lt. 10801.0_r8) THEN + Gval=4.0_r8 + ELSEIF (time(ng) .lt. 12601.0_r8) THEN + Gval=12.0_r8 + ELSEIF (time(ng) .lt. 13801.0_r8) THEN + Gval=4.0_r8 + ELSEIF (time(ng) .lt. 15001.0_r8) THEN + Gval=3.0_r8 + ELSEIF (time(ng) .lt. 16201.0_r8) THEN + Gval=2.0_r8 + ELSEIF (time(ng) .lt. 21601.0_r8) THEN + Gval=1.0_r8 + ELSEIF (time(ng) .lt. 25201.0_r8) THEN + Gval=0.0_r8 + ELSEIF (time(ng) .lt. 30601.0_r8) THEN + Gval=1.0_r8 + ELSEIF (time(ng) .lt. 31801.0_r8) THEN + Gval=2.0_r8 + ELSEIF (time(ng) .lt. 33001.0_r8) THEN + Gval=3.0_r8 + ELSEIF (time(ng) .lt. 34201.0_r8) THEN + Gval=4.0_r8 + ELSEIF (time(ng) .lt. 36001.0_r8) THEN + Gval=12.0_r8 + ELSEIF (time(ng) .lt. 37201.0_r8) THEN + Gval=4.0_r8 + ELSEIF (time(ng) .lt. 38401.0_r8) THEN + Gval=3.0_r8 + ELSEIF (time(ng) .lt. 39601.0_r8) THEN + Gval=2.0_r8 + ELSEIF (time(ng) .lt. 45001.0_r8) THEN + Gval=1.0_r8 + ELSEIF (time(ng) .lt. 48601.0_r8) THEN + Gval=0.0_r8 + ELSEIF (time(ng) .lt. 54001.0_r8) THEN + Gval=1.0_r8 + ELSEIF (time(ng) .lt. 55201.0_r8) THEN + Gval=2.0_r8 + ELSEIF (time(ng) .lt. 56401.0_r8) THEN + Gval=3.0_r8 + ELSEIF (time(ng) .lt. 57601.0_r8) THEN + Gval=4.0_r8 + ELSE + Gval=12.0_r8 + ENDIF + ELSE + Gval=sqrt(diss/nueau) + ENDIF +! NO KLUDGE +! Gval = 12.0_r8 + RETURN + END SUBROUTINE flocmod_comp_g + + +#endif + END MODULE sed_flocs_mod diff --git a/ROMS/Nonlinear/Sediment/sed_fluxes.F b/ROMS/Nonlinear/Sediment/sed_fluxes.F index afc3a30f..2c0f9435 100644 --- a/ROMS/Nonlinear/Sediment/sed_fluxes.F +++ b/ROMS/Nonlinear/Sediment/sed_fluxes.F @@ -60,7 +60,6 @@ SUBROUTINE sed_fluxes (ng, tile) & LBi, UBi, LBj, UBj, & & IminS, ImaxS, JminS, JmaxS, & & nstp(ng), nnew(ng), & - & GRID(ng) % Hz, & # ifdef WET_DRY & GRID(ng) % rmask_wet, & # endif @@ -74,6 +73,12 @@ SUBROUTINE sed_fluxes (ng, tile) # endif & FORCES(ng) % bustr, & & FORCES(ng) % bvstr, & +# ifdef SED_DUNEFACE + & FORCES(ng) % Dissip_roller, & + & GRID(ng) % pm, GRID(ng) % pn, & + & OCEAN(ng) % ubar, & + & OCEAN(ng) % vbar, & +# endif & OCEAN(ng) % t, & & SEDBED(ng) % ero_flux, & & SEDBED(ng) % settling_flux, & @@ -96,7 +101,6 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & IminS, ImaxS, JminS, JmaxS, & & nstp, nnew, & - & Hz, & # ifdef WET_DRY & rmask_wet, & # endif @@ -106,6 +110,11 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & & bustrcwmax, bvstrcwmax, & # endif & bustr, bvstr, & +# ifdef SED_DUNEFACE + & Dissip_roller, & + & pm, pn, & + & ubar, vbar, & +# endif & t, & & ero_flux, settling_flux, & # if defined SED_MORPH @@ -128,7 +137,6 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & integer, intent(in) :: nstp, nnew ! # ifdef ASSUMED_SHAPE - real(r8), intent(in) :: Hz(LBi:,LBj:,:) # ifdef WET_DRY real(r8), intent(in) :: rmask_wet(LBi:,LBj:) # endif @@ -142,6 +150,13 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & # endif real(r8), intent(in) :: bustr(LBi:,LBj:) real(r8), intent(in) :: bvstr(LBi:,LBj:) +# ifdef SED_DUNEFACE + real(r8), intent(in) :: Dissip_roller(LBi:,LBj:) + real(r8), intent(in) :: pm(LBi:,LBj:) + real(r8), intent(in) :: pn(LBi:,LBj:) + real(r8), intent(in) :: ubar(LBi:,LBj:,:) + real(r8), intent(in) :: vbar(LBi:,LBj:,:) +# endif # if defined SED_MORPH real(r8), intent(inout):: bed_thick(LBi:,LBj:,:) # endif @@ -153,7 +168,6 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) real(r8), intent(inout) :: bottom(LBi:,LBj:,:) # else - real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng)) # ifdef WET_DRY real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj) # endif @@ -167,6 +181,13 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & # endif real(r8), intent(in) :: bustr(LBi:UBi,LBj:UBj) real(r8), intent(in) :: bvstr(LBi:UBi,LBj:UBj) +# ifdef SED_DUNEFACE + real(r8), intent(in) :: Dissip_roller(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,3) + real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,3) +# endif # if defined SED_MORPH real(r8), intent(inout):: bed_thick(LBi:UBi,LBj:UBj,3) # endif @@ -184,10 +205,7 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & integer :: Ksed, i, indx, ised, j, k, ks integer :: bnew - real(r8) :: cff, cff1, cff2, cff3, cff4 - - real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv - + real(r8) :: cff, cff1, cff2, cff3, cff4, cff5 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tau_w # include "set_bounds.h" @@ -240,12 +258,6 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & ! after both fluxes are applied. ! J_LOOP : DO j=Jstr,Jend - DO k=1,N(ng) - DO i=Istr,Iend - Hz_inv(i,k)=1.0_r8/Hz(i,j,k) - END DO - END DO -! SED_LOOP: DO ised=1,NST indx=idsed(ised) DO i=Istr,Iend @@ -267,19 +279,52 @@ SUBROUTINE sed_fluxes_tile (ng, tile, & ! cff1=(1.0_r8-bed(i,j,1,iporo))*bed_frac(i,j,1,ised) cff2=dt(ng)*Erate(ised,ng)*cff1 +# ifdef SED_DUNEFACE + cff2=cff2+Dissip_roller(i,j)*0.0005_r8 +# endif cff3=Srho(ised,ng)*cff1 cff4=bed_mass(i,j,1,bnew,ised) + cff5=settling_flux(i,j,ised) !CRS +# if defined SED_TAU_CD_CONST || defined SED_TAU_CD_LIN + if (tau_w(i,j).GT.tau_cd(ised,ng)) then + cff5=0.0_r8 + endif +# endif +# if defined SED_TAU_CD_LIN + if (tau_w(i,j).LE.tau_cd(ised,ng).AND. & + & tau_cd(ised,ng).GT.0.0_r8) then + cff5=(1.0_r8-tau_w(i,j)/tau_cd(ised,ng))*cff5 + endif +# endif ero_flux(i,j,ised)= & & MIN(MAX(0.0_r8,cff2*(cff*tau_w(i,j)-1.0_r8)), & & MIN(cff3*bottom(i,j,iactv),cff4)+ & - & settling_flux(i,j,ised)) + & cff5) ! -! Update global tracer variables (m Tunits for nnew indx, Tuints for 3) -! for erosive flux. +! Update global tracer variables (mT units) for erosive flux. ! t(i,j,1,nnew,indx)=t(i,j,1,nnew,indx)+ero_flux(i,j,ised) +# if defined SED_TAU_CD_CONST || defined SED_TAU_CD_LIN + t(i,j,1,nnew,indx)=t(i,j,1,nnew,indx)+ & + & (settling_flux(i,j,ised)-cff5) + settling_flux(i,j,ised)=cff5 +# endif + END DO END DO SED_LOOP +! +! Calculate net deposition and erosion. +! + DO i=Istr,Iend + cff=0.0_r8 + cff2=0.0_r8 + DO ised=1,NST + cff=cff+settling_flux(i,j,ised) + cff2=cff2+ero_flux(i,j,ised) + END DO + bottom(i,j,idnet)=cff-cff2 + END DO +! END DO J_LOOP ! RETURN diff --git a/ROMS/Nonlinear/Sediment/sed_settling.F b/ROMS/Nonlinear/Sediment/sed_settling.F index 326c9662..62689451 100644 --- a/ROMS/Nonlinear/Sediment/sed_settling.F +++ b/ROMS/Nonlinear/Sediment/sed_settling.F @@ -110,7 +110,7 @@ SUBROUTINE sed_settling_tile (ng, tile, & # else real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng)) real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng)) - real(r8), intent(inout) :: settling_flux(LBi:UBi,LBj:UBj,NST) + real(r8), intent(inout) :: settling_flux(LBi:UBi,LBj:UBj,NST(ng)) real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng)) # endif ! @@ -167,7 +167,7 @@ SUBROUTINE sed_settling_tile (ng, tile, & indx=idsed(ised) DO k=1,N(ng) DO i=Istr,Iend - qc(i,k)=t(i,j,k,nnew,indx)*Hz_inv(i,k) + qc(i,k)=t(i,j,k,nstp,indx) END DO END DO ! @@ -330,7 +330,7 @@ SUBROUTINE sed_settling_tile (ng, tile, & END DO DO i=Istr,Iend DO k=1,N(ng) - t(i,j,k,nnew,indx)=qc(i,k)*Hz(i,j,k)+(FC(i,k)-FC(i,k-1)) + t(i,j,k,nnew,indx)=t(i,j,k,nnew,indx)+(FC(i,k)-FC(i,k-1)) END DO settling_flux(i,j,ised)=FC(i,0) END DO diff --git a/ROMS/Nonlinear/Sediment/sedbed_mod.h b/ROMS/Nonlinear/Sediment/sedbed_mod.h index ae739ae4..988f5d97 100644 --- a/ROMS/Nonlinear/Sediment/sedbed_mod.h +++ b/ROMS/Nonlinear/Sediment/sedbed_mod.h @@ -23,6 +23,12 @@ ! bed(:,:,:,iaged) => layer age ! ! bed(:,:,:,iporo) => layer porosity ! ! bed(:,:,:,idiff) => layer bio-diffusivity ! +# if defined SEDBIO_COUP +! bed(:,:,:,iboxy) => layer oxygen ! +! bed(:,:,:,ibno3) => layer nitrate ! +! bed(:,:,:,ibnh4) => layer ammonium ! +! bed(:,:,:,ibodu) => layer oxygen demand units ! +# endif ! bed_frac Sediment fraction of each size class in each bed ! ! layer(nondimensional: 0-1.0). Sum of ! ! bed_frac = 1.0. ! @@ -36,6 +42,15 @@ #ifdef BEDLOAD ! bedldu Bed load u-transport (kg/m/s). ! ! bedldv Bed load v-transport (kg/m/s). ! +# ifdef BEDLOAD_VANDERA +! ursell_no Ursell number of the asymmetric wave. ! +! RR_asymwave Velocity skewness parameter of the asymmetric wave. ! +! beta_asymwave Accleration assymetry parameter. ! +! ucrest_r Crest velocity of the asymmetric wave form (m/s). ! +! utrough_r Trough velocity of the asymmetric wave form (m/s). ! +! T_crest Crest time period of the asymmetric wave form (s). ! +! T_trough Trough time period of the asymmetric wave form (s). ! +# endif #endif ! bottom Exposed sediment layer properties: ! ! bottom(:,:,isd50) => mean grain diameter ! @@ -45,19 +60,57 @@ ! bottom(:,:,irlen) => ripple length ! ! bottom(:,:,irhgt) => ripple height ! ! bottom(:,:,ibwav) => bed wave excursion amplitude ! +! bottom(:,:,izdef) => default bottom roughness ! +! bottom(:,:,izapp) => apparent bottom roughness ! ! bottom(:,:,izNik) => Nikuradse bottom roughness ! ! bottom(:,:,izbio) => biological bottom roughness ! ! bottom(:,:,izbfm) => bed form bottom roughness ! ! bottom(:,:,izbld) => bed load bottom roughness ! -! bottom(:,:,izapp) => apparent bottom roughness ! ! bottom(:,:,izwbl) => wave bottom roughness ! -! bottom(:,:,izdef) => default bottom roughness ! ! bottom(:,:,iactv) => active layer thickness ! ! bottom(:,:,ishgt) => saltation height ! +! bottom(:,:,imaxD) => maximum inundation depth ! +! bottom(:,:,idnet) => Erosion or deposition ! +! bottom(:,:,idtbl) => Thickness of wbl ! +! bottom(:,:,idubl) => Current velocity at wbl ! +! bottom(:,:,idfdw) => Friction factor from currents ! +! bottom(:,:,idzrw) => Ref height for near bottom vel! +! bottom(:,:,idksd) => Bed roughness for wbl ! +! bottom(:,:,idusc) => Current friction velocity wbl ! +! bottom(:,:,idpcx) => Angle between currents and xi ! +! bottom(:,:,idpwc) => Angle between waves / currents! +#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED +! bottom(:,:,idoff) => tau critical offset ! +! bottom(:,:,idslp) => tau critical slope ! +! bottom(:,:,idtim) => erodibility time scale ! +! bottom(:,:,idbmx) => diffusivity db_max ! +! bottom(:,:,idbmm) => diffusivity db_m ! +! bottom(:,:,idbzs) => diffusivity db_zs ! +! bottom(:,:,idbzm) => diffusivity db_zm ! +! bottom(:,:,idbzp) => diffusivity db_zphi ! +#endif +#if defined MIXED_BED +! bottom(:,:,idprp) => cohesive behavior ! +#endif +#if defined SEAGRASS_BOTTOM +! bottom(:,:,isgrH) => Seagrass height ! +! bottom(:,:,isgrD) => Seagrass shoot density ! +#endif #if defined SEDIMENT && defined SUSPLOAD ! ero_flux Flux from erosion. ! ! settling_flux Flux from settling. ! #endif +#if defined COHESIVE_BED || defined MIXED_BED +! tcr_min minimum shear for erosion +! tcr_max maximum shear for erosion +! tcr_slp Tau_crit profile slope +! tcr_off Tau_crit profile offset +! tcr_tim Tau_crit consolidation rate +#endif +#if defined MIXED_BED +! transC cohesive transition +! transN noncohesive transition +#endif ! ! !======================================================================= ! @@ -97,12 +150,24 @@ #ifdef BEDLOAD real(r8), pointer :: bedldu(:,:,:) real(r8), pointer :: bedldv(:,:,:) +# ifdef BEDLOAD_VANDERA + real(r8), pointer :: ursell_no(:,:) + real(r8), pointer :: RR_asymwave(:,:) + real(r8), pointer :: beta_asymwave(:,:) + real(r8), pointer :: ucrest_r(:,:) + real(r8), pointer :: utrough_r(:,:) + real(r8), pointer :: T_crest(:,:) + real(r8), pointer :: T_trough(:,:) +# endif #endif real(r8), pointer :: bottom(:,:,:) #if defined SEDIMENT && defined SUSPLOAD real(r8), pointer :: ero_flux(:,:,:) real(r8), pointer :: settling_flux(:,:,:) #endif +#if defined SEDIMENT && defined SED_BIOMASS + real(r8), pointer :: Dstp_max(:,:,:) +#endif #if defined TANGENT || defined TL_IOMS ! @@ -202,17 +267,29 @@ #endif #if defined SEDIMENT && defined SED_MORPH allocate ( SEDBED(ng) % bed_thick0(LBi:UBi,LBj:UBj) ) - allocate ( SEDBED(ng) % bed_thick(LBi:UBi,LBj:UBj,3) ) + allocate ( SEDBED(ng) % bed_thick(LBi:UBi,LBj:UBj,1:3) ) #endif #ifdef BEDLOAD allocate ( SEDBED(ng) % bedldu(LBi:UBi,LBj:UBj,NST) ) allocate ( SEDBED(ng) % bedldv(LBi:UBi,LBj:UBj,NST) ) +# ifdef BEDLOAD_VANDERA + allocate ( SEDBED(ng) % ursell_no(LBi:UBi,LBj:UBj) ) + allocate ( SEDBED(ng) % RR_asymwave(LBi:UBi,LBj:UBj) ) + allocate ( SEDBED(ng) % beta_asymwave(LBi:UBi,LBj:UBj) ) + allocate ( SEDBED(ng) % ucrest_r(LBi:UBi,LBj:UBj) ) + allocate ( SEDBED(ng) % utrough_r(LBi:UBi,LBj:UBj) ) + allocate ( SEDBED(ng) % T_crest(LBi:UBi,LBj:UBj) ) + allocate ( SEDBED(ng) % T_trough(LBi:UBi,LBj:UBj) ) +# endif #endif allocate ( SEDBED(ng) % bottom(LBi:UBi,LBj:UBj,MBOTP) ) #if defined SEDIMENT && defined SUSPLOAD allocate ( SEDBED(ng) % ero_flux(LBi:UBi,LBj:UBj,NST) ) allocate ( SEDBED(ng) % settling_flux(LBi:UBi,LBj:UBj,NST) ) #endif +#if defined SEDIMENT && defined SED_BIOMASS + allocate ( SEDBED(ng) % Dstp_max(LBi:UBi,LBj:UBj,24) ) +#endif #if defined TANGENT || defined TL_IOMS ! @@ -225,7 +302,7 @@ # endif # if defined SEDIMENT && defined SED_MORPH allocate ( SEDBED(ng) % tl_bed_thick0(LBi:UBi,LBj:UBj) ) - allocate ( SEDBED(ng) % tl_bed_thick(LBi:UBi,LBj:UBj,3) ) + allocate ( SEDBED(ng) % tl_bed_thick(LBi:UBi,LBj:UBj,1:3) ) # endif # ifdef BEDLOAD allocate ( SEDBED(ng) % tl_bedldu(LBi:UBi,LBj:UBj,NST) ) @@ -249,7 +326,7 @@ # endif # if defined SEDIMENT && defined SED_MORPH allocate ( SEDBED(ng) % ad_bed_thick0(LBi:UBi,LBj:UBj) ) - allocate ( SEDBED(ng) % ad_bed_thick(LBi:UBi,LBj:UBj,3) ) + allocate ( SEDBED(ng) % ad_bed_thick(LBi:UBi,LBj:UBj,1:3) ) # endif # ifdef BEDLOAD allocate ( SEDBED(ng) % ad_bedldu(LBi:UBi,LBj:UBj,NST) ) @@ -261,7 +338,7 @@ allocate ( SEDBED(ng) % ad_settling_flux(LBi:UBi,LBj:UBj,NST) ) # endif #endif -! + RETURN END SUBROUTINE allocate_sedbed ! @@ -566,6 +643,17 @@ SEDBED(ng) % bedldv(i,j,itrc) = IniVal END DO END DO +# ifdef BEDLOAD_VANDERA + DO i=Imin,Imax + SEDBED(ng) % ursell_no(i,j) = IniVal + SEDBED(ng) % RR_asymwave(i,j) = IniVal + SEDBED(ng) % beta_asymwave(i,j)= IniVal + SEDBED(ng) % ucrest_r(i,j) = IniVal + SEDBED(ng) % utrough_r(i,j) = IniVal + SEDBED(ng) % T_crest(i,j) = IniVal + SEDBED(ng) % T_trough(i,j) = IniVal + END DO +# endif #endif DO itrc=1,MBOTP DO i=Imin,Imax @@ -579,6 +667,13 @@ SEDBED(ng) % settling_flux(i,j,itrc) = IniVal END DO END DO +#endif +#if defined SEDIMENT && defined SED_BIOMASS + DO itrc=1,24 + DO i=Imin,Imax + SEDBED(ng) % Dstp_max(i,j,itrc) = 0.1_r8 + END DO + END DO #endif END DO END IF diff --git a/ROMS/Nonlinear/Sediment/sedflocs_mod.h b/ROMS/Nonlinear/Sediment/sedflocs_mod.h new file mode 100644 index 00000000..ce20f8a0 --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sedflocs_mod.h @@ -0,0 +1,525 @@ +! +!git $Id$ +!================================================== Hernan G. Arango === +! Copyright (c) 2002-2024 The ROMS/TOMS Group John C. Warner ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! Sediment Floc Model Kernel Variables: ! +! ! +#if defined SED_FLOCS +! bottom Exposed sediment layer properties: ! +! bottom(:,:,isd50) => mean grain diameter ! +! bottom(:,:,idens) => mean grain density ! +! bottom(:,:,iwsed) => mean settling velocity ! +! bottom(:,:,itauc) => mean critical erosion stress ! +#endif +! ! +!======================================================================= +! + USE mod_kinds +! + implicit none +! + logical :: l_ASH + logical :: l_ADS + logical :: l_COLLFRAG + logical :: l_testcase + integer :: f_ero_iv + real(r8) :: f_dp0,f_alpha,f_beta,f_nb_frag + real(r8) :: f_dmax,f_ater,f_clim + real(r8) :: f_ero_frac,f_ero_nbfrag + real(r8) :: f_nf + real(r8) :: f_frag + real(r8) :: f_fter + real(r8) :: f_collfragparam + real(r8), parameter :: rhoref = 1030.0_r8 +! + TYPE T_SEDFLOCS +! +#if defined SEDIMENT + real(r8), pointer :: f_diam(:) + real(r8), pointer :: f_vol(:) + real(r8), pointer :: f_rho(:) + real(r8), pointer :: f_cv(:) + real(r8), pointer :: f_l3(:) + real(r8), pointer :: f_mass(:) + real(r8), pointer :: f_coll_prob_sh(:,:) + real(r8), pointer :: f_coll_prob_ds(:,:) + real(r8), pointer :: f_l1_sh(:,:) + real(r8), pointer :: f_l1_ds(:,:) + real(r8), pointer :: f_g3(:,:) + real(r8), pointer :: f_l4(:,:) + real(r8), pointer :: f_g1_sh(:,:,:) + real(r8), pointer :: f_g1_ds(:,:,:) + real(r8), pointer :: f_g4(:,:,:) +#endif + + END TYPE T_SEDFLOCS + + TYPE (T_SEDFLOCS), allocatable :: SEDFLOCS(:) + + CONTAINS + + SUBROUTINE allocate_sedflocs (ng, LBi, UBi, LBj, UBj) +! +!======================================================================= +! ! +! This routine allocates all variables in the module for all nested ! +! grids. ! +! ! +!======================================================================= +! + USE mod_param + USE mod_sediment +! +! Imported variable declarations. +! + integer, intent(in) :: ng, LBi, UBi, LBj, UBj +! +!----------------------------------------------------------------------- +! Allocate structure variables. +!----------------------------------------------------------------------- +! + IF (ng.eq.1) allocate ( SEDFLOCS(Ngrids) ) +! +! Nonlinear model state. +! +#if defined SEDIMENT + allocate ( SEDFLOCS(ng) % f_diam(NCS) ) + allocate ( SEDFLOCS(ng) % f_vol(NCS) ) + allocate ( SEDFLOCS(ng) % f_rho(NCS) ) + allocate ( SEDFLOCS(ng) % f_cv(NCS) ) + allocate ( SEDFLOCS(ng) % f_l3(NCS) ) + allocate ( SEDFLOCS(ng) % f_mass(0:NCS+1) ) + allocate ( SEDFLOCS(ng) % f_coll_prob_sh(NCS,NCS) ) + allocate ( SEDFLOCS(ng) % f_coll_prob_ds(NCS,NCS) ) + allocate ( SEDFLOCS(ng) % f_l1_sh(NCS,NCS) ) + allocate ( SEDFLOCS(ng) % f_l1_ds(NCS,NCS) ) + allocate ( SEDFLOCS(ng) % f_g3(NCS,NCS) ) + allocate ( SEDFLOCS(ng) % f_l4(NCS,NCS) ) + allocate ( SEDFLOCS(ng) % f_g1_sh(NCS,NCS,NCS) ) + allocate ( SEDFLOCS(ng) % f_g1_ds(NCS,NCS,NCS) ) + allocate ( SEDFLOCS(ng) % f_g4(NCS,NCS,NCS) ) +#endif + + + RETURN + END SUBROUTINE allocate_sedflocs + + SUBROUTINE initialize_sedflocs (ng, tile, model) +! +!======================================================================= +! ! +! This routine initialize structure variables in the module using ! +! first touch distribution policy. In shared-memory configuration, ! +! this operation actually performs the propagation of the "shared ! +! arrays" across the cluster, unless another policy is specified ! +! to override the default. ! +! ! +!======================================================================= +! + USE mod_param + USE mod_sediment +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile, model +! +! Local variable declarations. +! + integer :: Imin, Imax, Jmin, Jmax + integer :: i, itrc, j, k + + real(r8), parameter :: IniVal = 0.0_r8 + +#include "set_bounds.h" +! +! Set array initialization range. +! +#ifdef _OPENMP + IF (DOMAIN(ng)%Western_Edge(tile)) THEN + Imin=BOUNDS(ng)%LBi(tile) + ELSE + Imin=Istr + END IF + IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN + Imax=BOUNDS(ng)%UBi(tile) + ELSE + Imax=Iend + END IF + IF (DOMAIN(ng)%Southern_Edge(tile)) THEN + Jmin=BOUNDS(ng)%LBj(tile) + ELSE + Jmin=Jstr + END IF + IF (DOMAIN(ng)%Northern_Edge(tile)) THEN + Jmax=BOUNDS(ng)%UBj(tile) + ELSE + Jmax=Jend + END IF +#else + Imin=BOUNDS(ng)%LBi(tile) + Imax=BOUNDS(ng)%UBi(tile) + Jmin=BOUNDS(ng)%LBj(tile) + Jmax=BOUNDS(ng)%UBj(tile) +#endif +! +!----------------------------------------------------------------------- +! Initialize sediment structure variables. +!----------------------------------------------------------------------- +! +! Nonlinear model state. +! + IF ((model.eq.0).or.(model.eq.iNLM)) THEN + CALL initialize_sedflocs_param (ng, tile, & + & SEDFLOCS(ng) % f_mass, & + & SEDFLOCS(ng) % f_diam, & + & SEDFLOCS(ng) % f_g1_sh, & + & SEDFLOCS(ng) % f_g1_ds, & + & SEDFLOCS(ng) % f_g3, & + & SEDFLOCS(ng) % f_l1_sh, & + & SEDFLOCS(ng) % f_l1_ds, & + & SEDFLOCS(ng) % f_coll_prob_sh, & + & SEDFLOCS(ng) % f_coll_prob_ds, & + & SEDFLOCS(ng) % f_l3) +! + END IF +! + RETURN + END SUBROUTINE initialize_sedflocs +! +!*********************************************************************** + SUBROUTINE initialize_sedflocs_param (ng, tile, & + & f_mass,f_diam,f_g1_sh, & + & f_g1_ds,f_g3,f_l1_sh,f_l1_ds, & + & f_coll_prob_sh,f_coll_prob_ds, & + & f_l3) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment +! + implicit none +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + real(r8), intent(inout) :: f_mass(0:NCS+1) + real(r8), intent(inout) :: f_diam(NCS) + real(r8), intent(inout) :: f_g1_sh(NCS,NCS,NCS) + real(r8), intent(inout) :: f_g1_ds(NCS,NCS,NCS) + real(r8), intent(inout) :: f_g3(NCS,NCS) + real(r8), intent(inout) :: f_l1_sh(NCS,NCS) + real(r8), intent(inout) :: f_l1_ds(NCS,NCS) + real(r8), intent(inout) :: f_coll_prob_sh(NCS,NCS) + real(r8), intent(inout) :: f_coll_prob_ds(NCS,NCS) + real(r8), intent(inout) :: f_l3(NCS) +! +! Local variable declarations. +! + logical :: f_test + real(r8) :: f_weight,mult,dfragmax + integer :: iv1,iv2,iv3,iv,itrc + real(r8) :: f_vol(NCS),f_rho(NCS) + real(r8), parameter :: mu = 0.001_r8 + real(r8) :: eps + eps = epsilon(1.0) +! +! ALA the rest of the initialization +! +! l_ADS=.false. +! l_ASH=.true. +! l_COLLFRAG=.false. +! f_dp0=0.000004_r8 +! f_nf=1.9_r8 +! f_dmax=0.001500_r8 +! f_nb_frag=2.0_r8 +! f_alpha=0.35_r8 +! f_beta=0.15_r8 +! f_ater=0.0_r8 +! f_ero_frac=0.0_r8 +! f_ero_nbfrag=2.0_r8 +! f_ero_iv=1 +! f_collfragparam=0.01_r8 + + +!!-------------------------------------------------- +!! floc characteristics + DO itrc=1,NCS + f_diam(itrc)=Sd50(itrc,ng) + f_vol(itrc)=pi/6.0_r8*(f_diam(itrc))**3.0_r8 + f_rho(itrc)=rhoref+(2650.0_r8-rhoref)* & + & (f_dp0/f_diam(itrc))**(3.0_r8-f_nf) + f_mass(itrc)=f_vol(itrc)*(f_rho(itrc)-rhoref) + ENDDO + f_mass(NCS+1)=f_mass(NCS)*2.0_r8+1.0_r8 + IF (f_diam(1).eq.f_dp0) THEN + f_mass(1)=f_vol(1)*Srho(1,ng) + ENDIF +!TODO - This wont parallelize + WRITE(*,*) ' ' + WRITE(*,*) '*** FLOCMOD INIT *** ' + write(*,*) 'NAT, NPT, NCS, NNS:', NAT,NPT,NCS,NNS + WRITE(*,*) 'class diameter (um) volume (m3) density (kg/m3) mass (kg)' + DO itrc=1,NCS + WRITE(*,*) itrc,f_diam(itrc)*1e6,f_vol(itrc),f_rho(itrc),f_mass(itrc) + ENDDO + write(*,*) 'f_mass(0) and f_mass(NCS+1): ',f_mass(0),f_mass(NCS+1) + WRITE(*,*) ' ' + WRITE(*,*) ' *** PARAMETERS ***' + WRITE(*,*) 'Primary particle size (f_dp0) : ',f_dp0 + WRITE(*,*) 'Fractal dimension (f_nf) : ',f_nf + WRITE(*,*) 'Flocculation efficiency (f_alpha) : ',f_alpha + WRITE(*,*) 'Floc break up parameter (f_beta) : ',f_beta + WRITE(*,*) 'Nb of fragments (f_nb_frag) : ',f_nb_frag + WRITE(*,*) 'Ternary fragmentation (f_ater) : ',f_ater + WRITE(*,*) 'Floc erosion (% of mass) (f_ero_frac) : ',f_ero_frac + WRITE(*,*) 'Nb of fragments by erosion (f_ero_nbfrag) : ',f_ero_nbfrag + WRITE(*,*) 'fragment class (f_ero_iv) : ',f_ero_iv +! WRITE(*,*) 'negative mass tolerated before redistribution (f_mneg_param) : ',f_mneg_param + WRITE(*,*) 'Boolean for differential settling aggregation (L_ADS) : ',l_ADS + WRITE(*,*) 'Boolean for shear aggregation (L_ASH) : ',l_ASH + WRITE(*,*) 'Boolean for collision fragmenation (L_COLLFRAG) : ',l_COLLFRAG + WRITE(*,*) 'Collision fragmentation parameter (f_collfragparam) : ',f_collfragparam + WRITE(*,*) 'Boolean for test case from Verney (L_TESTCASE) : ',l_testcase + WRITE(*,*) ' ' + WRITE(*,*) 'Value of eps : ',eps + WRITE(*,*) ' ' + +! kernels computation former SUBROUTINE flocmod_kernels + + +!!-------------------------------------------------------------------------- +!! * Executable part + f_test=.true. + dfragmax=0.00003_r8 +! compute collision probability former SUBROUTINE flocmod_agregation_statistics + + DO iv1=1,NCS + DO iv2=1,NCS + + f_coll_prob_sh(iv1,iv2)=1.0_r8/6.0_r8*(f_diam(iv1)+ & + & f_diam(iv2))**3.0_r8 + + f_coll_prob_ds(iv1,iv2)=0.25_r8*pi*(f_diam(iv1)+ & + & f_diam(iv2))**2.0_r8*g/mu*abs((f_rho(iv1)- & + & rhoref)*f_diam(iv1)**2.0_r8-(f_rho(iv2)-rhoref)* & + & f_diam(iv2)**2.0_r8) + + ENDDO + ENDDO + + !******************************************************************************** + ! agregation : GAIN : f_g1_sh and f_g1_ds + !******************************************************************************** + DO iv1=1,NCS + DO iv2=1,NCS + DO iv3=iv2,NCS + IF((f_mass(iv2)+f_mass(iv3)) .gt. f_mass(iv1-1) .and. & + & ((f_mass(iv2)+f_mass(iv3)) .le. f_mass(iv1))) THEN + + f_weight=(f_mass(iv2)+f_mass(iv3)-f_mass(iv1-1))/ & + & (f_mass(iv1)-f_mass(iv1-1)) + + ELSEIF ((f_mass(iv2)+f_mass(iv3)) .gt. f_mass(iv1) .and. & + & ((f_mass(iv2)+f_mass(iv3)) .lt. f_mass(iv1+1))) THEN + + IF (iv1 .eq. NCS) THEN + f_weight=1.0_r8 + ELSE + f_weight=1.0_r8-(f_mass(iv2)+f_mass(iv3)- & + & f_mass(iv1))/(f_mass(iv1+1)-f_mass(iv1)) + ENDIF + + ELSE + f_weight=0.0_r8 + ENDIF + + f_g1_sh(iv2,iv3,iv1)=f_weight*f_alpha* & + & f_coll_prob_sh(iv2,iv3)*(f_mass(iv2)+ & + & f_mass(iv3))/f_mass(iv1) + f_g1_ds(iv2,iv3,iv1)=f_weight*f_alpha* & + & f_coll_prob_ds(iv2,iv3)*(f_mass(iv2)+ & + & f_mass(iv3))/f_mass(iv1) + + ENDDO + ENDDO + ENDDO + + !******************************************************************************** + ! Shear fragmentation : GAIN : f_g3 + !******************************************************************************** + + DO iv1=1,NCS + DO iv2=iv1,NCS + + IF (f_diam(iv2).gt.dfragmax) THEN + ! binary fragmentation + + IF (f_mass(iv2)/f_nb_frag .gt. f_mass(iv1-1) & + .and. f_mass(iv2)/f_nb_frag .le. f_mass(iv1)) THEN + + IF (iv1 .eq. 1) THEN + f_weight=1.0_r8 + ELSE + f_weight=(f_mass(iv2)/f_nb_frag-f_mass(iv1-1))/ & + & (f_mass(iv1)-f_mass(iv1-1)) + ENDIF + + ELSEIF (f_mass(iv2)/f_nb_frag .gt. f_mass(iv1) & + & .and. f_mass(iv2)/f_nb_frag .lt. f_mass(iv1+1)) THEN + + f_weight=1.0_r8-(f_mass(iv2)/f_nb_frag-f_mass(iv1))/ & + & (f_mass(iv1+1)-f_mass(iv1)) + + ELSE + + f_weight=0.0_r8 + + ENDIF + + ELSE + f_weight=0.0_r8 + ENDIF + + f_g3(iv2,iv1)=f_g3(iv2,iv1)+(1.0_r8-f_ero_frac)*(1.0_r8- & + & f_ater)*f_weight*f_beta*f_diam(iv2)*((f_diam(iv2)- & + & f_dp0)/f_dp0)**(3.0_r8-f_nf)*f_mass(iv2)/ & + & f_mass(iv1) + + ! ternary fragmentation + IF (f_diam(iv2).gt.dfragmax) THEN + IF (f_mass(iv2)/(2.0_r8*f_nb_frag) .gt. f_mass(iv1-1) .and. & + & f_mass(iv2)/(2.0_r8*f_nb_frag) .le. f_mass(iv1)) THEN + + IF (iv1 .eq. 1) THEN + f_weight=1.0_r8 + ELSE + f_weight=(f_mass(iv2)/(2.0_r8*f_nb_frag)- & + & f_mass(iv1-1))/(f_mass(iv1)-f_mass(iv1-1)) + ENDIF + + ELSEIF (f_mass(iv2)/(2.0_r8*f_nb_frag) .gt. f_mass(iv1) & + & .and. f_mass(iv2)/(2.0_r8*f_nb_frag) .lt. & + & f_mass(iv1+1)) THEN + + f_weight=1.0_r8-(f_mass(iv2)/(2.0_r8*f_nb_frag)- & + & f_mass(iv1))/(f_mass(iv1+1)-f_mass(iv1)) + + ELSE + f_weight=0.0_r8 + + ENDIF + ! update for ternary fragments + f_g3(iv2,iv1)=f_g3(iv2,iv1)+(1.0_r8-f_ero_frac)*(f_ater)* & + & f_weight*f_beta*f_diam(iv2)*((f_diam(iv2)-f_dp0)/ & + & f_dp0)**(3.0_r8-f_nf)*f_mass(iv2)/f_mass(iv1) + + ! Floc erosion + + IF ((f_mass(iv2)-f_mass(f_ero_iv)*f_ero_nbfrag) .gt. & + & f_mass(f_ero_iv)) THEN + + IF (((f_mass(iv2)-f_mass(f_ero_iv)*f_ero_nbfrag) .gt. & + & f_mass(iv1-1)) .and. (f_mass(iv2)-f_mass(f_ero_iv)* & + & f_ero_nbfrag) .le. f_mass(iv1)) THEN + + IF (iv1 .eq. 1) THEN + f_weight=1.0_r8 + ELSE + f_weight=(f_mass(iv2)-f_mass(f_ero_iv)* & + & f_ero_nbfrag-f_mass(iv1-1))/(f_mass(iv1)- & + & f_mass(iv1-1)) + ENDIF + + ELSEIF ((f_mass(iv2)-f_mass(f_ero_iv)*f_ero_nbfrag) .gt. & + & f_mass(iv1) .and. (f_mass(iv2)-f_mass(f_ero_iv)* & + & f_ero_nbfrag) .lt. f_mass(iv1+1)) THEN + + f_weight=1.0_r8-(f_mass(iv2)-f_mass(f_ero_iv)* & + & f_ero_nbfrag-f_mass(iv1))/(f_mass(iv1+1)- & + & f_mass(iv1)) + + ELSE + f_weight=0.0_r8 + ENDIF + + ! update for eroded floc masses + + f_g3(iv2,iv1)=f_g3(iv2,iv1)+f_ero_frac*f_weight*f_beta* & + & f_diam(iv2)*(max(eps,(f_diam(iv2)-f_dp0))/f_dp0)** & + & (3.0_r8-f_nf)*(f_mass(iv2)-f_mass(f_ero_iv)* & + & f_ero_nbfrag)/f_mass(iv1) + + IF (iv1 .eq. f_ero_iv) THEN + + f_g3(iv2,iv1)=f_g3(iv2,iv1)+f_ero_frac*f_beta* & + & f_diam(iv2)*(max(eps,(f_diam(iv2)-f_dp0))/f_dp0)** & + & (3.0_r8-f_nf)*f_ero_nbfrag*f_mass(f_ero_iv)/ & + & f_mass(iv1) + ENDIF + ENDIF + ENDIF ! condition on dfragmax + ENDDO + ENDDO + + !******************************************************************************** + ! Shear agregation : LOSS : f_l1 + !******************************************************************************** + + DO iv1=1,NCS + DO iv2=1,NCS + + IF(iv2 .eq. iv1) THEN + mult=2.0_r8 + ELSE + mult=1.0_r8 + ENDIF + + f_l1_sh(iv2,iv1)=mult*f_alpha*f_coll_prob_sh(iv2,iv1) + f_l1_ds(iv2,iv1)=mult*f_alpha*f_coll_prob_ds(iv2,iv1) + + ENDDO + ENDDO + + !******************************************************************************** + ! Shear fragmentation : LOSS : f_l2 + !******************************************************************************** + + DO iv1=1,NCS + f_l3(iv1)=0.0_r8 + IF (f_diam(iv1).gt.dfragmax) THEN + ! shear fragmentation + f_l3(iv1)=f_l3(iv1)+(1.0_r8-f_ero_frac)*f_beta*f_diam(iv1)* & + & ((f_diam(iv1)-f_dp0)/f_dp0)**(3.0_r8-f_nf) + + ! shear erosion + IF ((f_mass(iv1)-f_mass(f_ero_iv)*f_ero_nbfrag) .gt. & + & f_mass(f_ero_iv)) THEN + f_l3(iv1)=f_l3(iv1)+f_ero_frac*f_beta*f_diam(iv1)* & + & ((f_diam(iv1)-f_dp0)/f_dp0)**(3.0_r8-f_nf) + ENDIF + ENDIF + ENDDO + + WRITE(*,*) ' ' + write(*,*) 'Sum of kernal coefficients:' + write(*,*) 'f_coll_prob_sh',sum(f_coll_prob_sh) + write(*,*) 'f_coll_prob_ds',sum(f_coll_prob_ds) + write(*,*) 'f_g1_sh',sum(f_g1_sh) + write(*,*) 'f_g1_ds',sum(f_g1_ds) + write(*,*) 'f_l1_sh',sum(f_l1_sh) + write(*,*) 'f_l1_ds',sum(f_l1_ds) + write(*,*) 'f_g3',sum(f_g3) + write(*,*) 'f_l3',sum(f_l3) + WRITE(*,*) ' ' + WRITE(*,*) '*** END FLOCMOD INIT *** ' + + +! END FORMER SUBROUTINE flocmod_kernels + + RETURN + END SUBROUTINE initialize_sedflocs_param diff --git a/ROMS/Nonlinear/Sediment/sediment.F b/ROMS/Nonlinear/Sediment/sediment.F index 3bbedc3b..3caba754 100644 --- a/ROMS/Nonlinear/Sediment/sediment.F +++ b/ROMS/Nonlinear/Sediment/sediment.F @@ -77,21 +77,39 @@ MODULE sediment_mod SUBROUTINE sediment (ng, tile) !*********************************************************************** ! -# if defined COHESIVE_BED -!! USE sed_bed_cohesive_mod, ONLY : sed_bed_cohesive +# if defined COHESIVE_BED || defined MIXED_BED + USE sed_bed_cohesive_mod, ONLY : sed_bed_cohesive +# elif defined NONCOHESIVE_BED2 + USE sed_bed_mod2, ONLY : sed_bed2 # else USE sed_bed_mod, ONLY : sed_bed # endif -# ifdef BEDLOAD +# if defined BEDLOAD +# if defined BEDLOAD_SOULSBY || defined BEDLOAD_MPM USE sed_bedload_mod, ONLY : sed_bedload +# elif defined BEDLOAD_VANDERA + USE mod_vandera_funcs + USE sed_bedload_vandera_mod, ONLY : sed_bedload_vandera +# endif # endif # if defined SED_BIODIFF -!! USE sed_biodiff_mod, ONLY : sed_biodiff + USE sed_biodiff_mod, ONLY : sed_biodiff # endif # ifdef SUSPLOAD USE sed_fluxes_mod, ONLY : sed_fluxes USE sed_settling_mod, ONLY : sed_settling +# if defined SED_FLOCS + USE sed_flocs_mod, ONLY : sed_flocmod +# endif +# endif +# if defined SEDTR_REACTIONS +# if defined SEDBIO_COUP + USE sedtr_reactions_pom_mod, ONLY : sedtr_reactions_pom +# elif defined SEDTR_DECAY + USE sedtr_decay_mod, ONLY : sedtr_decay +# endif # endif +! USE sed_surface_mod, ONLY : sed_surface ! ! Imported variable declarations. @@ -104,10 +122,22 @@ SUBROUTINE sediment (ng, tile) ! Compute sediment bedload transport. !----------------------------------------------------------------------- ! +# if defined BEDLOAD_SOULSBY || defined BEDLOAD_MPM CALL sed_bedload (ng, tile) +# elif defined BEDLOAD_VANDERA + CALL sed_bedload_vandera(ng, tile) +# endif # endif # ifdef SUSPLOAD +# ifdef SED_FLOCS +! +!----------------------------------------------------------------------- +! Compute sediment flocculation +!----------------------------------------------------------------------- +! + CALL sed_flocmod (ng, tile) +# endif ! !----------------------------------------------------------------------- ! Compute sediment vertical settling. @@ -120,25 +150,39 @@ SUBROUTINE sediment (ng, tile) !----------------------------------------------------------------------- ! CALL sed_fluxes (ng, tile) +! # endif ! !----------------------------------------------------------------------- ! Compute sediment bed stratigraphy. !----------------------------------------------------------------------- ! -# if defined COHESIVE_BED -!! CALL sed_bed_cohesive (ng, tile) +# if defined COHESIVE_BED || defined MIXED_BED + CALL sed_bed_cohesive (ng, tile) +# elif defined NONCOHESIVE_BED2 + CALL sed_bed2 (ng, tile) # else CALL sed_bed (ng, tile) # endif - -# if defined SED_BIODIFF ! !----------------------------------------------------------------------- ! Compute sediment bed biodiffusivity. !----------------------------------------------------------------------- ! -!! CALL sed_biodiff (ng, tile) +# if defined SED_BIODIFF + CALL sed_biodiff (ng, tile) +# endif +! +!----------------------------------------------------------------------- +! Compute reactive sediment terms. +!----------------------------------------------------------------------- +! +# if defined SEDTR_REACTIONS +# if defined SEDBIO_COUP + CALL sedtr_reactions_pom (ng, tile) +# elif defined SEDTR_DECAY + CALL sedtr_decay (ng, tile) +# endif # endif ! !----------------------------------------------------------------------- diff --git a/ROMS/Nonlinear/Sediment/sediment_def.h b/ROMS/Nonlinear/Sediment/sediment_def.h index 3f502a09..d47be1db 100644 --- a/ROMS/Nonlinear/Sediment/sediment_def.h +++ b/ROMS/Nonlinear/Sediment/sediment_def.h @@ -31,17 +31,68 @@ & 1, (/0/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - +! + Vinfo( 1)='sg_zwbl' + Vinfo( 2)='input elevation to get near-bottom current vel.' + status=def_var(ng, model, ncid, varid, NF_TYPE, & + & 1, (/0/), Aval, Vinfo, ncname, & + & SetParAccess = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! #ifdef BEDLOAD Vinfo( 1)='bedload_coeff' Vinfo( 2)='bedload transport rate coefficient' status=def_var(ng, model, ncid, varid, NF_TYPE, & & 1, (/0/), Aval, Vinfo, ncname, & + & SetParAccess = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, & + & __FILE__)) RETURN +! + Vinfo( 1)='sedslope_crit_wet' + Vinfo( 2)='critical wet bed slope for slumping.' + status=def_var(ng, model, ncid, varid, NF_TYPE, & + & 1, (/0/), Aval, Vinfo, ncname, & + & SetParAccess = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! + Vinfo( 1)='sedslope_crit_dry' + Vinfo( 2)='critical dry bed slope for slumping.' + status=def_var(ng, model, ncid, varid, NF_TYPE, & + & 1, (/0/), Aval, Vinfo, ncname, & + & SetParAccess = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! + Vinfo( 1)='slopefac_wet' + Vinfo( 2)='bedload wet bed slumping factor.' + status=def_var(ng, model, ncid, varid, NF_TYPE, & + & 1, (/0/), Aval, Vinfo, ncname, & + & SetParAccess = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! + Vinfo( 1)='slopefac_dry' + Vinfo( 2)='bedload dry bed slumping factor.' + status=def_var(ng, model, ncid, varid, NF_TYPE, & + & 1, (/0/), Aval, Vinfo, ncname, & + & SetParAccess = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! + Vinfo( 1)='bedload_vandera_alphac' + Vinfo( 2)='bedload scale factor for currents contribution.' + status=def_var(ng, model, ncid, varid, NF_TYPE, & + & 1, (/0/), Aval, Vinfo, ncname, & + & SetParAccess = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! + Vinfo( 1)='bedload_vandera_alphaw' + Vinfo( 2)='bedload scale factor for waves contribution.' + status=def_var(ng, model, ncid, varid, NF_TYPE, & + & 1, (/0/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! #endif - -#ifdef ANA_SEDIMENT +! +!#ifdef ANA_SEDIMENT Vinfo( 1)='Sd50' Vinfo( 2)='median sediment grain diameter used in '// & & 'uniform initial conditions' @@ -68,7 +119,7 @@ & 1, (/seddim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN -#endif +!#endif Vinfo( 1)='Wsed' Vinfo( 2)='sediment particle settling velocity' diff --git a/ROMS/Nonlinear/Sediment/sediment_inp.h b/ROMS/Nonlinear/Sediment/sediment_inp.h index 04df8dda..7a835a3a 100644 --- a/ROMS/Nonlinear/Sediment/sediment_inp.h +++ b/ROMS/Nonlinear/Sediment/sediment_inp.h @@ -13,7 +13,7 @@ USE mod_ncparam USE mod_scalars USE mod_sediment -! + USE mod_sedflocs USE inp_decode_mod ! implicit none @@ -65,33 +65,6 @@ SELECT CASE (TRIM(KeyWord)) CASE ('Lsediment') Npts=load_l(Nval, Cval, Ngrids, Lsediment) - CASE ('NEWLAYER_THICK') - Npts=load_r(Nval, Rval, Ngrids, Rbed) - DO ng=1,Ngrids - newlayer_thick(ng)=Rbed(ng) - END DO - CASE ('MINLAYER_THICK') - Npts=load_r(Nval, Rval, Ngrids, Rbed) - DO ng=1,Ngrids - minlayer_thick(ng)=Rbed(ng) - END DO -#ifdef MIXED_BED - CASE ('TRANSC') - Npts=load_r(Nval, Rval, Ngrids, Rbed) - DO ng=1,Ngrids - transC(ng)=Rbed(ng) - END DO - CASE ('TRANSN') - Npts=load_r(Nval, Rval, Ngrids, Rbed) - DO ng=1,Ngrids - transN(ng)=Rbed(ng) - END DO -#endif - CASE ('BEDLOAD_COEFF') - Npts=load_r(Nval, Rval, Ngrids, Rbed) - DO ng=1,Ngrids - bedload_coeff(ng)=Rbed(ng) - END DO CASE ('Hadvection') IF (itracer.lt.NST) THEN itracer=itracer+1 @@ -160,226 +133,592 @@ & idsed(iTrcStr), idsed(iTrcEnd), & & Vname(1,idTvar(idsed(itracer))), ad_LBC) #endif - CASE ('MUD_SD50') - IF (.not.allocated(Sd50)) allocate (Sd50(NST,Ngrids)) - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('NEWLAYER_THICK') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - DO itrc=1,NCS - Sd50(itrc,ng)=Rmud(itrc,ng) - END DO + newlayer_thick(ng)=Rbed(ng) END DO - CASE ('MUD_CSED') - IF (.not.allocated(Csed)) allocate (Csed(NST,Ngrids)) - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud ) + CASE ('MINLAYER_THICK') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - DO itrc=1,NCS - Csed(itrc,ng)=Rmud(itrc,ng) - END DO + minlayer_thick(ng)=Rbed(ng) END DO - CASE ('MUD_SRHO') - IF (.not.allocated(Srho)) allocate (Srho(NST,Ngrids)) - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('BEDLOAD_COEFF') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - DO itrc=1,NCS - Srho(itrc,ng)=Rmud(itrc,ng) - END DO + bedload_coeff(ng)=Rbed(ng) END DO - CASE ('MUD_WSED') - IF (.not.allocated(Wsed)) allocate (Wsed(NST,Ngrids)) - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) +#ifdef SED_BIODIFF + CASE ('DBMAX') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - DO itrc=1,NCS - Wsed(itrc,ng)=Rmud(itrc,ng) - END DO + Dbmx(ng)=Rbed(ng) END DO - CASE ('MUD_ERATE') - IF (.not.allocated(Erate)) allocate (Erate(NST,Ngrids)) - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('DBMIN') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - DO itrc=1,NCS - Erate(itrc,ng)=Rmud(itrc,ng) - END DO + Dbmm(ng)=Rbed(ng) END DO - CASE ('MUD_TAU_CE') - IF (.not.allocated(tau_ce)) allocate (tau_ce(NST,Ngrids)) - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('DBZS') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - DO itrc=1,NCS - tau_ce(itrc,ng)=Rmud(itrc,ng) - END DO + Dbzs(ng)=Rbed(ng) END DO - CASE ('MUD_TAU_CD') - IF (.not.allocated(tau_cd)) allocate (tau_cd(NST,Ngrids)) - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('DBZM') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - DO itrc=1,NCS - tau_cd(itrc,ng)=Rmud(itrc,ng) - END DO + Dbzm(ng)=Rbed(ng) END DO - CASE ('MUD_POROS') - IF (.not.allocated(poros)) allocate (poros(NST,Ngrids)) - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('DBZP') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - DO itrc=1,NCS - poros(itrc,ng)=Rmud(itrc,ng) + Dbzp(ng)=Rbed(ng) + END DO +#endif + CASE ('SG_ZWBL') + Npts=load_r(Nval, Rval, Ngrids, Rbed) + DO ng=1,Ngrids + sg_zwbl(ng)=Rbed(ng) + END DO +#ifdef BEDLOAD + CASE ('SEDSLOPE_CRIT_WET') + Npts=load_r(Nval, Rval, Ngrids, Rbed) + DO ng=1,Ngrids + sedslope_crit_wet(ng)=Rbed(ng) + END DO + CASE ('SEDSLOPE_CRIT_DRY') + Npts=load_r(Nval, Rval, Ngrids, Rbed) + DO ng=1,Ngrids + sedslope_crit_dry(ng)=Rbed(ng) END DO + CASE ('SLOPEFAC_WET') + Npts=load_r(Nval, Rval, Ngrids, Rbed) + DO ng=1,Ngrids + slopefac_wet(ng)=Rbed(ng) + END DO + CASE ('SLOPEFAC_DRY') + Npts=load_r(Nval, Rval, Ngrids, Rbed) + DO ng=1,Ngrids + slopefac_dry(ng)=Rbed(ng) + END DO + CASE ('BEDLOAD_VANDERA_ALPHAW') + Npts=load_r(Nval, Rval, Ngrids, Rbed) + DO ng=1,Ngrids + bedload_vandera_alphaw(ng)=Rbed(ng) + END DO + CASE ('BEDLOAD_VANDERA_ALPHAC') + Npts=load_r(Nval, Rval, Ngrids, Rbed) + DO ng=1,Ngrids + bedload_vandera_alphac(ng)=Rbed(ng) + END DO +#endif + CASE ('Hout(ithck)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(ithck) + DO ng=1,Ngrids + Hout(i,ng)=Lbed(ng) END DO - CASE ('MUD_TNU2') - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('Hout(iaged)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(iaged) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - nl_tnu2(i,ng)=Rmud(itrc,ng) - END DO + Hout(i,ng)=Lbed(ng) END DO - CASE ('MUD_TNU4') - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('Hout(iporo)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(iporo) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - nl_tnu4(i,ng)=Rmud(itrc,ng) - END DO + Hout(i,ng)=Lbed(ng) END DO - CASE ('ad_MUD_TNU2') - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('Hout(idiff)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(idiff) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - ad_tnu2(i,ng)=Rmud(itrc,ng) - tl_tnu2(i,ng)=Rmud(itrc,ng) + Hout(i,ng)=Lbed(ng) + END DO +# ifdef BEDLOAD_VANDERA + CASE ('Hout(idsurs)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsurs + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('ad_MUD_TNU4') - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('Hout(idsrrw)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - ad_tnu4(i,ng)=Rmud(itrc,ng) - tl_tnu4(i,ng)=Rmud(itrc,ng) + DO itrc=1,NNS + i=idsrrw + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('MUD_Sponge') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Hout(idsbtw)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - LtracerSponge(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idsbtw + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('MUD_AKT_BAK') - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('Hout(idsucr)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - Akt_bak(i,ng)=Rmud(itrc,ng) + DO itrc=1,NNS + i=idsucr + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('MUD_AKT_fac') - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('Hout(idsutr)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - ad_Akt_fac(i,ng)=Rmud(itrc,ng) - tl_Akt_fac(i,ng)=Rmud(itrc,ng) + DO itrc=1,NNS + i=idsutr + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('MUD_TNUDG') - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('Hout(idstcr)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - Tnudg(i,ng)=Rmud(itrc,ng) + DO itrc=1,NNS + i=idstcr + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('MUD_MORPH_FAC') - IF (.not.allocated(morph_fac)) THEN - allocate (morph_fac(NST,Ngrids)) - END IF - Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + CASE ('Hout(idsttr)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - morph_fac(itrc,ng)=Rmud(itrc,ng) + DO itrc=1,NNS + i=idsttr + Hout(i,ng)=Lsand(itrc,ng) END DO END DO -#if defined COHESIVE_BED || defined MIXED_BED - CASE ('MUD_TAUCR_MIN') - Npts=load_r(Nval, Rval, Ngrids, Rbed) +# endif + CASE ('Hout(isd50)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(isd50) DO ng=1,Ngrids - tcr_min(ng)=Rbed(ng) + Hout(i,ng)=Lbottom(ng) END DO - CASE ('MUD_TAUCR_MAX') - Npts=load_r(Nval, Rval, Ngrids, Rbed) + CASE ('Hout(idens)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idens) DO ng=1,Ngrids - tcr_max(ng)=Rbed(ng) + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(iwsed)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(iwsed) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) END DO - CASE ('MUD_TAUCR_SLOPE') - Npts=load_r(Nval, Rval, Ngrids, Rbed) + CASE ('Hout(itauc)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(itauc) DO ng=1,Ngrids - tcr_slp(ng)=Rbed(ng) + Hout(i,ng)=Lbottom(ng) END DO - CASE ('MUD_TAUCR_OFF') - Npts=load_r(Nval, Rval, Ngrids, Rbed) + CASE ('Hout(irlen)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(irlen) DO ng=1,Ngrids - tcr_off(ng)=Rbed(ng) + Hout(i,ng)=Lbottom(ng) END DO - CASE ('MUD_TAUCR_TIME') - Npts=load_r(Nval, Rval, Ngrids, Rbed) + CASE ('Hout(irhgt)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(irhgt) DO ng=1,Ngrids - tcr_tim(ng)=Rbed(ng) + Hout(i,ng)=Lbottom(ng) END DO -#endif - CASE ('MUD_Ltsrc', 'MUD_Ltracer') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Hout(ibwav)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(ibwav) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - LtracerSrc(i,ng)=Lmud(itrc,ng) - END DO + Hout(i,ng)=Lbottom(ng) END DO - CASE ('MUD_Ltclm') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Hout(izdef)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(izdef) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - LtracerCLM(i,ng)=Lmud(itrc,ng) + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(izapp)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(izapp) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(izNik)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(izNik) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(izbio)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(izbio) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(izbfm)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(izbfm) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(izbld)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(izbld) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(izwbl)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(izwbl) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(iactv)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(iactv) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(ishgt)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(ishgt) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(imaxD)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(imaxD) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idnet)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idnet) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idtbl)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idtbl) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idubl)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idubl) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idfdw)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idfdw) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idzrw)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idzrw) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idksd)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idksd) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idusc)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idusc) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idpcx)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idpcx) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idpwc)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idpwc) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO +#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED + CASE ('Hout(idoff)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idoff) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idslp)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idslp) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idtim)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idtim) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idbmx)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idbmx) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idbmm)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idbmm) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idbzs)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idbzs) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idbzm)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idbzm) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO + CASE ('Hout(idbzp)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idbzp) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO +#endif +#if defined MIXED_BED + CASE ('Hout(idprp)') + Npts=load_l(Nval, Cval, Ngrids, Lbottom) + i=idBott(idprp) + DO ng=1,Ngrids + Hout(i,ng)=Lbottom(ng) + END DO +#endif + CASE ('SAND_SD50') + IF (.not.allocated(Sd50)) allocate (Sd50(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + Sd50(i,ng)=Rsand(itrc,ng) END DO END DO - CASE ('MUD_Tnudge') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('SAND_CSED') + IF (.not.allocated(Csed)) allocate (Csed(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand ) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + Csed(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_SRHO') + IF (.not.allocated(Srho)) allocate (Srho(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + Srho(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_WSED') + IF (.not.allocated(Wsed)) allocate (Wsed(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + Wsed(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_ERATE') + IF (.not.allocated(Erate)) allocate (Erate(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + Erate(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_TAU_CE') + IF (.not.allocated(tau_ce)) allocate (tau_ce(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + tau_ce(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_TAU_CD') + IF (.not.allocated(tau_cd)) allocate (tau_cd(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + tau_cd(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_POROS') + IF (.not.allocated(poros)) allocate (poros(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + poros(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_RXN') + IF (.not.allocated(sed_rxn)) allocate (sed_rxn(NST,Ngrids)) + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + sed_rxn(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_TNU2') + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + nl_tnu2(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_TNU4') + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + nl_tnu4(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('ad_SAND_TNU2') + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + ad_tnu2(i,ng)=Rsand(itrc,ng) + tl_tnu2(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('ad_SAND_TNU4') + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + ad_tnu4(i,ng)=Rsand(itrc,ng) + tl_tnu4(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_Sponge') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + LtracerSponge(i,ng)=Lsand(itrc,ng) + END DO + END DO + CASE ('SAND_AKT_BAK') + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + Akt_bak(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_AKT_fac') + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + ad_Akt_fac(i,ng)=Rsand(itrc,ng) + tl_Akt_fac(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_TNUDG') + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + Tnudg(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_MORPH_FAC') + IF (.not.allocated(morph_fac)) THEN + allocate (morph_fac(NST,Ngrids)) + END IF + Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=NCS+itrc + morph_fac(i,ng)=Rsand(itrc,ng) + END DO + END DO + CASE ('SAND_Ltsrc', 'SAND_Ltracer') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + LtracerSrc(i,ng)=Lsand(itrc,ng) + END DO + END DO + CASE ('SAND_Ltclm') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + DO ng=1,Ngrids + DO itrc=1,NNS + i=idsed(NCS+itrc) + LtracerCLM(i,ng)=Lsand(itrc,ng) + END DO + END DO + CASE ('SAND_Tnudge') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsed(itrc) - LnudgeTCLM(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idsed(NCS+itrc) + LnudgeTCLM(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Hout(idmud)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Hout(idsand)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idTvar(idsed(itrc)) - Hout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idTvar(idsed(NCS+itrc)) + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Hout(iMfrac)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Hout(iSfrac)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idfrac(itrc) - Hout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idfrac(NCS+itrc) + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Hout(iMmass)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Hout(iSmass)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idBmas(itrc) - Hout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idBmas(NCS+itrc) + Hout(i,ng)=Lsand(itrc,ng) END DO END DO #ifdef BEDLOAD - CASE ('Hout(iMUbld)') + CASE ('Hout(iSUbld)') DO ng=1,Ngrids - DO itrc=1,NCS + DO itrc=NCS+1,NST IF (idUbld(itrc).eq.0) THEN IF (Master) WRITE (out,30) 'idUbld' exit_flag=5 @@ -387,16 +726,16 @@ END IF END DO END DO - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idUbld(itrc) - Hout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idUbld(NCS+itrc) + Hout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Hout(iMVbld)') + CASE ('Hout(iSVbld)') DO ng=1,Ngrids - DO itrc=1,NCS + DO itrc=NCS+1,NST IF (idVbld(itrc).eq.0) THEN IF (Master) WRITE (out,30) 'idVbld' exit_flag=5 @@ -404,61 +743,61 @@ END IF END DO END DO - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idVbld(itrc) - Hout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idVbld(NCS+itrc) + Hout(i,ng)=Lsand(itrc,ng) END DO END DO #endif - CASE ('Qout(idmud)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Qout(idsand)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idTvar(idsed(itrc)) - Qout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idTvar(idsed(NCS+itrc)) + Qout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Qout(iSmud)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Qout(iSsand)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idsurT(idsed(itrc)) - Qout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idsurT(idsed(NCS+itrc)) + Qout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Qout(iMfrac)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Qout(iSfrac)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idfrac(itrc) - Qout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idfrac(NCS+itrc) + Qout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Qout(iMmass)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Qout(iSmass)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idBmas(itrc) - Qout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idBmas(NCS+itrc) + Qout(i,ng)=Lsand(itrc,ng) END DO END DO #ifdef BEDLOAD - CASE ('Qout(iMUbld)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Qout(iSUbld)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idUbld(itrc) - Qout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idUbld(NCS+itrc) + Qout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Qout(iMVbld)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Qout(iSVbld)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idVbld(itrc) - Qout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idVbld(NCS+itrc) + Qout(i,ng)=Lsand(itrc,ng) END DO END DO #endif @@ -466,361 +805,360 @@ (defined AD_AVERAGES && defined ADJOINT) || \ (defined RP_AVERAGES && defined TL_IOMS) || \ (defined TL_AVERAGES && defined TANGENT) - CASE ('Aout(idmud)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Aout(idsand)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idTvar(idsed(itrc)) - Aout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idTvar(idsed(NCS+itrc)) + Aout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Aout(iMTTav)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Aout(iSTTav)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idTTav(idsed(itrc)) - Aout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idTTav(idsed(NCS+itrc)) + Aout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Aout(iMUTav)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Aout(iSUTav)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idUTav(idsed(itrc)) - Aout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idUTav(idsed(NCS+itrc)) + Aout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Aout(iMVTav)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Aout(iSVTav)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idVTav(idsed(itrc)) - Aout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idVTav(idsed(NCS+itrc)) + Aout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Aout(MHUTav)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Aout(SHUTav)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=iHUTav(idsed(itrc)) - Aout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=iHUTav(idsed(NCS+itrc)) + Aout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Aout(MHVTav)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Aout(SHVTav)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=iHVTav(idsed(itrc)) - Aout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=iHVTav(idsed(NCS+itrc)) + Aout(i,ng)=Lsand(itrc,ng) END DO END DO # ifdef BEDLOAD - CASE ('Aout(iMUbld)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Aout(iSUbld)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idUbld(itrc) - Aout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idUbld(NCS+itrc) + Aout(i,ng)=Lsand(itrc,ng) END DO END DO - CASE ('Aout(iMVbld)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Aout(iSVbld)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO itrc=1,NCS - i=idVbld(itrc) - Aout(i,ng)=Lmud(itrc,ng) + DO itrc=1,NNS + i=idVbld(NCS+itrc) + Aout(i,ng)=Lsand(itrc,ng) END DO END DO # endif #endif #ifdef DIAGNOSTICS_TS - CASE ('Dout(MTrate)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(STrate)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iTrate),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iTrate),ng)=Lsand(i,ng) END DO END DO - CASE ('Dout(MThadv)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(SThadv)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iThadv),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iThadv),ng)=Lsand(i,ng) END DO END DO - CASE ('Dout(MTxadv)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(STxadv)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iTxadv),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iTxadv),ng)=Lsand(i,ng) END DO END DO - CASE ('Dout(MTyadv)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(STyadv)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iTyadv),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iTyadv),ng)=Lsand(i,ng) END DO END DO - CASE ('Dout(MTvadv)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(STvadv)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iTvadv),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iTvadv),ng)=Lsand(i,ng) END DO END DO # if defined TS_DIF2 || defined TS_DIF4 - CASE ('Dout(MThdif)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(SThdif)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iThdif),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iThdif),ng)=Lsand(i,ng) END DO END DO - CASE ('Dout(MTxdif)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(STxdif)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iTxdif),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iTxdif),ng)=Lsand(i,ng) END DO END DO - CASE ('Dout(MTydif)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(STydif)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iTydif),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iTydif),ng)=Lsand(i,ng) END DO END DO # if defined MIX_GEO_TS || defined MIX_ISO_TS - CASE ('Dout(MTsdif)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(STsdif)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iTsdif),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iTsdif),ng)=Lsand(i,ng) END DO END DO # endif # endif - CASE ('Dout(MTvdif)') - Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) + CASE ('Dout(STvdif)') + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) DO ng=1,Ngrids - DO i=1,NCS - itrc=idsed(i) - Dout(idDtrc(itrc,iTvdif),ng)=Lmud(i,ng) + DO i=1,NNS + itrc=idsed(NCS+i) + Dout(idDtrc(itrc,iTvdif),ng)=Lsand(i,ng) END DO END DO #endif - CASE ('SAND_SD50') + CASE ('MUD_SD50') IF (.not.allocated(Sd50)) allocate (Sd50(NST,Ngrids)) - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - Sd50(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + Sd50(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_CSED') + CASE ('MUD_CSED') IF (.not.allocated(Csed)) allocate (Csed(NST,Ngrids)) - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand ) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud ) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - Csed(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + Csed(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_SRHO') + CASE ('MUD_SRHO') IF (.not.allocated(Srho)) allocate (Srho(NST,Ngrids)) - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - Srho(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + Srho(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_WSED') + CASE ('MUD_WSED') IF (.not.allocated(Wsed)) allocate (Wsed(NST,Ngrids)) - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - Wsed(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + Wsed(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_ERATE') + CASE ('MUD_ERATE') IF (.not.allocated(Erate)) allocate (Erate(NST,Ngrids)) - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - Erate(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + Erate(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_TAU_CE') + CASE ('MUD_TAU_CE') IF (.not.allocated(tau_ce)) allocate (tau_ce(NST,Ngrids)) - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - tau_ce(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + tau_ce(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_TAU_CD') + CASE ('MUD_TAU_CD') IF (.not.allocated(tau_cd)) allocate (tau_cd(NST,Ngrids)) - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - tau_cd(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + tau_cd(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_POROS') + CASE ('MUD_POROS') IF (.not.allocated(poros)) allocate (poros(NST,Ngrids)) - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - poros(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + poros(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_TNU2') - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + CASE ('MUD_RXN') + IF (.not.allocated(sed_rxn)) allocate (sed_rxn(NST,Ngrids)) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - nl_tnu2(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + sed_rxn(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_TNU4') - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + CASE ('MUD_TNU2') + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - nl_tnu4(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + nl_tnu2(i,ng)=Rmud(itrc,ng) END DO END DO - CASE ('ad_SAND_TNU2') - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + CASE ('MUD_TNU4') + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - ad_tnu2(i,ng)=Rsand(itrc,ng) - tl_tnu2(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + nl_tnu4(i,ng)=Rmud(itrc,ng) END DO END DO - CASE ('ad_SAND_TNU4') - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + CASE ('ad_MUD_TNU2') + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - ad_tnu4(i,ng)=Rsand(itrc,ng) - tl_tnu4(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + ad_tnu2(i,ng)=Rmud(itrc,ng) + tl_tnu2(i,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_Sponge') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('ad_MUD_TNU4') + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - LtracerSponge(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + ad_tnu4(i,ng)=Rmud(itrc,ng) + tl_tnu4(i,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_AKT_BAK') - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + CASE ('MUD_Sponge') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - Akt_bak(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + LtracerSponge(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('SAND_AKT_fac') - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + CASE ('MUD_AKT_BAK') + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - ad_Akt_fac(i,ng)=Rsand(itrc,ng) - tl_Akt_fac(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + Akt_bak(i,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_TNUDG') - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + CASE ('MUD_AKT_fac') + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - Tnudg(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + ad_Akt_fac(i,ng)=Rmud(itrc,ng) + tl_Akt_fac(i,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_MORPH_FAC') + CASE ('MUD_TNUDG') + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) + DO ng=1,Ngrids + DO itrc=1,NCS + i=idsed(itrc) + Tnudg(i,ng)=Rmud(itrc,ng) + END DO + END DO + CASE ('MUD_MORPH_FAC') IF (.not.allocated(morph_fac)) THEN allocate (morph_fac(NST,Ngrids)) END IF - Npts=load_r(Nval, Rval, NNS, Ngrids, Rsand) + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=NCS+itrc - morph_fac(i,ng)=Rsand(itrc,ng) + DO itrc=1,NCS + morph_fac(itrc,ng)=Rmud(itrc,ng) END DO END DO - CASE ('SAND_Ltsrc', 'SAND_Ltracer') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('MUD_Ltsrc', 'MUD_Ltracer') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - LtracerSrc(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + LtracerSrc(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('SAND_Ltclm') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('MUD_Ltclm') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - LtracerCLM(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + LtracerCLM(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('SAND_Tnudge') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('MUD_Tnudge') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsed(NCS+itrc) - LnudgeTCLM(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idsed(itrc) + LnudgeTCLM(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Hout(idsand)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Hout(idmud)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idTvar(idsed(NCS+itrc)) - Hout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idTvar(idsed(itrc)) + Hout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Hout(iSfrac)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Hout(iMfrac)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idfrac(NCS+itrc) - Hout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idfrac(itrc) + Hout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Hout(iSmass)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Hout(iMmass)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idBmas(NCS+itrc) - Hout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idBmas(itrc) + Hout(i,ng)=Lmud(itrc,ng) END DO END DO #ifdef BEDLOAD - CASE ('Hout(iSUbld)') + CASE ('Hout(iMUbld)') DO ng=1,Ngrids - DO itrc=NCS+1,NST + DO itrc=1,NCS IF (idUbld(itrc).eq.0) THEN IF (Master) WRITE (out,30) 'idUbld' exit_flag=5 @@ -828,16 +1166,16 @@ END IF END DO END DO - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idUbld(NCS+itrc) - Hout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idUbld(itrc) + Hout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Hout(iSVbld)') + CASE ('Hout(iMVbld)') DO ng=1,Ngrids - DO itrc=NCS+1,NST + DO itrc=1,NCS IF (idVbld(itrc).eq.0) THEN IF (Master) WRITE (out,30) 'idVbld' exit_flag=5 @@ -845,61 +1183,61 @@ END IF END DO END DO - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idVbld(NCS+itrc) - Hout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idVbld(itrc) + Hout(i,ng)=Lmud(itrc,ng) END DO END DO #endif - CASE ('Qout(idsand)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Qout(idmud)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idTvar(idsed(NCS+itrc)) - Qout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idTvar(idsed(itrc)) + Qout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Qout(iSsand)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Qout(iSmud)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idsurT(idsed(NCS+itrc)) - Qout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idsurT(idsed(itrc)) + Qout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Qout(iSfrac)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Qout(iMfrac)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idfrac(NCS+itrc) - Qout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idfrac(itrc) + Qout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Qout(iSmass)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Qout(iMmass)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idBmas(NCS+itrc) - Qout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idBmas(itrc) + Qout(i,ng)=Lmud(itrc,ng) END DO END DO #ifdef BEDLOAD - CASE ('Qout(iSUbld)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Qout(iMUbld)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idUbld(NCS+itrc) - Qout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idUbld(itrc) + Qout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Qout(iSVbld)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Qout(iMVbld)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idVbld(NCS+itrc) - Qout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idVbld(itrc) + Qout(i,ng)=Lmud(itrc,ng) END DO END DO #endif @@ -907,287 +1245,250 @@ (defined AD_AVERAGES && defined ADJOINT) || \ (defined RP_AVERAGES && defined TL_IOMS) || \ (defined TL_AVERAGES && defined TANGENT) - CASE ('Aout(idsand)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Aout(idmud)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idTvar(idsed(NCS+itrc)) - Aout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idTvar(idsed(itrc)) + Aout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Aout(iSTTav)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Aout(iMTTav)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idTTav(idsed(NCS+itrc)) - Aout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idTTav(idsed(itrc)) + Aout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Aout(iSUTav)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Aout(iMUTav)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idUTav(idsed(NCS+itrc)) - Aout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idUTav(idsed(itrc)) + Aout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Aout(iSVTav)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Aout(iMVTav)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=idVTav(idsed(NCS+itrc)) - Aout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=idVTav(idsed(itrc)) + Aout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Aout(SHUTav)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Aout(MHUTav)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=iHUTav(idsed(NCS+itrc)) - Aout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=iHUTav(idsed(itrc)) + Aout(i,ng)=Lmud(itrc,ng) END DO END DO - CASE ('Aout(SHVTav)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Aout(MHVTav)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO itrc=1,NNS - i=iHVTav(idsed(NCS+itrc)) - Aout(i,ng)=Lsand(itrc,ng) + DO itrc=1,NCS + i=iHVTav(idsed(itrc)) + Aout(i,ng)=Lmud(itrc,ng) END DO END DO # ifdef BEDLOAD - CASE ('Aout(iSUbld)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO itrc=1,NNS - i=idUbld(NCS+itrc) - Aout(i,ng)=Lsand(itrc,ng) - END DO - END DO - CASE ('Aout(iSVbld)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO itrc=1,NNS - i=idVbld(NCS+itrc) - Aout(i,ng)=Lsand(itrc,ng) - END DO - END DO -# endif -#endif -#ifdef DIAGNOSTICS_TS - CASE ('Dout(STrate)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iTrate),ng)=Lsand(i,ng) - END DO - END DO - CASE ('Dout(SThadv)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iThadv),ng)=Lsand(i,ng) - END DO - END DO - CASE ('Dout(STxadv)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iTxadv),ng)=Lsand(i,ng) - END DO - END DO - CASE ('Dout(STyadv)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iTyadv),ng)=Lsand(i,ng) - END DO - END DO - CASE ('Dout(STvadv)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iTvadv),ng)=Lsand(i,ng) - END DO - END DO -# if defined TS_DIF2 || defined TS_DIF4 - CASE ('Dout(SThdif)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iThdif),ng)=Lsand(i,ng) - END DO - END DO - CASE ('Dout(STxdif)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iTxdif),ng)=Lsand(i,ng) - END DO - END DO - CASE ('Dout(STydif)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) - DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iTydif),ng)=Lsand(i,ng) - END DO - END DO -# if defined MIX_GEO_TS || defined MIX_ISO_TS - CASE ('Dout(STsdif)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Aout(iMUbld)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iTsdif),ng)=Lsand(i,ng) + DO itrc=1,NCS + i=idUbld(itrc) + Aout(i,ng)=Lmud(itrc,ng) END DO END DO -# endif -# endif - CASE ('Dout(STvdif)') - Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand) + CASE ('Aout(iMVbld)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - DO i=1,NNS - itrc=idsed(NCS+i) - Dout(idDtrc(itrc,iTvdif),ng)=Lsand(i,ng) + DO itrc=1,NCS + i=idVbld(itrc) + Aout(i,ng)=Lmud(itrc,ng) END DO END DO +# endif #endif - CASE ('Hout(ithck)') - Npts=load_l(Nval, Cval, Ngrids, Lbed) - i=idSbed(ithck) - DO ng=1,Ngrids - Hout(i,ng)=Lbed(ng) - END DO - CASE ('Hout(iaged)') - Npts=load_l(Nval, Cval, Ngrids, Lbed) - i=idSbed(iaged) +#ifdef DIAGNOSTICS_TS + CASE ('Dout(MTrate)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbed(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iTrate),ng)=Lmud(i,ng) + END DO END DO - CASE ('Hout(iporo)') - Npts=load_l(Nval, Cval, Ngrids, Lbed) - i=idSbed(iporo) + CASE ('Dout(MThadv)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbed(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iThadv),ng)=Lmud(i,ng) + END DO END DO -#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED - CASE ('Hout(ibtcr)') - Npts=load_l(Nval, Cval, Ngrids, Lbed) - i=idSbed(ibtcr) + CASE ('Dout(MTxadv)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbed(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iTxadv),ng)=Lmud(i,ng) + END DO END DO -#endif - CASE ('Hout(idiff)') - Npts=load_l(Nval, Cval, Ngrids, Lbed) - i=idSbed(idiff) + CASE ('Dout(MTyadv)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbed(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iTyadv),ng)=Lmud(i,ng) + END DO END DO - CASE ('Hout(isd50)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(isd50) + CASE ('Dout(MTvadv)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iTvadv),ng)=Lmud(i,ng) + END DO END DO - CASE ('Hout(idens)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(idens) - DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) - END DO - CASE ('Hout(iwsed)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(iwsed) +# if defined TS_DIF2 || defined TS_DIF4 + CASE ('Dout(MThdif)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iThdif),ng)=Lmud(i,ng) + END DO END DO - CASE ('Hout(itauc)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(itauc) + CASE ('Dout(MTxdif)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iTxdif),ng)=Lmud(i,ng) + END DO END DO - CASE ('Hout(irlen)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(irlen) + CASE ('Dout(MTydif)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iTydif),ng)=Lmud(i,ng) + END DO END DO - CASE ('Hout(irhgt)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(irhgt) +# if defined MIX_GEO_TS || defined MIX_ISO_TS + CASE ('Dout(MTsdif)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iTsdif),ng)=Lmud(i,ng) + END DO END DO - CASE ('Hout(ibwav)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(ibwav) +# endif +# endif + CASE ('Dout(MTvdif)') + Npts=load_l(Nval, Cval, NCS, Ngrids, Lmud) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + DO i=1,NCS + itrc=idsed(i) + Dout(idDtrc(itrc,iTvdif),ng)=Lmud(i,ng) + END DO END DO - CASE ('Hout(izdef)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(izdef) +#endif +#ifdef MIXED_BED + CASE ('TRANSC') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + transC(ng)=Rbed(ng) END DO - CASE ('Hout(izapp)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(izapp) + CASE ('TRANSN') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) - END DO - CASE ('Hout(izNik)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(izNik) - DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + transN(ng)=Rbed(ng) END DO - CASE ('Hout(izbio)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(izbio) +#endif +#if defined COHESIVE_BED || defined MIXED_BED + CASE ('MUD_TAUCR_MIN') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + tcr_min(ng)=Rbed(ng) END DO - CASE ('Hout(izbfm)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(izbfm) + CASE ('MUD_TAUCR_MAX') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + tcr_max(ng)=Rbed(ng) END DO - CASE ('Hout(izbld)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(izbld) + CASE ('MUD_TAUCR_SLOPE') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + tcr_slp(ng)=Rbed(ng) END DO - CASE ('Hout(izwbl)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(izwbl) + CASE ('MUD_TAUCR_OFF') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + tcr_off(ng)=Rbed(ng) END DO - CASE ('Hout(iactv)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(iactv) + CASE ('MUD_TAUCR_TIME') + Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + tcr_tim(ng)=Rbed(ng) END DO - CASE ('Hout(ishgt)') - Npts=load_l(Nval, Cval, Ngrids, Lbottom) - i=idBott(ishgt) +#endif +#if defined SED_FLOCS + CASE ('L_ADS') + Npts=load_l(Nval, Cval, Ngrids, l_ADS) + CASE ('L_ASH') + Npts=load_l(Nval, Cval, Ngrids, l_ASH) + CASE ('L_COLLFRAG') + Npts=load_l(Nval, Cval, Ngrids, l_COLLFRAG) + CASE ('F_DP0') + Npts=load_r(Nval, Rval, Ngrids, f_dp0) + CASE ('F_NF') + Npts=load_r(Nval, Rval, Ngrids, f_nf) + CASE ('F_DMAX') + Npts=load_r(Nval, Rval, Ngrids, f_dmax) + CASE ('F_NB_FRAG') + Npts=load_r(Nval, Rval, Ngrids, f_nb_frag) + CASE ('F_ALPHA') + Npts=load_r(Nval, Rval, Ngrids, f_alpha) + CASE ('F_BETA') + Npts=load_r(Nval, Rval, Ngrids, f_beta) + CASE ('F_ATER') + Npts=load_r(Nval, Rval, Ngrids, f_ater) + CASE ('F_ERO_FRAC') + Npts=load_r(Nval, Rval, Ngrids, f_ero_frac) + CASE ('F_ERO_NBFRAG') + Npts=load_r(Nval, Rval, Ngrids, f_ero_nbfrag) + CASE ('F_ERO_IV') + Npts=load_i(Nval, Rval, Ngrids, f_ero_iv) + CASE ('F_COLLFRAGPARAM') + Npts=load_r(Nval, Rval, Ngrids, f_collfragparam) + CASE ('F_CLIM') + Npts=load_r(Nval, Rval, Ngrids, f_clim) + CASE ('L_TESTCASE') + Npts=load_l(Nval, Cval, Ngrids, l_testcase) +#endif +#if defined SED_FLOCS && defined SED_DEFLOC + CASE ('MUD_FRAC_EQ') + IF (.not.allocated(mud_frac_eq)) THEN + allocate (mud_frac_eq(NCS,Ngrids)) + ENDIF + Npts=load_r(Nval, Rval, NCS, Ngrids, Rmud) DO ng=1,Ngrids - Hout(i,ng)=Lbottom(ng) + DO itrc=1,NCS + mud_frac_eq(itrc,ng)=Rmud(itrc,ng) + END DO END DO + CASE ('MUD_T_DFLOC') +! Npts=load_r(Nval, Rval, Ngrids, t_dfloc) + Npts=load_r(Nval, Rval, Ngrids, Rbed) + DO ng=1,Ngrids + t_dfloc(ng)=Rbed(ng) + END DO +#endif CASE ('Qout(ithck)') Npts=load_l(Nval, Cval, Ngrids, Lbed) i=idSbed(ithck) @@ -1213,6 +1514,32 @@ DO ng=1,Ngrids Qout(i,ng)=Lbed(ng) END DO +#endif +#if defined SEDBIO_COUP + CASE ('Qout(iboxy)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(iboxy) + DO ng=1,Ngrids + Qout(i,ng)=Lbed(ng) + END DO + CASE ('Qout(ibno3)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(ibno3) + DO ng=1,Ngrids + Qout(i,ng)=Lbed(ng) + END DO + CASE ('Qout(ibnh4)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(ibnh4) + DO ng=1,Ngrids + Qout(i,ng)=Lbed(ng) + END DO + CASE ('Qout(ibodu)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(ibodu) + DO ng=1,Ngrids + Qout(i,ng)=Lbed(ng) + END DO #endif CASE ('Qout(idiff)') Npts=load_l(Nval, Cval, Ngrids, Lbed) @@ -1316,6 +1643,41 @@ DO ng=1,Ngrids Qout(i,ng)=Lbottom(ng) END DO +#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED + CASE ('Hout(ibtcr)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(ibtcr) + DO ng=1,Ngrids + Hout(i,ng)=Lbed(ng) + END DO +#endif +#if defined SEDBIO_COUP + CASE ('Hout(iboxy)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(iboxy) + DO ng=1,Ngrids + Hout(i,ng)=Lbed(ng) + END DO + CASE ('Hout(ibno3)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(ibno3) + DO ng=1,Ngrids + Hout(i,ng)=Lbed(ng) + END DO + CASE ('Hout(ibnh4)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(ibnh4) + DO ng=1,Ngrids + Hout(i,ng)=Lbed(ng) + END DO + CASE ('Hout(ibodu)') + Npts=load_l(Nval, Cval, Ngrids, Lbed) + i=idSbed(ibodu) + DO ng=1,Ngrids + Hout(i,ng)=Lbed(ng) + END DO +#endif + END SELECT END IF END DO @@ -1345,6 +1707,12 @@ & nl_tnu2(i,ng), nl_tnu4(i,ng), & & Akt_bak(i,ng), Tnudg(i,ng) END DO +#if defined SEDTR_REACTIONS + WRITE (out,170) + DO itrc=1,NST + WRITE (out,70) itrc, sed_rxn(itrc,ng) + END DO +#endif WRITE (out,90) DO itrc=1,NST WRITE (out,70) itrc, morph_fac(itrc,ng) @@ -1422,7 +1790,7 @@ DO itrc=1,NST i=idBmas(itrc) IF (Hout(i,ng)) WRITE (out,160) Hout(i,ng), & - & 'Hout(idfrac)', & + & 'Hout(idmass)', & & 'Write out mass, sediment ', itrc, & & TRIM(Vname(1,i)) END DO @@ -1702,6 +2070,7 @@ 140 FORMAT (' Transition for cohesive sediment =',e12.5,/) 150 FORMAT (10x,l1,2x,a,'(',i2.2,')',t30,a,i2.2,':',1x,a) 160 FORMAT (10x,l1,2x,a,t29,a,i2.2,':',1x,a) + 170 FORMAT (/,9x,'sed_rxn',/,9x,'(1/d)',/) RETURN END SUBROUTINE read_SedPar diff --git a/ROMS/Nonlinear/Sediment/sediment_mod.h b/ROMS/Nonlinear/Sediment/sediment_mod.h index d0ae5c0b..30e7a1e6 100644 --- a/ROMS/Nonlinear/Sediment/sediment_mod.h +++ b/ROMS/Nonlinear/Sediment/sediment_mod.h @@ -19,6 +19,7 @@ ! Wsed Particle settling velocity (m/s). ! ! poros Porosity (non-dimensional: 0.0-1.0): ! ! Vwater/(Vwater+Vsed). ! +! sed_rxn Reaction rate for particulate tracers (1/d) ! ! tau_ce Kinematic critical shear for erosion (m2/s2). ! ! tau_cd Kinematic critical shear for deposition (m2/s2). ! ! ! @@ -27,6 +28,14 @@ ! newlayer_thick New layer deposit thickness criteria (m). ! ! morph_fac Morphological scale factor (nondimensional). ! ! ! +! sg_zwbl Input elevation to get near-bottom current vel.(m) ! +! sedslope_crit_wet Critical wet bed slope for slumping. ! +! sedslope_crit_dry Critical dry bed slope for slumping. ! +! slopefac_wet Bedload wet bed slumping factor. ! +! slopefac_dry Bedload dry bed slumping factor. ! +! bedload_vandera_alphaw Bedload scale factor for waves contribution.! +! bedload_vandera_alphac Bedload scale factor for currs contribution.! +! ! ! BED properties indices: ! ! ====================== ! ! ! @@ -39,6 +48,12 @@ ! iporo Sediment layer porosity (non-dimensional). ! ! idiff Sediment layer bio-diffusivity (m2/s). ! ! ibtcr Sediment critical stress for erosion (Pa). ! +#if defined SEDBIO_COUP +! iboxy Sediment porewater oxygen (mmol O2/m2) ! +! ibno3 Sediment porewater nitrate (mmol NO3/m2) ! +! ibnh4 Sediment porewater ammonium (mmol NH4/m2) ! +! ibodu Sediment porewater oxygen demand units (mmol O2/m2)! +#endif ! ! ! BOTTOM properties indices: ! ! ========================= ! @@ -61,12 +76,19 @@ ! izwbl Bottom roughness used wave BBL (m). ! ! iactv Active layer thickness for erosive potential (m). ! ! ishgt Sediment saltation height (m). ! -! idefx Erosion flux. ! -! idnet Erosion or deposition. ! -! idoff Offset for calculation of dmix erodibility ! -! profile (m). ! -! idslp Slope for calculation of dmix or erodibility ! -! profile. ! +! imaxD Maximum inundation depth. ! +! idnet Erosion/deposition ! +! idtbl Thickness at wave boundary layer ! +! idubl Current velocity at wave boundary layer ! +! idfdw Friction factor from the currents ! +! idzrw Reference height to get near bottom current vel ! +! idksd Bed roughness (Zo) for the wave boundary layer calc! +! idusc Current friction velocity the wave boundary layer ! +! idpcx Anlge between currents and xi axis ! +! idpwc Angle between waves/currents ! +! +! idoff Offset for calc of dmix erodibility profile (m). ! +! idslp Slope for calc of dmix or erodibility profile. ! ! idtim Time scale for restoring erodibility profile (s). ! ! idbmx Bed biodifusivity maximum. ! ! idbmm Bed biodifusivity minimum. ! @@ -75,11 +97,17 @@ ! idbzp Bed biodifusivity phi. ! ! idprp Cohesive behavior. ! ! ! +! isgrH Seagrass height. ! +! isgrD Seagrass shoot density. ! +! nTbiom Number of hours for depth integration ! !======================================================================= ! USE mod_param ! implicit none + + integer, allocatable :: idSbed(:) ! bed properties IDs + integer, allocatable :: idBott(:) ! bottom properties IDs ! !----------------------------------------------------------------------- ! Tracer identification indices. @@ -90,67 +118,36 @@ integer, allocatable :: isand(:) ! Non-cohesive sediment ! !----------------------------------------------------------------------- -! Bed and bottom properties indices. +! Set bed property variables !----------------------------------------------------------------------- ! -! Set size of properties arrays. -! + integer :: MBEDP ! Number of bed properties + integer :: ithck, iaged, iporo, idiff #if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED - integer, parameter :: MBEDP = 5 ! Bed properties -#else - integer, parameter :: MBEDP = 4 ! Bed properties + integer :: ibtcr #endif - integer :: idSbed(MBEDP) ! bed properties IDs -! -#if defined MIXED_BED - integer, parameter :: MBOTP = 27 ! Bottom properties -#elif defined COHESIVE_BED || defined SED_BIODIFF - integer, parameter :: MBOTP = 26 ! Bottom properties -#else - integer, parameter :: MBOTP = 18 ! Bottom properties +#if defined SEDBIO_COUP + integer :: iboxy, ibno3, ibnh4, ibodu #endif - integer :: idBott(MBOTP) ! bottom properties IDs -! -! Set properties indices. ! - integer, parameter :: ithck = 1 ! layer thickness - integer, parameter :: iaged = 2 ! layer age - integer, parameter :: iporo = 3 ! layer porosity - integer, parameter :: idiff = 4 ! layer bio-diffusivity -#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED - integer, parameter :: ibtcr = 5 ! layer critical stress -#endif +!----------------------------------------------------------------------- +! Set bottom property variables +!----------------------------------------------------------------------- ! - integer, parameter :: isd50 = 1 ! mean grain diameter - integer, parameter :: idens = 2 ! mean grain density - integer, parameter :: iwsed = 3 ! mean settle velocity - integer, parameter :: itauc = 4 ! critical erosion stress - integer, parameter :: irlen = 5 ! ripple length - integer, parameter :: irhgt = 6 ! ripple height - integer, parameter :: ibwav = 7 ! wave excursion amplitude - integer, parameter :: izdef = 8 ! default bottom roughness - integer, parameter :: izapp = 9 ! apparent bottom roughness - integer, parameter :: izNik = 10 ! Nikuradse bottom roughness - integer, parameter :: izbio = 11 ! biological bottom roughness - integer, parameter :: izbfm = 12 ! bed form bottom roughness - integer, parameter :: izbld = 13 ! bed load bottom roughness - integer, parameter :: izwbl = 14 ! wave bottom roughness - integer, parameter :: iactv = 15 ! active layer thickness - integer, parameter :: ishgt = 16 ! saltation height - integer, parameter :: idefx = 17 ! erosion flux - integer, parameter :: idnet = 18 ! erosion or deposition + integer :: MBOTP ! Number of bottom properties + integer :: isd50, idens, iwsed, itauc + integer :: irlen, irhgt, ibwav, izdef + integer :: izapp, izNik, izbio, izbfm + integer :: izbld, izwbl, iactv, ishgt + integer :: imaxD, idnet + integer :: idtbl, idubl, idfdw, idzrw + integer :: idksd, idusc, idpcx, idpwc #if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED - integer, parameter :: idoff = 19 ! tau critical offset - integer, parameter :: idslp = 20 ! tau critical slope - integer, parameter :: idtim = 21 ! erodibility time scale - integer, parameter :: idbmx = 22 ! diffusivity db_max - integer, parameter :: idbmm = 23 ! diffusivity db_m - integer, parameter :: idbzs = 24 ! diffusivity db_zs - integer, parameter :: idbzm = 25 ! diffusivity db_zm - integer, parameter :: idbzp = 26 ! diffusivity db_zphi + integer :: idoff, idslp, idtim, idbmx + integer :: idbmm, idbzs, idbzm, idbzp #endif #if defined MIXED_BED - integer, parameter :: idprp = 27 ! cohesive behavior + integer :: idprp #endif ! ! Sediment metadata indices vectors. @@ -160,39 +157,72 @@ integer, allocatable :: idUbld(:) ! bed load u-points integer, allocatable :: idVbld(:) ! bed load v-points ! +#if defined BEDLOAD +!# if defined BEDLOAD_VANDERA + integer :: idsurs ! Ursell number of the asymmetric wave + integer :: idsrrw ! velocity skewness of the asymmetric wave + integer :: idsbtw ! acceleration asymmetry parameter + integer :: idsucr ! Crest velocity of the asymmetric wave + integer :: idsutr ! Trough velocity of the asymmetric wave + integer :: idstcr ! Crest time period of the asymmetric wave + integer :: idsttr ! Trough time period of the asymmetric wave +!# endif +#endif +! !----------------------------------------------------------------------- ! Input sediment parameters. !----------------------------------------------------------------------- ! - real(r8), allocatable :: newlayer_thick(:) ! deposit thickness - real(r8), allocatable :: minlayer_thick(:) ! 2nd layer thickness - real(r8), allocatable :: bedload_coeff(:) ! bedload rate - + real(r8), allocatable :: newlayer_thick(:) ! deposit thickness criteria + real(r8), allocatable :: minlayer_thick(:) ! 2nd layer thickness criteria + real(r8), allocatable :: bedload_coeff(:) ! bedload rate coefficient + real(r8), allocatable :: sg_zwbl(:) ! input elevation to get near-bottom current vel +#if defined BEDLOAD + real(r8), allocatable :: sedslope_crit_wet(:) ! critical wet bed slope for slumping + real(r8), allocatable :: sedslope_crit_dry(:) ! critical dry bed slope for slumping + real(r8), allocatable :: slopefac_wet(:) ! bedload wet bed slumping factor + real(r8), allocatable :: slopefac_dry(:) ! bedload dry bed slumping factor + real(r8), allocatable :: bedload_vandera_alphaw(:) ! bedload scale factor for waves contribution + real(r8), allocatable :: bedload_vandera_alphac(:) ! bedload scale factor for currs contribution +#endif +! real(r8), allocatable :: Csed(:,:) ! initial concentration real(r8), allocatable :: Erate(:,:) ! erosion rate real(r8), allocatable :: Sd50(:,:) ! mediam grain diameter real(r8), allocatable :: Srho(:,:) ! grain density real(r8), allocatable :: Wsed(:,:) ! settling velocity real(r8), allocatable :: poros(:,:) ! porosity + real(r8), allocatable :: sed_rxn(:,:) ! reaction rate real(r8), allocatable :: tau_ce(:,:) ! shear for erosion real(r8), allocatable :: tau_cd(:,:) ! shear for deposition real(r8), allocatable :: morph_fac(:,:) ! morphological factor #if defined COHESIVE_BED || defined MIXED_BED - real(r8), allocatable :: tcr_min(:) ! minimum shear erosion - real(r8), allocatable :: tcr_max(:) ! maximum shear erosion + real(r8), allocatable :: tcr_min(:) ! minimum shear for erosion + real(r8), allocatable :: tcr_max(:) ! maximum shear for erosion real(r8), allocatable :: tcr_slp(:) ! Tau_crit profile slope real(r8), allocatable :: tcr_off(:) ! Tau_crit profile offset - real(r8), allocatable :: tcr_tim(:) ! Tau_crit consolidation + real(r8), allocatable :: tcr_tim(:) ! Tau_crit consolidation rate #endif #if defined MIXED_BED real(r8), allocatable :: transC(:) ! cohesive transition real(r8), allocatable :: transN(:) ! noncohesive transition #endif -! +#if defined SED_BIODIFF + real(r8), allocatable :: Dbmx(:) ! Dbmax Maximum biodiffusivity + real(r8), allocatable :: Dbmm(:) ! Dbmin Minimum biodiffusivity + real(r8), allocatable :: Dbzs(:) ! Dbzs Depth of maximum biodiff + real(r8), allocatable :: Dbzm(:) ! Dbzm Depth end exp biodiff + real(r8), allocatable :: Dbzp(:) ! Dbzp Depth of minimum biodiff +#endif +#if defined SED_FLOCS && defined SED_DEFLOC + real(r8), allocatable :: mud_frac_eq(:,:) ! Equilibrium fractional class distribution + real(r8), allocatable :: t_dfloc(:) ! Time scale of bed deflocculation +#endif + CONTAINS -! + SUBROUTINE initialize_sediment ! !======================================================================= @@ -205,10 +235,128 @@ ! Local variable declarations ! integer :: i, ic - + integer :: counter1, counter2 real(r8), parameter :: IniVal = 0.0_r8 ! !----------------------------------------------------------------------- +! Set bed properties indices. +!----------------------------------------------------------------------- +! + counter1 = 1 ! Initializing counter + ithck = counter1 ! layer thickness + counter1 = counter1+1 + iaged = counter1 ! layer age + counter1 = counter1+1 + iporo = counter1 ! layer porosity + counter1 = counter1+1 + idiff = counter1 ! layer bio-diffusivity +#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED + counter1 = counter1+1 + ibtcr = counter1 ! layer critical stress +#endif +#if defined SEDBIO_COUP + counter1 = counter1+1 + iboxy = counter1 ! porewater oxygen + counter1 = counter1+1 + ibno3 = counter1 ! porewater nitrate + counter1 = counter1+1 + ibnh4 = counter1 ! porewater ammonium + counter1 = counter1+1 + ibodu = counter1 ! porewater oxygen demand units +#endif +! +!----------------------------------------------------------------------- +! Set bottom properties indices. +!----------------------------------------------------------------------- +! + counter2 = 1 ! Initializing counter + isd50 = counter2 ! Median sediment grain diameter (m). + counter2 = counter2+1 + idens = counter2 ! Median sediment grain density (kg/m3). + counter2 = counter2+1 + iwsed = counter2 ! Mean settling velocity (m/s). + counter2 = counter2+1 + itauc = counter2 ! Mean critical erosion stress (m2/s2). + counter2 = counter2+1 + irlen = counter2 ! Sediment ripple length (m). + counter2 = counter2+1 + irhgt = counter2 ! Sediment ripple height (m). + counter2 = counter2+1 + ibwav = counter2 ! Bed wave excursion amplitude (m). + counter2 = counter2+1 + izdef = counter2 ! Default bottom roughness (m). + counter2 = counter2+1 + izapp = counter2 ! Apparent bottom roughness (m). + counter2 = counter2+1 + izNik = counter2 ! Nikuradse bottom roughness (m). + counter2 = counter2+1 + izbio = counter2 ! Biological bottom roughness (m). + counter2 = counter2+1 + izbfm = counter2 ! Bed form bottom roughness (m). + counter2 = counter2+1 + izbld = counter2 ! Bed load bottom roughness (m). + counter2 = counter2+1 + izwbl = counter2 ! Bottom roughness used wave BBL (m). + counter2 = counter2+1 + iactv = counter2 ! Active layer thickness for erosive potential (m). + counter2 = counter2+1 + ishgt = counter2 ! Sediment saltation height (m). + counter2 = counter2+1 + imaxD = counter2 ! Maximum inundation depth. + counter2 = counter2+1 + idnet = counter2 ! Erosion/deposition + counter2 = counter2+1 + idtbl = counter2 ! Thickness at wave boundary layer + counter2 = counter2+1 + idubl = counter2 ! Current velocity at wave boundary layer + counter2 = counter2+1 + idfdw = counter2 ! Friction factor from the currents + counter2 = counter2+1 + idzrw = counter2 ! Reference height to get near bottom current velocity + counter2 = counter2+1 + idksd = counter2 ! Bed roughness (zo) to calc. wave boundary layer + counter2 = counter2+1 + idusc = counter2 ! Current friction velocity at wave boundary layer + counter2 = counter2+1 + idpcx = counter2 ! Anlge between currents and xi axis. + counter2 = counter2+1 + idpwc = counter2 ! Angle between waves/currents +#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED + counter2 = counter2+1 + idoff = counter2 ! Offset for calculation of dmix erodibility profile (m). + counter2 = counter2+1 + idslp = counter2 ! Slope for calculation of dmix or erodibility profile. + counter2 = counter2+1 + idtim = counter2 ! Time scale for restoring erodibility profile (s). + counter2 = counter2+1 + idbmx = counter2 ! Bed biodifusivity maximum. + counter2 = counter2+1 + idbmm = counter2 ! Bed biodifusivity minimum. + counter2 = counter2+1 + idbzs = counter2 ! Bed biodifusivity zs. + counter2 = counter2+1 + idbzm = counter2 ! Bed biodifusivity zm. + counter2 = counter2+1 + idbzp = counter2 ! Bed biodifusivity phi. +#endif +#if defined MIXED_BED + counter2 = counter2+1 + idprp = counter2 ! Cohesive behavior. +#endif +! +! Allocate bed & bottom properties +! + MBEDP = counter1 + IF (.not.allocated(idSbed)) THEN + allocate ( idSbed(MBEDP) ) + END IF +! + MBOTP = counter2 + IF (.not.allocated(idBott)) THEN + allocate ( idBott(MBOTP) ) + END IF +! +!----------------------------------------------------------------------- ! Initialize tracer identification indices. !----------------------------------------------------------------------- ! @@ -231,7 +379,96 @@ bedload_coeff = IniVal Dmem(1)=Dmem(1)+REAL(Ngrids,r8) END IF - +! +#if defined SED_BIODIFF + IF (.not.allocated(Dbmx)) THEN + allocate ( Dbmx(Ngrids) ) + Dbmx = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(Dbmm)) THEN + allocate ( Dbmm(Ngrids) ) + Dbmm = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(Dbzs)) THEN + allocate ( Dbzs(Ngrids) ) + Dbzs = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(Dbzm)) THEN + allocate ( Dbzm(Ngrids) ) + Dbzm = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(Dbzp)) THEN + allocate ( Dbzp(Ngrids) ) + Dbzp = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF +#endif + IF (.not.allocated(sg_zwbl)) THEN + allocate ( sg_zwbl(Ngrids) ) + sg_zwbl = 0.1_r8 + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF +#if defined BEDLOAD +!# if defined BEDLOAD_VANDERA + IF (.not.allocated(sedslope_crit_wet)) THEN + allocate ( sedslope_crit_wet(Ngrids) ) + sedslope_crit_wet = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(sedslope_crit_dry)) THEN + allocate ( sedslope_crit_dry(Ngrids) ) + sedslope_crit_dry = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(slopefac_wet)) THEN + allocate ( slopefac_wet(Ngrids) ) + slopefac_wet = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(slopefac_dry)) THEN + allocate ( slopefac_dry(Ngrids) ) + slopefac_dry = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(bedload_vandera_alphaw)) THEN + allocate ( bedload_vandera_alphaw(Ngrids) ) + bedload_vandera_alphaw = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(bedload_vandera_alphac)) THEN + allocate ( bedload_vandera_alphac(Ngrids) ) + bedload_vandera_alphac = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF +!# endif +#endif +! +#if defined SED_BIODIFF + IF (.not.allocated(Dbmm)) THEN + allocate ( Dbmm(Ngrids) ) + Dbmm = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(Dbzs)) THEN + allocate ( Dbzs(Ngrids) ) + Dbzs = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(Dbzm)) THEN + allocate ( Dbzm(Ngrids) ) + Dbzm = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF + IF (.not.allocated(Dbzp)) THEN + allocate ( Dbzp(Ngrids) ) + Dbzp = IniVal + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + END IF +#endif #if defined COHESIVE_BED || defined MIXED_BED IF (.not.allocated(tcr_min)) THEN allocate ( tcr_min(Ngrids) ) @@ -259,8 +496,16 @@ IF (.not.allocated(tcr_tim)) THEN allocate ( tcr_tim(Ngrids) ) + Dmem(1)=Dmem(1)+REAL(Ngrids,r8) tcr_tim = IniVal + END IF +#endif + +#if defined SED_FLOCS && defined SED_DEFLOC + IF (.not.allocated(t_dfloc)) THEN + allocate ( t_dfloc(Ngrids) ) Dmem(1)=Dmem(1)+REAL(Ngrids,r8) + t_dfloc = IniVal END IF #endif diff --git a/ROMS/Nonlinear/Sediment/sediment_var.h b/ROMS/Nonlinear/Sediment/sediment_var.h index bc648667..2f0451a7 100644 --- a/ROMS/Nonlinear/Sediment/sediment_var.h +++ b/ROMS/Nonlinear/Sediment/sediment_var.h @@ -20,617 +20,608 @@ ** Model state sediment tracers. */ - CASE ('idSbed(ithck)') - idSbed(ithck)=varid - CASE ('idSbed(iaged)') - idSbed(iaged)=varid - CASE ('idSbed(iporo)') - idSbed(iporo)=varid - CASE ('idSbed(idiff)') - idSbed(idiff)=varid + CASE ('idSbed(ithck)') + idSbed(ithck)=varid + CASE ('idSbed(iaged)') + idSbed(iaged)=varid + CASE ('idSbed(iporo)') + idSbed(iporo)=varid + CASE ('idSbed(idiff)') + idSbed(idiff)=varid +#if defined BEDLOAD_VANDERA + CASE ('idsurs') + idsurs=varid + CASE ('idsrrw') + idsrrw=varid + CASE ('idsbtw') + idsbtw=varid + CASE ('idsucr') + idsucr=varid + CASE ('idsutr') + idsutr=varid + CASE ('idstcr') + idstcr=varid + CASE ('idsttr') + idsttr=varid +#endif #if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED - CASE ('idSbed(ibtcr)') - idSbed(ibtcr)=varid + CASE ('idSbed(ibtcr)') + idSbed(ibtcr)=varid +#endif +#if defined SEDBIO_COUP + CASE ('idSbed(iboxy)') + idSbed(iboxy)=varid + CASE ('idSbed(ibno3)') + idSbed(ibno3)=varid + CASE ('idSbed(ibnh4)') + idSbed(ibnh4)=varid + CASE ('idSbed(ibodu)') + idSbed(ibodu)=varid #endif - CASE ('idBott(isd50)') - idBott(isd50)=varid - CASE ('idBott(idens)') - idBott(idens)=varid - CASE ('idBott(iwsed)') - idBott(iwsed)=varid - CASE ('idBott(itauc)') - idBott(itauc)=varid - CASE ('idBott(irlen)') - idBott(irlen)=varid - CASE ('idBott(irhgt)') - idBott(irhgt)=varid - CASE ('idBott(ibwav)') - idBott(ibwav)=varid - CASE ('idBott(izdef)') - idBott(izdef)=varid - CASE ('idBott(izapp)') - idBott(izapp)=varid - CASE ('idBott(izNik)') - idBott(izNik)=varid - CASE ('idBott(izbio)') - idBott(izbio)=varid - CASE ('idBott(izbfm)') - idBott(izbfm)=varid - CASE ('idBott(izbld)') - idBott(izbld)=varid - CASE ('idBott(izwbl)') - idBott(izwbl)=varid - CASE ('idBott(iactv)') - idBott(iactv)=varid - CASE ('idBott(ishgt)') - idBott(ishgt)=varid - CASE ('idBott(idefx)') - idBott(idefx)=varid - CASE ('idBott(idnet)') - idBott(idnet)=varid + CASE ('idBott(isd50)') + idBott(isd50)=varid + CASE ('idBott(idens)') + idBott(idens)=varid + CASE ('idBott(iwsed)') + idBott(iwsed)=varid + CASE ('idBott(itauc)') + idBott(itauc)=varid + CASE ('idBott(irlen)') + idBott(irlen)=varid + CASE ('idBott(irhgt)') + idBott(irhgt)=varid + CASE ('idBott(ibwav)') + idBott(ibwav)=varid + CASE ('idBott(izdef)') + idBott(izdef)=varid + CASE ('idBott(izapp)') + idBott(izapp)=varid + CASE ('idBott(izNik)') + idBott(izNik)=varid + CASE ('idBott(izbio)') + idBott(izbio)=varid + CASE ('idBott(izbfm)') + idBott(izbfm)=varid + CASE ('idBott(izbld)') + idBott(izbld)=varid + CASE ('idBott(izwbl)') + idBott(izwbl)=varid + CASE ('idBott(iactv)') + idBott(iactv)=varid + CASE ('idBott(ishgt)') + idBott(ishgt)=varid + CASE ('idBott(imaxD)') + idBott(imaxD)=varid + CASE ('idBott(idnet)') + idBott(idnet)=varid + CASE ('idBott(idtbl)') + idBott(idtbl)=varid + CASE ('idBott(idubl)') + idBott(idubl)=varid + CASE ('idBott(idfdw)') + idBott(idfdw)=varid + CASE ('idBott(idzrw)') + idBott(idzrw)=varid + CASE ('idBott(idksd)') + idBott(idksd)=varid + CASE ('idBott(idusc)') + idBott(idusc)=varid + CASE ('idBott(idpcx)') + idBott(idpcx)=varid + CASE ('idBott(idpwc)') + idBott(idpwc)=varid #if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED - CASE ('idBott(idoff)') - idBott(idoff)=varid - CASE ('idBott(idslp)') - idBott(idslp)=varid - CASE ('idBott(idtim)') - idBott(idtim)=varid - CASE ('idBott(idbmx)') - idBott(idbmx)=varid - CASE ('idBott(idbmm)') - idBott(idbmm)=varid - CASE ('idBott(idbzs)') - idBott(idbzs)=varid - CASE ('idBott(idbzm)') - idBott(idbzm)=varid - CASE ('idBott(idbzp)') - idBott(idbzp)=varid + CASE ('idBott(idoff)') + idBott(idoff)=varid + CASE ('idBott(idslp)') + idBott(idslp)=varid + CASE ('idBott(idtim)') + idBott(idtim)=varid + CASE ('idBott(idbmx)') + idBott(idbmx)=varid + CASE ('idBott(idbmm)') + idBott(idbmm)=varid + CASE ('idBott(idbzs)') + idBott(idbzs)=varid + CASE ('idBott(idbzm)') + idBott(idbzm)=varid + CASE ('idBott(idbzp)') + idBott(idbzp)=varid #endif #if defined MIXED_BED - CASE ('idBott(idprp)') - idBott(idprp)=varid + CASE ('idBott(idprp)') + idBott(idprp)=varid #endif - CASE ('idTvar(idmud(i))') - load=.FALSE. - IF (NCS.gt.0) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idTvar(idmud(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idTvar(isand(i))') - load=.FALSE. - IF (NNS.gt.0) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idTvar(isand(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idfrac') - load=.FALSE. - IF ((NCS.gt.0).and. & - & (Vinfo(1)(1:8).eq.'mudfrac_')) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idfrac(i)=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_fraction') - END DO - varid=varid+1 - END IF - IF ((NNS.gt.0).and. & - & (Vinfo(1)(1:9).eq.'sandfrac_')) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idfrac(NCS+i)=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_fraction') - END DO - varid=varid+1 - END IF - CASE ('idBmas') - load=.FALSE. - IF ((NCS.gt.0).and. & - & (Vinfo(1)(1:8).eq.'mudmass_')) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idBmas(i)=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_mass') - END DO - varid=varid+1 - END IF - IF ((NNS.gt.0).and. & - & (Vinfo(1)(1:9).eq.'sandmass_')) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idBmas(NCS+i)=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_mass') - END DO - varid=varid+1 - END IF + CASE ('idTvar(idmud(i))') + load=.FALSE. + IF (NCS.gt.0) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idTvar(idmud(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idTvar(isand(i))') + load=.FALSE. + IF (NNS.gt.0) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idTvar(isand(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idfrac') + load=.FALSE. + IF ((NCS.gt.0).and. & + & (Vinfo(1)(1:8).eq.'mudfrac_')) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idfrac(i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + IF ((NNS.gt.0).and. & + & (Vinfo(1)(1:9).eq.'sandfrac_')) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idfrac(NCS+i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idBmas') + load=.FALSE. + IF ((NCS.gt.0).and. & + & (Vinfo(1)(1:8).eq.'mudmass_')) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idBmas(i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + IF ((NNS.gt.0).and. & + & (Vinfo(1)(1:9).eq.'sandmass_')) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idBmas(NCS+i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF #ifdef BEDLOAD - CASE ('idUbld') - load=.FALSE. - IF ((NCS.gt.0).and. & - & (Vinfo(1)(1:13).eq.'bedload_Umud_')) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idUbld(i)=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string) - END DO - varid=varid+1 - END IF - IF ((NNS.gt.0).and. & - & (Vinfo(1)(1:14).eq.'bedload_Usand_')) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idUbld(NCS+i)=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string) - END DO - varid=varid+1 - END IF - CASE ('idVbld') - load=.FALSE. - IF ((NCS.gt.0).and. & - & (Vinfo(1)(1:13).eq.'bedload_Vmud_')) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idVbld(i)=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string) - END DO - varid=varid+1 - END IF - IF ((NNS.gt.0).and. & - & (Vinfo(1)(1:14).eq.'bedload_Vsand_')) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idVbld(NCS+i)=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string) - END DO - varid=varid+1 - END IF + CASE ('idUbld') + load=.FALSE. + IF ((NCS.gt.0).and. & + & (Vinfo(1)(1:13).eq.'bedload_Umud_')) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idUbld(i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + IF ((NNS.gt.0).and. & + & (Vinfo(1)(1:14).eq.'bedload_Usand_')) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idUbld(NCS+i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idVbld') + load=.FALSE. + IF ((NCS.gt.0).and. & + & (Vinfo(1)(1:13).eq.'bedload_Vmud_')) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idVbld(i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + IF ((NNS.gt.0).and. & + & (Vinfo(1)(1:14).eq.'bedload_Vsand_')) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idVbld(NCS+i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF #endif /* ** Sediment tracers open boundary conditions. */ - CASE ('idTbry(iwest,idmud(i))') - load=.FALSE. - IF (NCS.gt.0) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idTbry(iwest,idmud(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2,a)') & - & TRIM(ADJUSTL(Vinfo(4))), i, ' western-boundary' - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idTbry(ieast,idmud(i))') - load=.FALSE. - IF (NCS.gt.0) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idTbry(ieast,idmud(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2,a)') & - & TRIM(ADJUSTL(Vinfo(4))), i, ' eastern-boundary' - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idTbry(isouth,idmud(i))') - load=.FALSE. - IF (NCS.gt.0) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idTbry(isouth,idmud(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2,a)') & - & TRIM(ADJUSTL(Vinfo(4))), i, ' southern-boundary' - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idTbry(inorth,idmud(i))') - load=.FALSE. - IF (NCS.gt.0) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idTbry(inorth,idmud(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2,a)') & - & TRIM(ADJUSTL(Vinfo(4))), i, ' northern-boundary' - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idTbry(iwest,isand(i))') - load=.FALSE. - IF (NNS.gt.0) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idTbry(iwest,isand(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2,a)') & - & TRIM(ADJUSTL(Vinfo(4))), i, ' western-boundary' - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idTbry(ieast,isand(i))') - load=.FALSE. - IF (NNS.gt.0) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idTbry(ieast,isand(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2,a)') & - & TRIM(ADJUSTL(Vinfo(4))), i, ' eastern-boundary' - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idTbry(isouth,isand(i))') - load=.FALSE. - IF (NNS.gt.0) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idTbry(isouth,isand(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2,a)') & - & TRIM(ADJUSTL(Vinfo(4))), i, ' southern-boundary' - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF - CASE ('idTbry(inorth,isand(i))') - load=.FALSE. - IF (NNS.gt.0) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idTbry(inorth,isand(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2,a)') & - & TRIM(ADJUSTL(Vinfo(4))), i, ' northern-boundary' - WRITE (Vname(5,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(5))) - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='_in_sea_water') - END DO - varid=varid+1 - END IF + CASE ('idTbry(iwest,idmud(i))') + load=.FALSE. + IF (NCS.gt.0) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idTbry(iwest,idmud(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idTbry(ieast,idmud(i))') + load=.FALSE. + IF (NCS.gt.0) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idTbry(ieast,idmud(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idTbry(isouth,idmud(i))') + load=.FALSE. + IF (NCS.gt.0) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idTbry(isouth,idmud(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idTbry(inorth,idmud(i))') + load=.FALSE. + IF (NCS.gt.0) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idTbry(inorth,idmud(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idTbry(iwest,isand(i))') + load=.FALSE. + IF (NNS.gt.0) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idTbry(iwest,isand(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idTbry(ieast,isand(i))') + load=.FALSE. + IF (NNS.gt.0) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idTbry(ieast,isand(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idTbry(isouth,isand(i))') + load=.FALSE. + IF (NNS.gt.0) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idTbry(isouth,isand(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idTbry(inorth,isand(i))') + load=.FALSE. + IF (NNS.gt.0) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idTbry(inorth,isand(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + /* ** Sediment tracers point Source/Sinks (river runoff). */ - CASE ('idRtrc(idmud)') - load=.FALSE. - IF (NCS.gt.0) THEN - varid=varid-1 - DO i=1,NCS - varid=varid+1 - idRtrc(idmud(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='trasnport_into_sea_water_from_rivers') - END DO - varid=varid+1 - END IF - CASE ('idRtrc(isand)') - load=.FALSE. - IF (NNS.gt.0) THEN - varid=varid-1 - DO i=1,NNS - varid=varid+1 - idRtrc(isand(i))=varid - DO ng=1,Ngrids - Fscale(varid,ng)=scale - Iinfo(1,varid,ng)=gtype - END DO - WRITE (Vname(1,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(1))), i - WRITE (Vname(2,varid),'(a,a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i - WRITE (Vname(3,varid),'(a)') & - & TRIM(ADJUSTL(Vinfo(3))) - WRITE (Vname(4,varid),'(a,i2.2)') & - & TRIM(ADJUSTL(Vinfo(4))), i - WRITE (string,'(a,i2.2)') TRIM(ADJUSTL(Vinfo(6))), i - CALL StandardName (Vname(6,varid), string, & - & suffix='trasnport_into_sea_water_from_rivers') - END DO - varid=varid+1 - END IF + CASE ('idRtrc(idmud)') + load=.FALSE. + IF (NCS.gt.0) THEN + varid=varid-1 + DO i=1,NCS + varid=varid+1 + idRtrc(idmud(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF + CASE ('idRtrc(isand)') + load=.FALSE. + IF (NNS.gt.0) THEN + varid=varid-1 + DO i=1,NNS + varid=varid+1 + idRtrc(isand(i))=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF diff --git a/ROMS/Nonlinear/Sediment/sediment_wrt.h b/ROMS/Nonlinear/Sediment/sediment_wrt.h index 9475952c..d44b52d5 100644 --- a/ROMS/Nonlinear/Sediment/sediment_wrt.h +++ b/ROMS/Nonlinear/Sediment/sediment_wrt.h @@ -13,7 +13,7 @@ */ ! -! Write out Nemuro ecosystem model parameters. +! Write out sediment model parameters. ! CALL netcdf_put_fvar (ng, model, ncname, 'minlayer_thick', & & minlayer_thick(ng), (/0/), (/0/), & @@ -24,15 +24,45 @@ & newlayer_thick(ng), (/0/), (/0/), & & ncid = ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - + CALL netcdf_put_fvar (ng, model, ncname, 'sg_zwbl', & + & sg_zwbl(ng), (/0/), (/0/), & + & ncid = ncid) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN #ifdef BEDLOAD CALL netcdf_put_fvar (ng, model, ncname, 'bedload_coeff', & & bedload_coeff(ng), (/0/), (/0/), & & ncid = ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! +!# ifdef BEDLOAD_VANDERA + CALL netcdf_put_fvar (ng, model, ncname, 'sedslope_crit_wet', & + & sedslope_crit_wet(ng), (/0/), (/0/), & + & ncid = ncid) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + CALL netcdf_put_fvar (ng, model, ncname, 'sedslope_crit_dry', & + & sedslope_crit_dry(ng), (/0/), (/0/), & + & ncid = ncid) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + CALL netcdf_put_fvar (ng, model, ncname, 'slopefac_wet', & + & slopefac_wet(ng), (/0/), (/0/), & + & ncid = ncid) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + CALL netcdf_put_fvar (ng, model, ncname, 'slopefac_dry', & + & slopefac_dry(ng), (/0/), (/0/), & + & ncid = ncid) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + CALL netcdf_put_fvar (ng, model, ncname, 'bedload_vandera_alphaw',& + & bedload_vandera_alphaw(ng), (/0/), (/0/), & + & ncid = ncid) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + CALL netcdf_put_fvar (ng, model, ncname, 'bedload_vandera_alphac',& + & bedload_vandera_alphac(ng), (/0/), (/0/), & + & ncid = ncid) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +!# endif #endif -#ifdef ANA_SEDIMENT +!#ifdef ANA_SEDIMENT CALL netcdf_put_fvar (ng, model, ncname, 'Sd50', & & Sd50(:,ng), (/1/), (/NST/), & & ncid = ncid) @@ -47,7 +77,7 @@ & Csed(:,ng), (/1/), (/NST/), & & ncid = ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN -#endif +!#endif CALL netcdf_put_fvar (ng, model, ncname, 'Wsed', & & Wsed(:,ng), (/1/), (/NST/), & diff --git a/ROMS/Nonlinear/Sediment/sedtr_decay.F b/ROMS/Nonlinear/Sediment/sedtr_decay.F new file mode 100644 index 00000000..f1038999 --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sedtr_decay.F @@ -0,0 +1,248 @@ +#include "cppdefs.h" + + MODULE sedtr_decay_mod + +#if defined NONLINEAR && defined SEDIMENT && defined SEDTR_REACTIONS \ + && defined SEDTR_DECAY +! +!git $Id$ +!==================================================== John C. Warner === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Hernan G. Arango ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! This routine computes reaction term for particles and particle- ! +! associated material. ! +! ! +! Module built based on version of Soetaert model as coded by K. ! +! Fennel and Robin West (Dalhousie), and was incorporated into ROMS by! +! ! +! Moriarty, J.M., C.K. Harris, K. Fennel, M.A.M. Friedrichs, K. Xu, ! +! and C. Rabouille, 2017: The roles of resuspension, diffusion and ! +! biogeochemical processes on oxygen dynamics offshore of the Rhone ! +! River, France: a numerical modeling study, Biogeosciences, 14, ! +! 1919-1946. ! +! ! +! Currently, reactions for particulate organic matter and dissolved ! +! nutrients are available. At present we include multiple organic ! +! carbon fractions, oxygen, nitrate, ammonium, and oxygen demand ! +! units (ODUs). We account for oxic and anerobic mineralization, and ! +! denitrification, as well as nitrification and oxidation of ODUs. ! +! Annamox and phosphorus code could be added later. Changes in ! +! porosity are neglected. Inert organic matter should be modeled using! +! inert sediment classes. Since publication, the model has been ! +! adapted to allow particulate organic matter to affect seabed mass ! +! and seabed layer thicknesses, but neglects variations in N:C ratios ! +! and biodiffusion coefficients. ! +! ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: sedtr_decay + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sedtr_decay (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_sedbed + USE mod_stepping +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16, __LINE__, __FILE__) +# endif + CALL sedtr_decay_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & + & OCEAN(ng) % t, & + & SEDBED(ng) % bed_mass, & + & SEDBED(ng) % bed_frac, & + & SEDBED(ng) % bed) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16, __LINE__, __FILE__) +# endif + RETURN + END SUBROUTINE sedtr_decay +! +!*********************************************************************** + SUBROUTINE sedtr_decay_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & + & t, & + & bed_mass, bed_frac, bed) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment +! + USE bc_3d_mod, ONLY : bc_r3d_tile + USE exchange_2d_mod, ONLY : exchange_r2d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE + real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) +# else + real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng)) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) + real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) + real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) +# endif +! +! Local variable declarations. +! + integer :: i, ised, j, k + + real(r8), parameter :: eps = 1.0E-14_r8 + real(r8), parameter :: zeros = 0.0_r8 + real(r8), parameter :: ones = 1.0_r8 + real(r8) :: cff + + real(r8) :: oc(NST) + real(r8) :: docdt(NST) + real(r8) :: rem + +! Coefficients for remineralization and oxidation reactions + real(r8) :: r_om=0.15_r8 !ratio mol N: mol C for POM + real(r8) :: kg2mmolC = 1000.0_r8/12.0107_r8 !ratio of + !sediment mass to mmol Carbon + ![mmol/kg] +# include "set_bounds.h" + +! +!----------------------------------------------------------------------- +! Particulate organic matter remineralization & +! Update to bed mass. +!----------------------------------------------------------------------- +! + J_LOOP : DO j=Jstr,Jend + I_LOOP : DO i=Istr,Iend + K_LOOP : DO k=1,Nbed + +! +!----------------------------------------------------------------------- +! Prepare for Soetaert routines +!----------------------------------------------------------------------- +! + +! Convert tracer units from ROMS to Soetaert units +! From mmol/m2 (bulk) to mmol / m3 solids or porewater +! Also convert POM from kg to mmol C, and set oc = 0 for inorganics +! + DO ised=1,NST + + IF (sed_rxn(ised,ng).ne.0.0_r8) THEN +! Calculate rate constant for POM remineralization (1/s), +! change in POM due to remineralization, +! and change to bed mass due to decaying POM + rem=(sed_rxn(ised,ng) & +# ifdef SEDBIO_POM_TVAR + & + 1.0_r8**(t(i,j,1,nstp,itemp)-20.0_r8) & +# endif + & )/24.0_r8/3600.0_r8 + docdt(ised) = 0.0_r8 + bed_mass(i,j,k,nnew,ised)*rem +! Use updated derivatives to update tracer values. +! Convert from mmol/m3 porewater or solids to mmol / m2 (bulk) + bed_mass(i,j,k,nnew,ised) = MAX(0.0_r8, & + & bed_mass(i,j,k,nnew,ised) - dt(ng)*docdt(ised)) + t(i,j,k,nnew,ised) = MAX(0.0_r8, & + & t(i,j,k,nnew,ised)*(1.0_r8 - dt(ng)*rem)) + + + +! ELSE +! oc(ised)=0.0_r8 +! bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nnew,ised) + END IF + + END DO + +! +!----------------------------------------------------------------------- +! Update bed properties following reaction terms. +!----------------------------------------------------------------------- +! + bed(i,j,k,ithck)=zeros + cff=zeros + DO ised=1,NST + cff=cff+bed_mass(i,j,k,nnew,ised) + END DO + cff=MAX(eps,cff) + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_mass(i,j,k,nnew,ised)/cff + bed(i,j,k,ithck)=bed(i,j,k,ithck)+ & + & bed_mass(i,j,k,nnew,ised)/(Srho(ised,ng)* & + & (ones-bed(i,j,k,iporo))) + END DO + + END DO K_LOOP + END DO I_LOOP + END DO J_LOOP +! +!----------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions to property arrays. +!----------------------------------------------------------------------- +! + DO ised=1,NST + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_frac(:,:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed_frac, & + & bed_mass(:,:,:,nnew,:)) +# endif + + DO i=1,MBEDP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed(:,:,:,i)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, MBEDP, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed) +# endif + RETURN + END SUBROUTINE sedtr_decay_tile +#endif + END MODULE sedtr_decay_mod diff --git a/ROMS/Nonlinear/Sediment/sedtr_reactions_pom.F b/ROMS/Nonlinear/Sediment/sedtr_reactions_pom.F new file mode 100644 index 00000000..2cda8e59 --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sedtr_reactions_pom.F @@ -0,0 +1,421 @@ +#include "cppdefs.h" + + MODULE sedtr_reactions_pom_mod + +#if defined NONLINEAR && defined SEDIMENT && defined SEDTR_REACTIONS \ + && defined SEDBIO_COUP +! +!git $Id$ +!==================================================== John C. Warner === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Hernan G. Arango ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! This routine computes reaction term for particles and particle- ! +! associated material. ! +! ! +! Module built based on version of Soetaert model as coded by K. ! +! Fennel and Robin West (Dalhousie), and was incorporated into ROMS by! +! ! +! Moriarty, J.M., C.K. Harris, K. Fennel, M.A.M. Friedrichs, K. Xu, ! +! and C. Rabouille, 2017: The roles of resuspension, diffusion and ! +! biogeochemical processes on oxygen dynamics offshore of the Rhone ! +! River, France: a numerical modeling study, Biogeosciences, 14, ! +! 1919-1946. ! +! ! +! Currently, reactions for particulate organic matter and dissolved ! +! nutrients are available. At present we include multiple organic ! +! carbon fractions, oxygen, nitrate, ammonium, and oxygen demand ! +! units (ODUs). We account for oxic and anerobic mineralization, and ! +! denitrification, as well as nitrification and oxidation of ODUs. ! +! Annamox and phosphorus code could be added later. Changes in ! +! porosity are neglected. Inert organic matter should be modeled using! +! inert sediment classes. Since publication, the model has been ! +! adapted to allow particulate organic matter to affect seabed mass ! +! and seabed layer thicknesses, but neglects variations in N:C ratios ! +! and biodiffusion coefficients. ! +! ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: sedtr_reactions_pom + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sedtr_reactions_pom (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_sedbed + USE mod_biology + USE mod_stepping +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16, __LINE__, __FILE__) +# endif + CALL sedtr_reactions_pom_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & + & OCEAN(ng) % t, & + & SEDBED(ng) % bed_mass, & + & SEDBED(ng) % bed_frac, & + & SEDBED(ng) % bed) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16, __LINE__, __FILE__) +# endif + RETURN + END SUBROUTINE sedtr_reactions_pom +! +!*********************************************************************** + SUBROUTINE sedtr_reactions_pom_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & + & t, & + & bed_mass, bed_frac, bed) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment + USE mod_biology +! + USE bc_3d_mod, ONLY : bc_r3d_tile + USE exchange_2d_mod, ONLY : exchange_r2d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE + real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) +# else + real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng)) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) + real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) + real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) +# endif +! +! Local variable declarations. +! + integer :: i, ised, j, k + + real(r8), parameter :: eps = 1.0E-14_r8 + real(r8), parameter :: zeros = 0.0_r8 + real(r8), parameter :: ones = 1.0_r8 + real(r8) :: cff + + real(r8) :: o2,no3, nh4, odu + real(r8) :: oc(NST) + real(r8) :: docdt(NST) + real(r8) :: docdt_tot, doc1dt, doc2dt, do2dt, dodudt + real(r8) :: dnh4dt, dno3dt + real(r8) :: sConv, pwConv, poroConv + real(r8) :: rxnOC1, rxnOC2 + real(r8) :: rxnOC1_o2, rxnOC2_o2, rxnOC_o2 + real(r8) :: rxnNH4_o2, rxnODU_o2, rxnOC_odu + real(r8) :: rxnOC_no3, rxnNH4_amx + real(r8) :: o2lim, totlim, odulim, dnflim + real(r8) :: oxodu,nit + real(r8) :: rem + +! Coefficients for remineralization and oxidation reactions + real(r8) :: r_om=0.15_r8 !ratio mol N: mol C for POM + real(r8) :: kg2mmolC = 1000.0_r8/12.0107_r8 !ratio of + !sediment mass to mmol Carbon + ![mmol/kg] + real(r8) :: k_o2 = 1.0_r8 !Half-sat for O2 lim in + !aerobic remin + ![umol o2/L == mmol/m3] + real(r8) :: kin_odu = 1.0_r8 !Half-sat for O2 inhib. of + !anaerobic remin + ![umol o2/L == mmol/m3] + real(r8) :: oxodu_base = 20.0_r8 !oxidation rate of ODUs [1/d] + real(r8) :: k_odu = 1.0_r8 !Half-sat for O2 lim in + !ODU oxidation + ![umol o2/L == mmol/m3] + real(r8) :: nit_base = 100.0_r8 !Nitrification Rate [1/d] + real(r8) :: k_nit = 10.0_r8 !Half-sat for O2 lim of + !nitrification + ![umol o2/L == mmol/m3] + real(r8) :: k_dnf = 20.0_r8 !Half-sat for NO3 lim in + !denitrification + ![umol o2/L == mmol/m3] + real(r8) :: kin_dnf = 1.0_r8 !Half-sat for O2 inhib of + !denitrification + ![umol o2/L == mmol/m3] + real(r8) :: kin_anox_no3 = 10.0_r8 !Half-sat for NO3 inhib of + !anerobic remin + ![umol no3/L == mmol/m3] + real(r8) :: PB = 0.995_r8 !Fraction of newly created + !ODUS that are + !assumed to be inert + real(r8) :: NH4ads = 1.3_r8 !NH4 adsorption coefficient +# include "set_bounds.h" + +! +!----------------------------------------------------------------------- +! Particulate organic matter remineralization & +! Update to bed mass. +!----------------------------------------------------------------------- +! + J_LOOP : DO j=Jstr,Jend + I_LOOP : DO i=Istr,Iend + K_LOOP : DO k=1,Nbed + +! +!----------------------------------------------------------------------- +! Prepare for Soetaert routines +!----------------------------------------------------------------------- +! +! Conversion factors to account for porosity and bed thickness +! units are meters for sConv and pwConv + sConv = (1.0_r8-bed(i,j,k,iporo))*bed(i,j,k,ithck) + pwConv = bed(i,j,k,iporo)*bed(i,j,k,ithck) + poroConv = (1.0_r8-bed(i,j,k,iporo))/bed(i,j,k,iporo) + +! Calculate rate constants for nitrification, ODU oxidation (1/s) + nit=nit_base/24.0_r8/3600.0_r8 + oxodu=oxodu_base/24.0_r8/3600.0_r8 + +! Convert tracer units from ROMS to Soetaert units +! From mmol/m2 (bulk) to mmol / m3 solids or porewater +! Also convert POM from kg to mmol C, and set oc = 0 for inorganics +! +!IF ((i.eq.3).and.(j.eq.3).and.(k.eq.1)) THEN +!write(6,*),"w.c.conc 1",t(i,j,1,nnew,iwc)/Hz(i,j,1) +!write(6,*),"sd conc 10",bed(i,j,1,iboxy)/ & +! & bed(i,j,1,ithck)/bed(i,j,1,iporo) +!ENDIF + o2 =bed(i,j,k,iboxy)/pwConv + no3=bed(i,j,k,ibno3)/pwConv + nh4=bed(i,j,k,ibnh4)/pwConv + odu=bed(i,j,k,ibodu)/pwConv +!IF ((i.eq.3).and.(j.eq.3).and.(k.eq.1)) THEN +!write(6,*) "bed_oxy: ",o2 +!write(6,*) "bed_no3: ",no3 +!write(6,*) "bed_nh4: ",nh4 +!write(6,*) "bed_odu: ",odu +!END IF + DO ised=1,NST + IF (sed_rxn(ised,ng).ne.0.0_r8) THEN + oc(ised)=bed_mass(i,j,k,nnew,ised)*kg2mmolC/sConv + ELSE + oc(ised)=0.0_r8 + END IF + END DO + +! Initialize derivatives + dnh4dt = 0.0_r8 + dno3dt = 0.0_r8 + do2dt = 0.0_r8 + dodudt = 0.0_r8 + docdt_tot = 0.0_r8 + +! Calculate limitation terms that are used to partition OM +! remineralization between aerobic, nitrate and anerobic +! remineralization + o2lim = o2/(o2+k_o2) + odulim = kin_odu/(o2+kin_odu) & + & *kin_anox_NO3/(no3+kin_anox_NO3) + dnflim = no3/(no3+k_dnf) & + & *kin_dnf/(kin_dnf+o2) + totlim = o2lim+odulim+dnflim+eps + +! Calculate rate constant for POM remineralization (1/s), +! change in POM due to remineralization, +! and change to bed mass due to decaying POM + DO ised=1,NST + rem=(sed_rxn(ised,ng) & +# ifdef SEDBIO_POM_TVAR + & + 1.0_r8**(t(i,j,1,nstp,itemp)-20.0_r8) & +# endif + & )/24.0_r8/3600.0_r8 + docdt(ised) = 0.0_r8 + oc(ised)*rem + docdt_tot = docdt_tot + docdt(ised) + END DO + +! Calculate O2 consumed by aerobic respiration (O2:C = 1:1) +! in mmol O2/m3/s porewater + rxnOC_o2 = docdt_tot*o2lim/totlim *poroConv + +! Calculate NO3 consumed by denitrification (NO3:C = 0.8:1) +! (mmol NO3/m3 porewater /sec + rxnOC_no3 = 0.8_r8*docdt_tot*dnflim/totlim*poroConv + +! Calculate ODUs produced by anaerobic metabolism (ODU:C = 1:1). +! (mmol ODU/m3 porewater/sec) +! Note that a fraction (=PB) of the ODUs are considered to be lost +! because they are assumed to be non-reactive solids. + rxnOC_odu = docdt_tot*odulim/totlim & + & *poroConv*(1.0_r8-PB) + +! Calculate O2 consumed by nitrification (O2:NH3 = 2:1) (rxnNH4_o2) +! and by ODU oxidation (O2:ODU = 1:1) (rxnODU_o2) +! in mmol O2/m3 porewater /sec +! +! Note that calculations assume that remineralizaiton occurs first +! so rxnOC_* are subtracted/added to o2, no3, and odu + rxnNH4_o2 = 2.0_r8*nit*(nh4+docdt_tot*r_om*poroConv) & + & *(o2-rxnOC_o2)/((o2-rxnOC_o2)+k_nit) +! rxnNH4_o2 = 2.0_r8*nit*(no3-rxnOC_no3)*(o2-rxnOC_o2) & +! & /((o2-rxnOC_o2)+k_nit) +! rxnNH4_o2 = 2.0_r8*nit*nh4*o2/(o2+k_nit) + rxnODU_o2 = oxodu*(o2-rxnOC_o2)*(odu+rxnOC_odu) & + & /((o2-rxnOC_o2)+k_odu) +! rxnODU_o2 = oxodu*o2*odu/(o2+k_odu) + +! Calculate NH4 consumed by anammox: 5NH3 + 3HNO3 -> 4N2 + 9H2O +! simplify: Neglect anammox + rxnNH4_amx = 0.0_r8 + +! +!----------------------------------------------------------------------- +! Update derivatives of dissolved tracers +!----------------------------------------------------------------------- +! All units are mmol tracer /m3 porewater/s +! + do2dt = do2dt - rxnOC_o2 - rxnNH4_o2 - rxnODU_o2 + dodudt = dodudt + rxnOC_odu - rxnODU_o2 + dno3dt = dno3dt - rxnOC_no3 + rxnNH4_o2/2.0_r8 & + & - rxnNH4_amx*3.0_r8/5.0_r8 + dnh4dt = dnh4dt - rxnNH4_o2/2.0_r8 - rxnNH4_amx + & + & docdt_tot*r_om*poroConv +! Ammonium adsorption + dnh4dt=dnh4dt/(1.0_r8+NH4ads) + +! Use updated derivatives to update tracer values. +! Convert from mmol/m3 porewater or solids to mmol / m2 (bulk) + o2 = (o2 + dt(ng)*do2dt) *pwConv + no3 = (no3 + dt(ng)*dno3dt)*pwConv + nh4 = (nh4 + dt(ng)*dnh4dt)*pwConv + odu = (odu + dt(ng)*dodudt)*pwConv + DO ised=1,NST + oc(ised) = (oc(ised) - dt(ng)*docdt(ised))*sConv & + & /kg2mmolC + END DO + +! Make sure tracers are positive + o2=MAX(o2,0.0_r8) + no3=MAX(no3,0.0_r8) + nh4=MAX(nh4,0.0_r8) + odu=MAX(odu,0.0_r8) + DO ised=1,NST + oc(ised)=MAX(oc(ised),0.0_r8) + END DO +! +! Map bed tracer values back into ROMS variable +! + bed(i,j,k,iboxy)=o2 + bed(i,j,k,ibno3)=no3 + bed(i,j,k,ibnh4)=nh4 + bed(i,j,k,ibodu)=odu + DO ised=1,NST + IF (sed_rxn(ised,ng).ne.0.0_r8) THEN + bed_mass(i,j,k,nnew,ised)=oc(ised) + ELSE + bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nnew,ised) + END IF + END DO +!IF ((i.eq.3).and.(j.eq.3).and.(k.eq.1)) THEN +!write(6,*),"w.c.conc 1",t(i,j,1,nnew,iwc)/Hz(i,j,1) +!write(6,*),"sd conc 15",bed(i,j,1,iboxy)/ & +! & bed(i,j,1,ithck)/bed(i,j,1,iporo) +!ENDIF + + END DO K_LOOP + END DO I_LOOP + END DO J_LOOP + + +! +!----------------------------------------------------------------------- +! Update bed properties following reaction terms. +!----------------------------------------------------------------------- +! + DO j=JstrR,JendR + DO i=IstrR,IendR + DO k=1,Nbed + bed(i,j,k,ithck)=zeros + cff=zeros + DO ised=1,NST + cff=cff+bed_mass(i,j,k,nnew,ised) + END DO + cff=MAX(eps,cff) + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_mass(i,j,k,nnew,ised)/cff + bed(i,j,k,ithck)=bed(i,j,k,ithck)+ & + & bed_mass(i,j,k,nnew,ised)/(Srho(ised,ng)* & + & (ones-bed(i,j,k,iporo))) + END DO +!IF ((i.eq.3).and.(j.eq.3).and.(k.eq.1)) THEN +!write(6,*),"w.c.conc 1",t(i,j,1,nnew,iwc)/Hz(i,j,1) +!write(6,*),"sd conc 19",bed(i,j,1,iboxy)/ & +! & bed(i,j,1,ithck)/bed(i,j,1,iporo) +!ENDIF + END DO + END DO + END DO +! +!----------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions to property arrays. +!----------------------------------------------------------------------- +! + DO ised=1,NST + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_frac(:,:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed_frac, & + & bed_mass(:,:,:,nnew,:)) +# endif + + DO i=1,MBEDP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed(:,:,:,i)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, MBEDP, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed) +# endif + RETURN + END SUBROUTINE sedtr_reactions_pom_tile +#endif + END MODULE sedtr_reactions_pom_mod diff --git a/ROMS/Nonlinear/Sediment/sedtr_reactions_sed_decay.F b/ROMS/Nonlinear/Sediment/sedtr_reactions_sed_decay.F new file mode 100644 index 00000000..85ac4a13 --- /dev/null +++ b/ROMS/Nonlinear/Sediment/sedtr_reactions_sed_decay.F @@ -0,0 +1,248 @@ +#include "cppdefs.h" + + MODULE sedtr_reactions_sed_decay_mod + +#if defined NONLINEAR && defined SEDIMENT && defined SEDTR_REACTIONS \ + && defined SEDTR_SED_DECAY +! +!git $Id$ +!==================================================== John C. Warner === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Hernan G. Arango ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! This routine computes reaction term for particles and particle- ! +! associated material. ! +! ! +! Module built based on version of Soetaert model as coded by K. ! +! Fennel and Robin West (Dalhousie), and was incorporated into ROMS by! +! ! +! Moriarty, J.M., C.K. Harris, K. Fennel, M.A.M. Friedrichs, K. Xu, ! +! and C. Rabouille, 2017: The roles of resuspension, diffusion and ! +! biogeochemical processes on oxygen dynamics offshore of the Rhone ! +! River, France: a numerical modeling study, Biogeosciences, 14, ! +! 1919-1946. ! +! ! +! Currently, reactions for particulate organic matter and dissolved ! +! nutrients are available. At present we include multiple organic ! +! carbon fractions, oxygen, nitrate, ammonium, and oxygen demand ! +! units (ODUs). We account for oxic and anerobic mineralization, and ! +! denitrification, as well as nitrification and oxidation of ODUs. ! +! Annamox and phosphorus code could be added later. Changes in ! +! porosity are neglected. Inert organic matter should be modeled using! +! inert sediment classes. Since publication, the model has been ! +! adapted to allow particulate organic matter to affect seabed mass ! +! and seabed layer thicknesses, but neglects variations in N:C ratios ! +! and biodiffusion coefficients. ! +! ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: sedtr_reactions_sed_decay + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sedtr_reactions_sed_decay (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_sedbed + USE mod_stepping +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16, __LINE__, __FILE__) +# endif + CALL sedtr_reactions_sed_decay_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & + & OCEAN(ng) % t, & + & SEDBED(ng) % bed_mass, & + & SEDBED(ng) % bed_frac, & + & SEDBED(ng) % bed) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16, __LINE__, __FILE__) +# endif + RETURN + END SUBROUTINE sedtr_reactions_sed_decay +! +!*********************************************************************** + SUBROUTINE sedtr_reactions_sed_decay_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & + & t, & + & bed_mass, bed_frac, bed) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment +! + USE bc_3d_mod, ONLY : bc_r3d_tile + USE exchange_2d_mod, ONLY : exchange_r2d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE + real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) + real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) +# else + real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng)) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) + real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) + real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) +# endif +! +! Local variable declarations. +! + integer :: i, ised, j, k + + real(r8), parameter :: eps = 1.0E-14_r8 + real(r8), parameter :: zeros = 0.0_r8 + real(r8), parameter :: ones = 1.0_r8 + real(r8) :: cff + + real(r8) :: oc(NST) + real(r8) :: docdt(NST) + real(r8) :: rem + +! Coefficients for remineralization and oxidation reactions + real(r8) :: r_om=0.15_r8 !ratio mol N: mol C for POM + real(r8) :: kg2mmolC = 1000.0_r8/12.0107_r8 !ratio of + !sediment mass to mmol Carbon + ![mmol/kg] +# include "set_bounds.h" + +! +!----------------------------------------------------------------------- +! Particulate organic matter remineralization & +! Update to bed mass. +!----------------------------------------------------------------------- +! + J_LOOP : DO j=Jstr,Jend + I_LOOP : DO i=Istr,Iend + K_LOOP : DO k=1,Nbed + +! +!----------------------------------------------------------------------- +! Prepare for Soetaert routines +!----------------------------------------------------------------------- +! + +! Convert tracer units from ROMS to Soetaert units +! From mmol/m2 (bulk) to mmol / m3 solids or porewater +! Also convert POM from kg to mmol C, and set oc = 0 for inorganics +! + DO ised=1,NST + + IF (sed_rxn(ised,ng).ne.0.0_r8) THEN +! Calculate rate constant for POM remineralization (1/s), +! change in POM due to remineralization, +! and change to bed mass due to decaying POM + rem=(sed_rxn(ised,ng) & +# ifdef SEDBIO_POM_TVAR + & + 1.0_r8**(t(i,j,1,nstp,itemp)-20.0_r8) & +# endif + & )/24.0_r8/3600.0_r8 + docdt(ised) = 0.0_r8 + bed_mass(i,j,k,nnew,ised)*rem +! Use updated derivatives to update tracer values. +! Convert from mmol/m3 porewater or solids to mmol / m2 (bulk) + bed_mass(i,j,k,nnew,ised) = MAX(0.0_r8, & + & bed_mass(i,j,k,nnew,ised) - dt(ng)*docdt(ised)) + t(i,j,k,nnew,ised) = MAX(0.0_r8, & + & t(i,j,k,nnew,ised)*(1.0_r8 - dt(ng)*rem)) + + + +! ELSE +! oc(ised)=0.0_r8 +! bed_mass(i,j,k,nnew,ised)=bed_mass(i,j,k,nnew,ised) + END IF + + END DO + +! +!----------------------------------------------------------------------- +! Update bed properties following reaction terms. +!----------------------------------------------------------------------- +! + bed(i,j,k,ithck)=zeros + cff=zeros + DO ised=1,NST + cff=cff+bed_mass(i,j,k,nnew,ised) + END DO + cff=MAX(eps,cff) + DO ised=1,NST + bed_frac(i,j,k,ised)=bed_mass(i,j,k,nnew,ised)/cff + bed(i,j,k,ithck)=bed(i,j,k,ithck)+ & + & bed_mass(i,j,k,nnew,ised)/(Srho(ised,ng)* & + & (ones-bed(i,j,k,iporo))) + END DO + + END DO K_LOOP + END DO I_LOOP + END DO J_LOOP +! +!----------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions to property arrays. +!----------------------------------------------------------------------- +! + DO ised=1,NST + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_frac(:,:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed_frac, & + & bed_mass(:,:,:,nnew,:)) +# endif + + DO i=1,MBEDP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed(:,:,:,i)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, MBEDP, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed) +# endif + RETURN + END SUBROUTINE sedtr_reactions_sed_decay_tile +#endif + END MODULE sedtr_reactions_sed_decay_mod diff --git a/ROMS/Nonlinear/Vegetation/CMakeLists.txt b/ROMS/Nonlinear/Vegetation/CMakeLists.txt new file mode 100644 index 00000000..0bfef393 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/CMakeLists.txt @@ -0,0 +1,25 @@ +# git $Id$ +#:::::::::::::::::::::::::::::::::::::::::::::::::::::: David Robertson ::: +# Copyright (c) 2002-2024 The ROMS/TOMS Group ::: +# Licensed under a MIT/X style license ::: +# See License_ROMS.txt ::: +#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +# +# Source code list for sub-directory "ROMS/Nonlinear/Wec" + +list( APPEND _files + ROMS/Nonlinear/Vegetation/marsh_dynamics.F + ROMS/Nonlinear/Vegetation/marsh_sed_erosion.F + ROMS/Nonlinear/Vegetation/marsh_tidal_range_calc.F + ROMS/Nonlinear/Vegetation/marsh_vert_growth.F + ROMS/Nonlinear/Vegetation/marsh_wave_thrust.F + ROMS/Nonlinear/Vegetation/vegetation_biomass.F + ROMS/Nonlinear/Vegetation/vegetation_drag.F + ROMS/Nonlinear/Vegetation/vegetation_stream.F + ROMS/Nonlinear/Vegetation/vegetation_turb_cal.F +) + +set ( ROMS_Nonlinear_Vegetation_files + ${_files} + PARENT_SCOPE +) diff --git a/ROMS/Nonlinear/Vegetation/Module.mk b/ROMS/Nonlinear/Vegetation/Module.mk new file mode 100644 index 00000000..447614f2 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/Module.mk @@ -0,0 +1,14 @@ +# git $Id$ +#::::::::::::::::::::::::::::::::::::::::::::::::::::: Hernan G. Arango ::: +# Copyright (c) 2002-2024 The ROMS/TOMS Group Kate Hedstrom ::: +# Licensed under a MIT/X style license ::: +# See License_ROMS.txt ::: +#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +local_sub := ROMS/Nonlinear/Vegetation + +local_src := $(wildcard $(local_sub)/*.F) + +sources += $(local_src) + +$(eval $(compile-rules)) diff --git a/ROMS/Nonlinear/Vegetation/marsh_dynamics.F b/ROMS/Nonlinear/Vegetation/marsh_dynamics.F new file mode 100644 index 00000000..3b38c648 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/marsh_dynamics.F @@ -0,0 +1,124 @@ +#include "cppdefs.h" + + MODULE marsh_dynamics_mod +#if defined VEGETATION && defined MARSH_DYNAMICS +! +!git $Id$ +!================================================ Tarandeep S. Kalra === +! Copyright (c) 2002-2024 The ROMS/TOMS Group Neil K. Ganju ! +! Licensed under a MIT/X style license John C. Warner ! +! See License_ROMS.txt Julia M. Moriarty ! +!============================================== Alfredo Aretxabaleta === +! ! +! This routine is the main driver for marsh dynamics and accounts ! +! for two processes through various sub-routines: ! +! ! +! 1. Calculate lateral wave thrust and sediment release from ! +! edge erosion ! +! 2. Calculate vertical biomass production (autochthonous supply) ! +! (organic sediment) ! +! ! +! This is done through the following modules: ! +! ! +! 1. Compute wave thrust on marshes ! +! --> marsh_wave_thrust.F ! +! 2. Obtain sediment release (i.e. lateral erosion) out of marsh cells! +! --> marsh_sed_erosion.F ! +! 3. Compute the mean tidal range and marsh high water ! +! --> marsh_tidal_range.F ! +! 4. Compute marsh biomass production and vertical accretion ! +! --> marsh_vert_growth.F ! +! ! +! References: ! +! Kalra, T.S., Ganju, N.K., Aretxabaleta, A., Moriarty, J.M., ! +! Aretxabaleta, A., Warner, J.C., Carr, J., Leonardi., N., ! +! Modeling Marsh Dynamics Using a 3-D Coupled Wave-Flow-Sediment ! +! Model (In process). ! +! ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: marsh_dynamics + + CONTAINS +! +!*********************************************************************** +! + SUBROUTINE marsh_dynamics (ng, tile) +! +!*********************************************************************** +! + USE mod_param + USE mod_stepping + USE mod_scalars +# if defined MARSH_WAVE_THRUST + USE marsh_wave_thrust_mod, ONLY : marsh_wave_thrust +# endif +# if defined MARSH_SED_EROSION + USE marsh_sed_erosion_mod, ONLY : marsh_sed_erosion +# endif +# if defined MARSH_TIDAL_RANGE_CALC + USE marsh_tidal_range_calc_mod, ONLY : marsh_tidal_range_calc +# endif +# if defined MARSH_VERT_GROWTH + USE marsh_vert_growth_mod, ONLY : marsh_vert_growth +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! + character (len=*), parameter :: MyFile = & + & __FILE__ +! +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16, __LINE__, MyFile) +# endif +! +!*********************************************************************** +! Wave induced thrust calculation on marsh boundary. +!*********************************************************************** +! +# if defined MARSH_WAVE_THRUST + CALL marsh_wave_thrust(ng, tile) +# endif +! +# if defined MARSH_SED_EROSION +! +!*********************************************************************** +! Marsh sediment erosion based on bathy change in marsh cells. +!*********************************************************************** +! + CALL marsh_sed_erosion(ng, tile) +# endif +! +# if defined MARSH_TIDAL_RANGE_CALC +! +!*********************************************************************** +! Compute tidal range and mean high water over a given frequency. +!*********************************************************************** +! + CALL marsh_tidal_range_calc(ng, tile) +# endif +! + +# if defined MARSH_VERT_GROWTH +! +!*********************************************************************** +! Compute vertical biomass production of marsh. +!*********************************************************************** +! + CALL marsh_vert_growth(ng, tile) +# endif +! +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16)! +# endif + RETURN + END SUBROUTINE marsh_dynamics +#endif + END MODULE marsh_dynamics_mod diff --git a/ROMS/Nonlinear/Vegetation/marsh_sed_erosion.F b/ROMS/Nonlinear/Vegetation/marsh_sed_erosion.F new file mode 100644 index 00000000..0450f5cb --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/marsh_sed_erosion.F @@ -0,0 +1,427 @@ +#include "cppdefs.h" + + MODULE marsh_sed_erosion_mod +! +#if defined SEDIMENT && defined MARSH_DYNAMICS \ + && defined MARSH_SED_EROSION +! +!git $Id$ +!======================================================================! +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.txt Alexander F. Shchepetkin ! +!==============================================Tarandeep S. Kalra======! +!==============================================Julia M. Moriarty=======! +!================================================Neil K. Ganju =======! +!==============================================John C. Warner==========! +! ! +! This routine calculates the export of sediment through bedload ! +! exchange from the marsh cells when lateral wave thrust acts upon ! +! them. For high resolution (of the order of 1m or less, one can ! +! compute the lateral retreat of marsh cells and convert them to open ! +! water cells. ! +! ! +!======================================================================! +! + implicit none + + PRIVATE + PUBLIC :: marsh_sed_erosion + + CONTAINS +! +!*********************************************************************** + SUBROUTINE marsh_sed_erosion (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_vegetation + USE mod_vegarr + USE mod_sedbed + USE mod_stepping + USE marsh_wave_thrust_mod +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL marsh_sed_erosion_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & GRID(ng) % om_r, & + & GRID(ng) % on_r, & + & GRID(ng) % om_u, & + & GRID(ng) % om_v, & + & GRID(ng) % on_u, & + & GRID(ng) % on_v, & + & GRID(ng) % pm, & + & GRID(ng) % pn, & + & GRID(ng) % h, & + & nstp(ng), nnew(ng), & + & VEG(ng) % umask_marsh, & + & VEG(ng) % vmask_marsh, & + & VEG(ng) % Thrust_xi, & + & VEG(ng) % Thrust_eta, & + & VEG(ng) % Thrust_total, & + & VEG(ng) % marsh_mask, & + & VEG(ng) % marsh_flux_out, & +# ifdef MARSH_RETREAT + & VEG(ng) % marsh_retreat, & +# endif +# ifdef MARSH_STOCH + & VEG(ng) % marsh_stoch, & +# endif + & SEDBED(ng) % bed_frac, & + & SEDBED(ng) % bed, & + & SEDBED(ng) % bed_mass) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE marsh_sed_erosion +! +!*********************************************************************** + SUBROUTINE marsh_sed_erosion_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & om_r, on_r, & + & om_u, om_v, & + & on_u, on_v, & + & pm, pn, & + & h, & + & nstp, nnew, & + & umask_marsh, vmask_marsh, & + & Thrust_xi, Thrust_eta, & + & Thrust_total, & + & marsh_mask, marsh_flux_out, & +# ifdef MARSH_RETREAT + & marsh_retreat, & +# endif +# ifdef MARSH_STOCH + & marsh_stoch, & +# endif + & bed_frac, bed, bed_mass) +!*********************************************************************** +! + USE mod_param + USE mod_ncparam + USE mod_scalars + USE mod_vegetation + USE mod_vegarr + USE mod_sediment + USE marsh_wave_thrust_mod +! + USE bc_2d_mod, ONLY : bc_r2d_tile + USE bc_3d_mod, ONLY : bc_r3d_tile +! USE exchange_2d_mod +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d, & + & mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: om_r(LBi:,LBj:) + real(r8), intent(in) :: on_r(LBi:,LBj:) + real(r8), intent(in) :: om_u(LBi:,LBj:) + real(r8), intent(in) :: om_v(LBi:,LBj:) + real(r8), intent(in) :: on_u(LBi:,LBj:) + real(r8), intent(in) :: on_v(LBi:,LBj:) + real(r8), intent(in) :: pm(LBi:,LBj:) + real(r8), intent(in) :: pn(LBi:,LBj:) + real(r8), intent(in) :: h(LBi:,LBj:) +! + real(r8), intent(in) :: umask_marsh(LBi:,LBj:) + real(r8), intent(in) :: vmask_marsh(LBi:,LBj:) + real(r8), intent(in) :: Thrust_xi(LBi:,LBj:) + real(r8), intent(in) :: Thrust_eta(LBi:,LBj:) + real(r8), intent(in) :: Thrust_total(LBi:,LBj:) + real(r8), intent(inout) :: marsh_mask(LBi:,LBj:) + real(r8), intent(inout) :: marsh_flux_out(LBi:,LBj:,:) +# ifdef MARSH_RETREAT + real(r8), intent(inout) :: marsh_retreat(LBi:,LBj:) +# endif +# ifdef MARSH_STOCH + real(r8), intent(in) :: marsh_stoch(LBi:,LBj:) +# endif +! + real(r8), intent(inout) :: bed(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) +! +# else + real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: h(LBi:UBi,LBj:UBj) +! + real(r8), intent(in) :: umask_marsh(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask_marsh(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Thrust_xi(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Thrust_eta(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Thrust_total(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: marsh_mask(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: marsh_flux_out(LBi:UBi,LBj:UBj,NST) +# ifdef MARSH_RETREAT + real(r8), intent(inout) :: marsh_retreat(LBi:UBi,LBj:UBj) +# endif +# ifdef MARSH_STOCH + real(r8), intent(in) :: marsh_stoch(LBi:UBi,LBj:UBj) +# endif +! + real(r8), intent(inout) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) + real(r8), intent(inout) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) +! +# endif +! +! Local variable declarations. +! + integer :: i, j, k, ised + real(r8), parameter :: half=0.5_r8, one=1.0_r8 + real(r8), parameter :: eps = 1.0E-14_r8 ! + real(r8), parameter :: kN_N=1000.0_r8 ! convert Thrust from kN to N + real(r8) :: cff, cff1, cff2, cff3, cff4, cff5, cff_retreat + real(r8) :: bed_thick_old, bathy +# if defined MARSH_RETREAT + real(r8) :: cff3_ceil +# endif +! +# include "set_bounds.h" +! +# if defined MARSH_RETREAT + cff3_ceil=0.0_r8 +# endif +! + cff1=kN_N*kfac_marsh(ng)*dt(ng) +! + J_LOOP: DO j=Jstr,Jend + DO i=Istr,Iend + SED_LOOP: DO ised=1,NST +! +! Convert bed mass from kg/sq.m to kg in each cell +! + cff=bed_mass(i,j,1,nnew,ised)*om_r(i,j)*on_r(i,j) +! +!# ifdef MARSH_STOCH +! cff1=kN_N*kfac_marsh(ng)*marsh_stoch(i,j)*dt(ng) +!# else +!# endif +! +!--------------------------------------------------------------------- +! Add bed mass to sea cell providing horizontal face thrust +! you cannot add more than the available amount from adjacent cell +! how to take into account the fraction of bed mass coming into the cell +! Rules-cff4 is mass and can never be negative +!--------------------------------------------------------------------- +! + cff2=half*(one-SIGN(one,Thrust_xi(i,j ))) + cff3=half*(one+SIGN(one,Thrust_xi(i+1,j))) + cff4=cff1* & + & ( Thrust_xi(i+1,j )*bed_frac(i+1,j,1,ised)* & + & on_u(i+1,j )*cff3 & + & -Thrust_xi(i,j)*bed_frac(i-1,j,1,ised)* & + & on_u(i,j)*cff2 ) + cff=cff+cff4 +! +!--------------------------------------------------------------------- +! Subtract bed mass from marsh cell if thrust acts on horizontal face +! Marsh cell +!--------------------------------------------------------------------- +! + cff2=half*(one+SIGN(one,Thrust_xi(i,j ))) + cff3=half*(one-SIGN(one,Thrust_xi(i+1,j))) + cff4=cff1*bed_frac(i,j,1,ised)* & + & ( Thrust_xi(i,j )*on_u(i,j )*cff2 & + & -Thrust_xi(i+1,j)*on_u(i+1,j)*cff3 ) + cff=cff-cff4 +! +!--------------------------------------------------------------------- +! Ensure that cff is not negative +!--------------------------------------------------------------------- +! + cff=MAX(cff,0.0_r8) +! +!--------------------------------------------------------------------- +! Sediment flux for each sediment class out of marsh cells +!--------------------------------------------------------------------- +! + marsh_flux_out(i,j,ised)=cff4+marsh_flux_out(i,j,ised) +! +!--------------------------------------------------------------------- +! Add bed mass to sea cell if it provides vertical face thrust +!--------------------------------------------------------------------- +! + cff2=half*(one-SIGN(one,Thrust_eta(i,j ))) + cff3=half*(one+SIGN(one,Thrust_eta(i,j+1))) + cff4=cff1* & + & ( Thrust_eta(i,j+1)*bed_frac(i,j+1,1,ised)* & + & om_v(i,j+1)*cff3 & + & -Thrust_eta(i,j )*bed_frac(i,j-1,1,ised)* & + & om_v(i,j )*cff2 ) + cff=cff+cff4 +! +!--------------------------------------------------------------------- +! Subtract bed mass from marsh cell if thrust acts on vertical face +! Only can subtract from a cell if the sediment class exists +!--------------------------------------------------------------------- +! + cff2=half*(one+SIGN(one,Thrust_eta(i,j ))) + cff3=half*(one-SIGN(one,Thrust_eta(i,j+1))) + cff4=cff1*bed_frac(i,j,1,ised)* & + & ( Thrust_eta(i,j )*om_v(i,j )*cff2 & + & -Thrust_eta(i,j+1)*om_v(i,j+1)*cff3 ) + cff=cff-cff4 +! +!--------------------------------------------------------------------- +! Ensure that cff is not negative +!--------------------------------------------------------------------- +! + cff=MAX(cff,0.0_r8) +! +!--------------------------------------------------------------------- +! Sediment flux for each sediment class out of marsh cells +!--------------------------------------------------------------------- +! + marsh_flux_out(i,j,ised)=cff4+marsh_flux_out(i,j,ised) +! +!--------------------------------------------------------------------- +! Update bed mass +!--------------------------------------------------------------------- +! + bed_mass(i,j,1,nnew,ised)=cff*pm(i,j)*pn(i,j) +! + END DO SED_LOOP +! +# if defined MARSH_RETREAT +! +!--------------------------------------------------------------------- +! recalculate thickness and fractions for all layers. +!--------------------------------------------------------------------- +! + cff3_ceil=MAX(CEILING(Thrust_total(i,j)),0) +! + bed_thick_old=bed(i,j,1,ithck) + cff3=0.0_r8 + DO ised=1,NST + cff3=cff3+bed_mass(i,j,1,nnew,ised) + END DO + IF (cff3.eq.0.0_r8) THEN + cff3=eps + END IF + bed(i,j,1,ithck)=0.0_r8 + DO ised=1,NST + bed_frac(i,j,1,ised)=bed_mass(i,j,1,nnew,ised)/cff3 + bed(i,j,1,ithck)=MAX(bed(i,j,1,ithck)+ & + & bed_mass(i,j,1,nnew,ised)/ & + & (Srho(ised,ng)* & + & (1.0_r8-bed(i,j,1,iporo))),0.0_r8) + END DO +! +! Determine the cell that is under marsh wave attack +! + cff1=(ABS(bed(i,j,1,ithck)-bed_thick_old))*cff3_ceil + marsh_retreat(i,j)=marsh_retreat(i,j)+cff1 + IF(marsh_retreat(i,j).gt.SCARP_HGHT(ng))THEN + marsh_mask(i,j)=0.0_r8 + END IF +# endif +! + END DO + END DO J_LOOP +! +!--------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions for output +! purposes only. +!--------------------------------------------------------------------- +! + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_mask) + DO ised=1,NST + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_flux_out(:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_frac(:,:,:,ised)) + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + END DO + DO i=1,MBEDP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed(:,:,:,i)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange2d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & marsh_mask) +! + CALL mp_exchange3d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & marsh_flux_out) +! + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed_frac, & + & bed_mass(:,:,:,nnew,:)) +! + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, MBEDP, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed) +# endif +! +# if defined MARSH_RETREAT +! +!--------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions for output +! purposes only. +!--------------------------------------------------------------------- +! + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_retreat) +# ifdef DISTRIBUTE + CALL mp_exchange2d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & marsh_retreat) +# endif +# endif +! + END SUBROUTINE marsh_sed_erosion_tile +#endif + END MODULE marsh_sed_erosion_mod + diff --git a/ROMS/Nonlinear/Vegetation/marsh_tidal_range_calc.F b/ROMS/Nonlinear/Vegetation/marsh_tidal_range_calc.F new file mode 100644 index 00000000..f42dede3 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/marsh_tidal_range_calc.F @@ -0,0 +1,230 @@ +#include "cppdefs.h" + + MODULE marsh_tidal_range_calc_mod + +#if defined MARSH_TIDAL_RANGE_CALC +! +!git $Id$ +!======================================================================! +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.txt Alexander F. Shchepetkin ! +!==============================================Tarandeep S. Kalra======! +!=============================================Alfredo Aretxabaleta ====! +!================================================Neil K. Ganju =======! +!================================================John C. Warner========! +! ! +! Compute the tidal range and mean high water that are later used ! +! for biomass production and vertical growth of marsh. ! +!======================================================================! +! ! + + implicit none + + PRIVATE + PUBLIC :: marsh_tidal_range_calc + + CONTAINS +! +!*********************************************************************** + SUBROUTINE marsh_tidal_range_calc (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_stepping + USE mod_vegarr +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! + CALL marsh_tidal_range_calc_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), & + & OCEAN(ng) % zeta, & + & VEG(ng) % zeta_max1, & + & VEG(ng) % zeta_min1, & + & VEG(ng) % zeta_max_rec, & + & VEG(ng) % zeta_min_rec, & + & VEG(ng) % counter_loc_rl, & + & VEG(ng) % marsh_mask, & + & VEG(ng) % marsh_high_water, & + & VEG(ng) % marsh_tidal_range) + + RETURN + END SUBROUTINE marsh_tidal_range_calc +! +!*********************************************************************** +! + SUBROUTINE marsh_tidal_range_calc_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, & + & zeta, & + & zeta_max1, & + & zeta_min1, & + & zeta_max_rec, zeta_min_rec, & + & counter_loc_rl, & + & marsh_mask, & + & marsh_high_water, & + & marsh_tidal_range) +! +!*********************************************************************** +! + USE mod_param + USE mod_grid + USE mod_forces + USE mod_ocean + USE mod_scalars + USE mod_vegetation + USE bc_2d_mod, ONLY : bc_r2d_tile + USE bc_3d_mod, ONLY : bc_r3d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp +! + real(r8), intent(inout):: counter_loc_rl +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: zeta(LBi:,LBj:,:) + real(r8), intent(inout):: zeta_max1(LBi:,LBj:) + real(r8), intent(inout):: zeta_min1(LBi:,LBj:) + real(r8), intent(inout):: zeta_max_rec(LBi:,LBj:,:) + real(r8), intent(inout):: zeta_min_rec(LBi:,LBj:,:) + real(r8), intent(inout):: marsh_mask(LBi:,LBj:) + real(r8), intent(inout):: marsh_high_water(LBi:,LBj:) + real(r8), intent(inout):: marsh_tidal_range(LBi:,LBj:) +# else + real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,3) + real(r8), intent(inout):: zeta_max1(LBi:UBi,LBj:UBj) + real(r8), intent(inout):: zeta_min1(LBi:UBi,LBj:UBj) + real(r8), intent(inout):: & + & zeta_max_rec(LBi:UBi,LBj:UBj,NTIMES_MARSH) + real(r8), intent(inout):: & + & zeta_min_rec(LBi:UBi,LBj:UBj,NTIMES_MARSH) + real(r8), intent(inout):: marsh_mask(LBi:UBj,LBj:UBj) + real(r8), intent(inout):: marsh_high_water(LBi:UBj,LBj:UBj) + real(r8), intent(inout):: marsh_tidal_range(LBi:UBj,LBj:UBj) +# endif +! +! Local variable declarations. +! + integer :: i, j, it, iic_loc + integer :: counter_new_time, counter_loc + integer :: freq + real(r8) :: ntimes_marsh_rl + real(r8) :: zeta_loc, zeta_max2, zeta_min, tdays_marsh + real(r8) :: tot_zeta_max, tot_zeta_min + real(r8) :: mean_zeta_max, mean_zeta_min + real(r8) :: time_loc + real(r8) :: modm_freq, day2sec_loc, day_inp_loc, tdays_loc +! +# include "set_bounds.h" +! +!---------------------------------------------------------------------- +! Executing the code +!---------------------------------------------------------------------- +! + day2sec_loc=86400.0_r8 ! 86400.0_r8 + day_inp_loc=1.0_r8 ! record zeta max, min per day +! + time_loc=dt(ng)*iic(ng) ! ocean time + tdays_loc=MAX((FLOOR(time_loc/(day_inp_loc*day2sec_loc))),1)! time in days + freq=CEILING(day_inp_loc*day2sec_loc/dt(ng)) ! time step freq. to record zeta max,min + + modm_freq=MOD(iic(ng),freq) +! + DO j=Jstr,Jend + DO i=Istr,Iend + + zeta_loc=zeta(i,j,3) ! store zeta locally first +! + ntimes_marsh_rl=REAL(NTIMES_MARSH) + zeta_max1(i,j)=MAX(zeta_max1(i,j),zeta_loc) + zeta_min1(i,j)=MIN(zeta_min1(i,j),zeta_loc) +! +! Retain the value of counter_loc_rl in the next time step. +! + IF(modm_freq==0.and.counter_loc_rl<=ntimes_marsh_rl) THEN + counter_loc_rl=MOD(tdays_loc,ntimes_marsh_rl) + IF(counter_loc_rl.eq.0.0) THEN + counter_loc_rl=ntimes_marsh_rl + END IF +! +! this has correct value of counter. +! + zeta_max_rec(i,j,INT(counter_loc_rl))=(zeta_max1(i,j)) + zeta_min_rec(i,j,INT(counter_loc_rl))=(zeta_min1(i,j)) +! +! Once get zeta_max_rec for a day, then reinitialize zeta_max1 +! for the next cycle of saving values. +! + zeta_max1(i,j)=-10.0_r8 + zeta_min1(i,j)= 10.0_r8 + END IF + +! +! Find the mean for the tidal range. +! + tot_zeta_max=0.0_r8 + tot_zeta_min=0.0_r8 + DO it=1,NTIMES_MARSH + tot_zeta_max=zeta_max_rec(i,j,it)+tot_zeta_max + tot_zeta_min=zeta_min_rec(i,j,it)+tot_zeta_min + END DO + mean_zeta_max=tot_zeta_max/NTIMES_MARSH + mean_zeta_min=tot_zeta_min/NTIMES_MARSH +! + marsh_high_water(i,j)=mean_zeta_max + marsh_tidal_range(i,j)=mean_zeta_max-mean_zeta_min + marsh_tidal_range(i,j)=marsh_tidal_range(i,j) +! + END DO + END DO +! + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_tidal_range(:,:)) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_high_water(:,:)) + + DO it=1,NTIMES_MARSH + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & zeta_max_rec(:,:,it)) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & zeta_min_rec(:,:,it)) + END DO +# ifdef DISTRIBUTE + CALL mp_exchange2d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & marsh_tidal_range, marsh_high_water) +! + CALL mp_exchange3d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, NTIMES_MARSH, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & zeta_max_rec, zeta_min_rec) +# endif + END SUBROUTINE marsh_tidal_range_calc_tile +#endif +! + END MODULE marsh_tidal_range_calc_mod diff --git a/ROMS/Nonlinear/Vegetation/marsh_vert_growth.F b/ROMS/Nonlinear/Vegetation/marsh_vert_growth.F new file mode 100644 index 00000000..595c085f --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/marsh_vert_growth.F @@ -0,0 +1,406 @@ +#include "cppdefs.h" + + MODULE marsh_vert_growth_mod + +#if defined MARSH_VERT_GROWTH +! +!git $Id$ +!======================================================================! +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.txt Alexander F. Shchepetkin ! +!==============================================Tarandeep S. Kalra======! +!==============================================Joel Carr===============! +!================================================Neil K. Ganju =======! +!==============================================Alfredo Aretxabaleta====! +!==============================================John C. Warner==========! +! ! +! Calculate vertical growth of marsh through biomass production. ! +! Biomass production can lead to mudflats being converted to marsh ! +! cells and evolve marsh stem/canopy properties ! +! ! +! References: ! +! ! +!======================================================================! +! For marsh vertical growth and parabolic profile: ! +!======================================================================! +! Morris, J. T., P. V. Sundareshwar, C. T. Nietch, B. Kjerfve, and ! +! D. R. Cahoon.: Responses of coastal wetlands to rising sea level, ! +! Ecology, 83(10), 2869–2877, 2002. ! +! ! +!======================================================================! +! For marsh vegetation parameters: ! +!======================================================================! +! D'Alpaos, A., Lanzoni, S., Marani, M., Rinaldo, A.: Landscape ! +! evolution in tidal embayments: Modeling the interplay of erosion, ! +! sedimentation, and vegetation dynamics, Journal of Geophysical ! +! Research,112, F01008, 2007. ! +!======================================================================! +! ! + implicit none + + PRIVATE + PUBLIC :: marsh_vert_growth + + CONTAINS +! +!*********************************************************************** + SUBROUTINE marsh_vert_growth (ng,tile) +!*********************************************************************** + USE mod_param + USE mod_grid + USE mod_ocean + USE mod_vegarr + USE mod_sedbed + USE mod_stepping + + integer, intent(in) :: ng, tile + +! Local variable declarations. +! +# include "tile.h" +! + CALL marsh_vert_growth_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & GRID(ng) % h, & + & OCEAN(ng) % zeta, & + & nnew(ng), & + & SEDBED(ng) % bed, & + & SEDBED(ng) % bed_mass, & + & VEG(ng) % marsh_mask, & +!# if defined MARSH_TIDAL_RANGE_CALC + & VEG(ng) % marsh_high_water, & +!# if defined MARSH_MCKEE_FORMULATION + & VEG(ng) % marsh_low_water, & +!# endif +! & VEG(ng) % marsh_tidal_range, & +!# endif +# if defined MARSH_BIOMASS_VEG + & VEG(ng) % plant, & +# endif + & VEG(ng) % marsh_biomass_peak, & + & VEG(ng) % marsh_vert_rate, & + & VEG(ng) % marsh_accret) + + END SUBROUTINE marsh_vert_growth + +!*********************************************************************** + SUBROUTINE marsh_vert_growth_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & h, & + & zeta, & + & nnew, & + & bed, & + & bed_mass, & + & marsh_mask, & +!# if defined MARSH_TIDAL_RANGE_CALC + & marsh_high_water, & +!# if defined MARSH_MCKEE_FORMULATION + & marsh_low_water, & +!# endif +! & marsh_tidal_range, & +!# endif +# if defined MARSH_BIOMASS_VEG + & plant, & +# endif + & marsh_biomass_peak, & + & marsh_vert_rate, & + & marsh_accret) +!*********************************************************************** +! + USE mod_grid + USE mod_forces + USE mod_param + USE mod_scalars + USE mod_vegetation + USE mod_vegarr + USE mod_sediment + USE bc_2d_mod, ONLY : bc_r2d_tile + USE bc_3d_mod, ONLY : bc_r3d_tile +! USE exchange_2d_mod +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d, & + & mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nnew +! +# ifdef ASSUMED_SHAPE + real(r8), intent(inout) :: marsh_mask(LBi:,LBj:) + real(r8), intent(inout) :: h(LBi:,LBj:) + real(r8), intent(in) :: zeta(LBi:,LBj:,:) + real(r8), intent(in) :: bed(LBi:,LBj:,:,:) + real(r8), intent(inout) :: bed_mass(LBi:,LBj:,:,:,:) + real(r8), intent(in) :: marsh_high_water(LBi:,LBj:) +!# if defined MARSH_MCKEE_FORMULATION + real(r8), intent(in) :: marsh_low_water(LBi:,LBj:) +!# endif +! real(r8), intent(in) :: marsh_tidal_range(LBi:,LBj:) +# if defined MARSH_BIOMASS_VEG + real(r8), intent(inout) :: plant(LBi:,LBj:,:,:) +# endif + real(r8), intent(inout) :: marsh_biomass_peak(LBi:,LBj:) + real(r8), intent(inout) :: marsh_vert_rate(LBi:,LBj:) + real(r8), intent(inout) :: marsh_accret(LBi:,LBj:) +# else + real(r8), intent(inout) :: marsh_mask(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: h(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,3) + real(r8), intent(in) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP) + real(r8), intent(inout) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,1:2,NST) + real(r8), intent(in) :: marsh_high_water(LBi:UBi,LBj:UBj) +!# if defined MARSH_MCKEE_FORMULATION + real(r8), intent(in) :: marsh_low_water(LBi:UBi,LBj:UBj) +!# endif +! real(r8), intent(in) :: marsh_tidal_range(LBi:UBi,LBj:UBj) +# if defined MARSH_BIOMASS_VEG + real(r8), intent(inout) :: plant(LBi:UBi,LBj:UBj,NVEG,NVEGP) +# endif + real(r8), intent(inout) :: marsh_biomass_peak(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: marsh_vert_rate(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: marsh_accret(LBi:UBi,LBj:UBj) +# endif +! +! Local variable declarations. +! + integer :: i, j, k, ised + real(r8) :: Dmin, Dmax, depth + real(r8) :: Samp, Bpeak, Rref, AMC + real(r8) :: ramp, cff, mtr + real(r8) :: marsh_bulk_density + real(r8) :: marsh_vert_rate_insec + real(r8) :: slope_in_meter, marsh_organic_matter +! real(r8), parameter :: lower_lev=1.0e-9 ! 800-1000 kg/m3 + real(r8), parameter :: & + & one_over_year2sec=1.0_r8/(365.0_r8*86400.0_r8) +! +# if defined MARSH_BIOMASS_VEG + integer :: ivpr, iveg +# endif +! +# include "set_bounds.h" +! +# if defined WET_DRY && defined MARSH_COLONIZE + DO j=Jstr,Jend + DO i=Istr,Iend +! marsh_mask(i,j)=marsh_mask(i,j)*rmask_wet(i,j) + IF(rmask_wet(i,j)==0.0_r8) THEN + marsh_mask(i,j)=1.0_r8 + ENDIF + END DO + END DO +# endif +! +! ramp could be used to introduce vegetation in the flow. +! Ntimes marsh only activated with marsh tidalrange calc +! ramp=MIN( DBLE(FLOOR(tdays(ng)/NTIMES_MARSH)), 1.0_r8 ) +! + J_LOOP: DO j=Jstr,Jend + DO i=Istr,Iend +! + IF(tdays(ng).lt.tdays_marsh_growth(ng)) THEN +# if defined MARSH_KIRWAN_FORMULATION +! Kirwan formulation. +# if defined MARSH_TIDAL_RANGE_INTERNAL +! Depend on internal calculation. + Dmin=marsh_high_water(i,j) +! Assume MTR=2*MHW + mtr=2.0_r8*Dmin +# else +! Depend on user input. + mtr=marsh_high_water(i,j)-marsh_low_water(i,j) +# endif + Dmax=Par_fac1(ng)*mtr+Par_fac2(ng)+Dmin +# endif +! +# if defined MARSH_MCKEE_FORMULATION +! Mckee formulation. +# if defined MARSH_TIDAL_RANGE_INTERNAL +! Depend on internal calculation. + Samp=(marsh_high_water(i,j)) +# else +! Depend on user input. + Samp=0.5*(marsh_high_water(i,j)-marsh_low_water(i,j)) +# endif + Dmin= 0.429_r8*Samp*2.0_r8+0.253_r8 + Dmax=-0.237_r8*Samp*2.0_r8+0.092_r8 +# endif +! Dmin is higher positive number than Dmax and a higher elevation +! means more towards Dmin and less towards Dmax +! + Depth=-h(i,j) +! +! scales parabola from 0 to 1 in next line. +! + cff=0.25_r8*(Dmin-Dmax)*(Dmax-Dmin) +! +! peak biomass as a function of depth. +! + Bpeak=BMax(ng)*(Depth-Dmax)*(Depth-Dmin)/cff +! +! Not allow negative Bpeak. +! + Bpeak=MAX(Bpeak,0.0_r8)*marsh_mask(i,j) +! +! Integrated per year amount of below ground biomass. +! kg/(sq.m-year) +! + AMC=180.0_r8*Bpeak*nuGp(ng) + ELSE +! +! 180 growing days, after 180 days make AMC=0, Bpeak=0.0. +! + Bpeak=0.0_r8 + AMC=0.0_r8 + ENDIF +! +! Masking the amount of marsh biomass and saving in 2D array for I/O. +! (kg/(sq.m-year) +! + marsh_biomass_peak(i,j)=Bpeak +! +! what material remains after accounting for recalcitrant Carbon. +! kg/(sq.m-year) +! + Rref=AMC*chiref(ng) +! +! marsh_vert_rate is kg/(sq.m-year)/(kg/m^3) = m/year +! (0.9 is the porosity! ) +! + marsh_bulk_density =Srho(1,ng)*(1.0_r8-bed(i,j,1,iporo)) + marsh_vert_rate(i,j) =(Rref/marsh_bulk_density) +! +! convert m/year to m/s +! + marsh_vert_rate_insec =marsh_vert_rate(i,j)*one_over_year2sec +! +! convert the rate to m of accretion +! + slope_in_meter =marsh_vert_rate_insec*dt(ng) + marsh_accret(i,j) =marsh_accret(i,j)+slope_in_meter +! +! Assuming that organic sed in class 1, add bed mass. +! marsh_bulk_density = kg/(m^3) (1-poro)*srho. +! + marsh_organic_matter =slope_in_meter*marsh_bulk_density + bed_mass(i,j,1,nnew,1)=bed_mass(i,j,1,nnew,1)+ & + & marsh_organic_matter +! +# if defined MARSH_COLONIZE +! +! De-Colonize if marsh biomass production goes to zero +! +! marsh_mask(i,j)=MIN(1.0_r8,MAX(Bpeak,0.0_r8)) + IF(Bpeak.gt.0.0_r8) THEN + marsh_mask(i,j)=1.0_r8 + ELSE + marsh_mask(i,j)=0.0_r8 + END IF +# endif +# if defined MARSH_BIOMASS_VEG +! IF(tdays(ng).gt.tdays_marsh_growth) THEN +! +! Colonize if marsh biomass production (Bpeak)>0.0 +! +! marsh_mask(i,j)=MIN(1.0_r8,MAX(Bpeak,0.0_r8)) +! + DO iveg=1,NVEG +! +! Inside veg loop to change veg properties based on Bpeak +! + cff=( (Bpeak*1000.0_r8)**beta_pdens(ng) )*marsh_mask(i,j) + plant(i,j,iveg,pdens)=alpha_pdens(ng)*cff +! + cff=( (Bpeak*1000.0_r8)**beta_phght(ng) )*marsh_mask(i,j) + plant(i,j,iveg,phght)=alpha_phght(ng)*cff +! + cff=( (Bpeak*1000.0_r8)**beta_pdiam(ng) )*marsh_mask(i,j) + plant(i,j,iveg,pdiam)=alpha_pdiam(ng)*cff +! + END DO +! END IF +# endif + END DO + END DO J_LOOP +! +!--------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions for output +! purposes only. +!--------------------------------------------------------------------- +! +! Exchange boundary data +! + DO ised=1,NST + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, Nbed, & + & bed_mass(:,:,:,nnew,ised)) + END DO +! + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_biomass_peak) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_vert_rate) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_accret) +! +# if defined MARSH_BIOMASS_VEG + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & marsh_mask) +! + DO ivpr=1,NVEGP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, NVEG, & + & plant(:,:,:,ivpr)) + END DO +# endif +! +# ifdef DISTRIBUTE +! + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, Nbed, 1, NST, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & bed_mass(:,:,:,nnew,:)) +! + CALL mp_exchange2d (ng, tile, iNLM, 3, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & marsh_biomass_peak, & + & marsh_vert_rate, & + & marsh_accret) +! +# if defined MARSH_BIOMASS_VEG + CALL mp_exchange2d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & marsh_mask) +! + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, NVEG, 1, NVEGP, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & plant(:,:,:,:)) +# endif +# endif +! + + END SUBROUTINE marsh_vert_growth_tile +! +!*********************************************************************** +#endif + + END MODULE marsh_vert_growth_mod + diff --git a/ROMS/Nonlinear/Vegetation/marsh_wave_thrust.F b/ROMS/Nonlinear/Vegetation/marsh_wave_thrust.F new file mode 100644 index 00000000..073572bb --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/marsh_wave_thrust.F @@ -0,0 +1,450 @@ +#include "cppdefs.h" + + MODULE marsh_wave_thrust_mod +#if defined MARSH_DYNAMICS && defined MARSH_WAVE_THRUST +! +!git $Id$ +!======================================================================! +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.txt Alexander F. Shchepetkin ! +!==============================================Tarandeep S. Kalra======! +!================================================Neil K. Ganju =======! +!================================================John C. Warner========! +!==============================================Julia M. Moriarty=======! +! ! +! This routine computes the wave thrust on marsh edge from wave ! +! climate from the adjacent water cells. ! +! Thrust is modified based on water level of the adjacent water cell ! +! providing wave climate and bathymetry of marsh cell. ! +! ! +! References: ! +! ! +!======================================================================! +! Dean, R.G. and Dalrymple, R.A., 1991: Water Wave Mechanics for ! +! Engineers and Scientists, World Scientific Publications. ! +! ! +! Tonelli, M., Fagherazzi, Sergio., and Petti., M., 2010: ! +! Modeling wave impact on salt marsh boundaries, Journal of ! +! Geophysical Research, 115, 0148-0227. ! +!======================================================================! +! ! + implicit none + + PRIVATE + PUBLIC :: marsh_wave_thrust + + CONTAINS +! +!*********************************************************************** + SUBROUTINE marsh_wave_thrust (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_stepping + USE mod_vegarr +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! + CALL marsh_wave_thrust_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), & + & GRID(ng) % h, & + & GRID(ng) % angler, & +# ifdef MASKING + & GRID(ng) % rmask, & + & GRID(ng) % umask, & + & GRID(ng) % vmask, & +# endif +# ifdef WET_DRY + & GRID(ng) % rmask_wet, & +# endif +# if defined WAVES_HEIGHT + & FORCES(ng) % Hwave, & +# endif +# if defined WAVES_LENGTH + & FORCES(ng) % Lwave, & +# endif +# if defined WAVES_DIR + & FORCES(ng) % Dwave, & +# endif + & VEG(ng) % marsh_mask, & + & VEG(ng) % umask_marsh, & + & VEG(ng) % vmask_marsh, & + & VEG(ng) % Thrust_xi, & + & VEG(ng) % Thrust_eta, & + & VEG(ng) % Thrust_total, & + & OCEAN(ng) % zeta) + + RETURN + END SUBROUTINE marsh_wave_thrust +! +!*********************************************************************** +! + SUBROUTINE marsh_wave_thrust_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, & + & h,angler, & +# ifdef MASKING + & rmask, umask, vmask, & +# endif +# ifdef WET_DRY + & rmask_wet, & +# endif +# if defined WAVES_HEIGHT + & Hwave, & +# endif +# if defined WAVES_LENGTH + & Lwave, & +# endif +# if defined WAVES_DIR + & Dwave, & +# endif + & marsh_mask, & + & umask_marsh, & + & vmask_marsh, & + & Thrust_xi, & + & Thrust_eta, & + & Thrust_total, & + & zeta) +! +!*********************************************************************** +! + USE mod_param + USE mod_grid + USE mod_forces + USE mod_ocean + USE mod_scalars + USE mod_vegetation + USE mod_vegarr + USE bc_2d_mod + USE exchange_2d_mod +! +#ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d +#endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: h(LBi:,LBj:) + real(r8), intent(in) :: angler(LBi:,LBj:) +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:,LBj:) + real(r8), intent(in) :: umask(LBi:,LBj:) + real(r8), intent(in) :: vmask(LBi:,LBj:) +# endif +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:,LBj:) +# endif +# ifdef WAVES_HEIGHT + real(r8), intent(in) :: Hwave(LBi:,LBj:) +# endif +# ifdef WAVES_LENGTH + real(r8), intent(in) :: Lwave(LBi:,LBj:) +# endif +# ifdef WAVES_DIR + real(r8), intent(in) :: Dwave(LBi:,LBj:) +# endif + real(r8), intent(in) :: marsh_mask(LBi:,LBj:) + real(r8), intent(inout) :: umask_marsh(LBi:,LBj:) + real(r8), intent(inout) :: vmask_marsh(LBi:,LBj:) +! + real(r8), intent(inout) :: Thrust_xi(LBi:,LBj:) + real(r8), intent(inout) :: Thrust_eta(LBi:,LBj:) + real(r8), intent(inout) :: Thrust_total(LBi:,LBj:) + real(r8), intent(in) :: zeta(LBi:,LBj:,:) +# else + real(r8), intent(in) :: h(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj) +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj) +# endif +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj) +# endif +# ifdef WAVES_HEIGHT + real(r8), intent(in) :: Hwave(LBi:UBi,LBj:UBj) +# endif +# ifdef WAVES_HEIGHT + real(r8), intent(in) :: Lwave(LBi:UBi,LBj:UBj) +# endif +# ifdef WAVES_DIR + real(r8), intent(in) :: Dwave(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(in) :: marsh_mask(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: umask_marsh(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: vmask_marsh(LBi:UBi,LBj:UBj) + + real(r8), intent(inout) :: Thrust_xi(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: Thrust_eta(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: Thrust_total(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,3) +# endif +! +! Local variable declarations. +! + integer :: i,j + + real(r8), parameter :: Inival=0.0_r8 + real(r8), parameter :: half=0.5_r8 + real(r8), parameter :: N_kN=0.001_r8 + real(r8), parameter :: eps=1.0e-12_r8 +! real(r8), parameter :: depth_const=0.6_r8 + + real(r8) :: Kw, Integral_Kp + real(r8) :: depth_all + + real(r8) :: cff, cff1, cff2, cff3, cff4, cff5, cff6, cff7, cff8 + + real(r8) :: F_asl, F_bsl, F_msl + + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FX + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FY + +# include "set_bounds.h" +! +!---------------------------------------------------------------------- +! Executing the code +!---------------------------------------------------------------------- +! +!---------------------------------------------------------------------- +! Marsh mask at U-points and V-points. +!---------------------------------------------------------------------- +! + DO j=JstrR,JendR + DO i=Istr,IendR + umask_marsh(i,j)=marsh_mask(i-1,j)+marsh_mask(i,j) + IF (umask_marsh(i,j).eq.1.0_r8) THEN + umask_marsh(i,j)=marsh_mask(i-1,j)-marsh_mask(i,j) + ELSE + umask_marsh(i,j)=0.0_r8 + END IF + END DO + END DO +! +! + DO j=Jstr,JendR + DO i=IstrR,IendR + vmask_marsh(i,j)=marsh_mask(i,j-1)+marsh_mask(i,j) + IF (vmask_marsh(i,j).eq.1.0_r8) THEN + vmask_marsh(i,j)=marsh_mask(i,j-1)-marsh_mask(i,j) + ELSE + vmask_marsh(i,j)=0.0_r8 + END IF + END DO + END DO +! +! Exchange boundary data +! + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + CALL exchange_u2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & umask_marsh(:,:)) + CALL exchange_v2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & vmask_marsh(:,:)) + END IF +! +# ifdef DISTRIBUTE +! + CALL mp_exchange2d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & umask_marsh, vmask_marsh) +# endif +! +!---------------------------------------------------------------------- +! Compute total thrust on all cell centers +! where wave data is available at RHO points. +!---------------------------------------------------------------------- +! + DO j=Jstr-1,Jend+1 + DO i=Istr-1,Iend+1 + cff=1.5_r8*pi-Dwave(i,j)-angler(i,j) +! +!---------------------------------------------------------------------- +! Calculate Thrust below and above sea level. +!---------------------------------------------------------------------- +! + kw=2.0_r8*pi/Lwave(i,j) +! cff1=MAX(0.0_r8,h(i,j)+zeta(i,j,1)) +! cff1=h(i,j) +! Integral_kp=ABS(sinh(kw*cff1)/(kw*cosh(kw*cff1))) + cff1=h(i,j)+zeta(i,j,1) + Integral_kp=(sinh(kw*cff1)/(kw*cosh(kw*h(i,j)))) +! + cff2=rho0*g*Hwave(i,j)*N_kN + F_asl=half*cff2*Hwave(i,j) + F_bsl=cff2*Integral_kp +! +!--------------------------------------------------------------------- +! Total wave thrust at mean sea level. +!--------------------------------------------------------------------- +! + F_msl=F_asl+F_bsl + FX(i,j)=F_msl*cos(cff) + FY(i,j)=F_msl*sin(cff) +! + END DO + END DO +! +!--------------------------------------------------------------------- +! Get the wave thrust on cell faces +!--------------------------------------------------------------------- +! + DO j=JstrR,JendR + DO i=Istr,IendR +! + cff1=SIGN(1.0_r8,umask_marsh(i,j)) + cff2=half*(1.0_r8+cff1) + cff3=half*(1.0_r8-cff1) +! + cff4=SIGN(1.0_r8,FX(i,j)) + cff5=half*(1.0_r8-cff4) +! + cff6=SIGN(1.0_r8,FX(i-1,j)) + cff7=half*(1.0_r8+cff6) +! + Thrust_xi(i,j)=ABS(umask_marsh(i,j))* & + & (cff2*cff5*FX(i,j)+cff3*cff7*FX(i-1,j)) +! +! Account for marsh cell depth by exponentially decreasing +! thrust if marsh is fully submerged. Otherwise, constant thrust. +! + depth_all=cff2*(h(i-1,j )+zeta(i,j,1) )+ & + & cff3*(h(i,j )+zeta(i-1,j,1)) + IF(depth_all.lt.0.0_r8) THEN + cff8=1.0_r8 + ELSEIF(depth_all.ge.0.0_r8) THEN + cff8=exp(-depth_all*3.0_r8) + ENDIF +! +!--------------------------------------------------------------------- +! Modify xi cell face thrust based on water depth. +!--------------------------------------------------------------------- +! + Thrust_xi(i,j)=cff8*Thrust_xi(i,j) +! + END DO + END DO +! + DO j=Jstr,JendR + DO i=IstrR,IendR +! + cff1=SIGN(1.0_r8,vmask_marsh(i,j)) + cff2=half*(1.0_r8+cff1) + cff3=half*(1.0_r8-cff1) +! + cff4=SIGN(1.0_r8,FY(i,j)) + cff5=half*(1.0_r8-cff4) +! + cff6=SIGN(1.0_r8,FY(i,j-1)) + cff7=half*(1.0_r8+cff6) +! + Thrust_eta(i,j)=ABS(vmask_marsh(i,j))* & + & (cff3*cff7*FY(i,j-1)+cff2*cff5*FY(i,j)) +! +! Account for marsh cell depth by exponentially decreasing +! thrust if marsh is fully submerged. Otherwise, constant thrust. +! + depth_all=cff2*(h(i,j-1)+zeta(i,j,1 ))+ & + & cff3*(h(i,j )+zeta(i,j-1,1)) +! + IF(depth_all.lt.0.0_r8) THEN + cff8=1.0_r8 + ELSEIF(depth_all.ge.0.0_r8) THEN + cff8=exp(-depth_all*3.0_r8) + ENDIF +! +!--------------------------------------------------------------------- +! Modify eta cell face thrust based on water depth. +!--------------------------------------------------------------------- +! + Thrust_eta(i,j)=cff8*Thrust_eta(i,j) + END DO + END DO +! +! +! Exchange boundary data +! + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + CALL exchange_u2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & Thrust_xi(:,:)) + CALL exchange_v2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & Thrust_eta(:,:)) + END IF +! +# ifdef DISTRIBUTE +! + CALL mp_exchange2d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & Thrust_xi, Thrust_eta) +# endif + +! +!--------------------------------------------------------------------- +! Sum the thrust from all cell faces to get thrust at cell center +!--------------------------------------------------------------------- +! + DO j=Jstr,Jend + DO i=Istr,Iend + cff=ABS(Thrust_xi(i,j ))+ABS(Thrust_xi(i+1,j ))+ & + & ABS(Thrust_eta(i,j))+ABS(Thrust_eta(i,j+1)) + Thrust_total(i,j)=cff*marsh_mask(i,j) + END DO + END DO +! +!--------------------------------------------------------------------- +! Apply periodic or gradient boundary conditions for output +! purposes only. +!--------------------------------------------------------------------- +! + CALL bc_u2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & Thrust_xi) + CALL bc_v2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & Thrust_eta) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & Thrust_total) +! +# ifdef DISTRIBUTE +! +! Exchange boundary data +! + CALL mp_exchange2d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & Thrust_total) +! +# endif +! + END SUBROUTINE marsh_wave_thrust_tile +# endif + END MODULE marsh_wave_thrust_mod diff --git a/ROMS/Nonlinear/Vegetation/vegarr_mod.h b/ROMS/Nonlinear/Vegetation/vegarr_mod.h new file mode 100644 index 00000000..01909fea --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegarr_mod.h @@ -0,0 +1,483 @@ +! +!git $Id$ +!================================================== Hernan G. Arango ==! +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!================================================== John C. Warner ====! +!==================================================== Neil K. Ganju ==! +!==================================================== Alexis Beudin ==! +!==================================================Tarandeep S. Kalra==! +! ! +! Vegetation Model Kernel Variables: ! +! plant Vegetation variable properties: ! +! plant(:,:,:,phght) => height ! +! plant(:,:,:,pdens) => density ! +! plant(:,:,:,pthck) => thickness ! +! plant(:,:,:,pdiam) => diameter ! +! ru_veg Momentum term for x direction(takes account for all ! +! vegetation types) ! +! rv_veg Momentum term for x direction(takes account for all ! +! vegetation types) ! +! ru_veg_loc Momentum term for x direction(takes account for only ! +! local vegetation type) ! +! rv_veg_loc Momentum term for x direction(takes account for all ! +! local vegetation types) ! +! step2d_uveg Momentum term for 2d x direction ! +! step2d_vveg Momentum term for 2d y direction ! +#ifdef VEG_FLEX +! bend Bending for each vegetation ! +! Lveg Effective blade length ! +# endif +# ifdef VEG_FLEX +! bend Bending for each vegetation ! +# endif +# ifdef VEG_TURB +! tke_veg Turbulent kinetic energy from vegetation ! +! gls_veg Length scale change from vegetation ! +#endif +#if defined VEG_SWAN_COUPLING && defined VEG_STREAMING +! dissip_veg Dissipation from the SWAN model due to vegetation ! +! Cdwave_veg Spectral Cd from the SWAN model due to vegetation ! +! BWDXL_veg Wave streaming effect due to vegetation ! +! BWDYL_veg Wave streaming effect due to vegetation ! +#endif +#ifdef MARSH_WAVE_THRUST +! marsh_mask Store marsh mask at cell centers of marsh cells ! +! umask_marsh Store u face marsh boundary ! +! vmask_marsh Store v face marsh boundary ! +! Thrust_xi Wave thrust on xi marsh faces ! +! Thrust_eta Wave thrust on eta marsh faces ! +! Thrust_total Total magnitude of thrust on marsh edge ! +# if defined MARSH_SED_EROSION +! marsh_flux_out Total marsh flux out from a cell ! +# endif +# if defined MARSH_RETREAT +! marsh_retreat Amount of marsh retreat ! +# endif +# if defined MARSH_TIDAL_RANGE_CALC +! zeta_max_rec Record mean high high water (MHHW) ! +! zeta_min_rec Record mean low low water (MLLW) ! +! marsh_tidal_range Mean tidal range (MHHW-MLLW) ! +# endif +# if defined MARSH_VERT_GROWTH +! marsh_high_water Read or record mean high water ! +! marsh_low_water Read mean low water ! +! marsh_biomass_peak Peak biomass on marsh ! +! marsh_vert_rate Vertical rate of marsh growth (m/yr) ! +! marsh_accret Total accretion in marsh elevation (m) ! +# endif +#endif +! ! +!======================================================================! +! + USE mod_kinds +! + implicit none + + TYPE T_VEG +! +! Nonlinear model state. +! +# if defined VEG_DRAG || defined VEG_BIOMASS + real(r8), pointer :: plant(:,:,:,:) +# endif +# ifdef VEG_DRAG +! Momentum terms go back to act as sink in rhs + real(r8), pointer :: ru_veg(:,:,:) + real(r8), pointer :: rv_veg(:,:,:) +! +! Momentum terms feed to the turbulence model + real(r8), pointer :: ru_loc_veg(:,:,:,:) + real(r8), pointer :: rv_loc_veg(:,:,:,:) + real(r8), pointer :: step2d_uveg(:,:) + real(r8), pointer :: step2d_vveg(:,:) + real(r8), pointer :: Lveg(:,:,:) +# endif +# ifdef VEG_FLEX + real(r8), pointer :: bend(:,:,:) +# endif +# ifdef VEG_TURB + real(r8), pointer :: tke_veg(:,:,:) + real(r8), pointer :: gls_veg(:,:,:) +# endif +# ifdef VEG_HMIXING + real(r8), pointer :: visc2d_r_veg(:,:) + real(r8), pointer :: visc3d_r_veg(:,:,:) +# endif +# if defined VEG_SWAN_COUPLING && defined VEG_STREAMING + real(r8), pointer :: dissip_veg(:,:) + real(r8), pointer :: Cdwave_veg(:,:) + real(r8), pointer :: BWDXL_veg(:,:,:) + real(r8), pointer :: BWDYL_veg(:,:,:) +# endif +# ifdef MARSH_DYNAMICS + real(r8), pointer :: marsh_mask(:,:) +# ifdef MARSH_WAVE_THRUST + real(r8), pointer :: umask_marsh(:,:) + real(r8), pointer :: vmask_marsh(:,:) + real(r8), pointer :: Thrust_xi(:,:) + real(r8), pointer :: Thrust_eta(:,:) + real(r8), pointer :: Thrust_total(:,:) +# endif +# if defined MARSH_SED_EROSION + real(r8), pointer :: marsh_flux_out(:,:,:) +# endif +# if defined MARSH_RETREAT + real(r8), pointer :: marsh_retreat(:,:) +# endif +# if defined MARSH_STOCH + real(r8), pointer :: marsh_stoch(:,:) +# endif +# if defined MARSH_TIDAL_RANGE_CALC + real(r8), pointer :: zeta_max1(:,:) + real(r8), pointer :: zeta_min1(:,:) + real(r8), pointer :: zeta_max_rec(:,:,:) + real(r8), pointer :: zeta_min_rec(:,:,:) + real(r8), pointer :: marsh_tidal_range(:,:) +! integer, pointer :: counter_dim(:) + real(r8) :: counter_loc_rl +# endif +# if defined MARSH_VERT_GROWTH + real(r8), pointer :: marsh_high_water(:,:) + real(r8), pointer :: marsh_low_water(:,:) + real(r8), pointer :: marsh_biomass_peak(:,:) + real(r8), pointer :: marsh_vert_rate(:,:) + real(r8), pointer :: marsh_accret(:,:) +# endif +# endif +! + END TYPE T_VEG +! + TYPE (T_VEG), allocatable :: VEG(:) +! + CONTAINS +! + SUBROUTINE allocate_vegarr (ng, LBi, UBi, LBj, UBj) +! +!======================================================================= +! ! +! This routine allocates all variables in the module for all nested ! +! grids. ! +! ! +!======================================================================= +! + USE mod_param + USE mod_ncparam + USE mod_vegetation + + implicit none +! +! Imported variable declarations. +! + integer, intent(in) :: ng, LBi, UBi, LBj, UBj + +! +!----------------------------------------------------------------------- +! Allocate structure variables. +!----------------------------------------------------------------------- +! + IF (ng.eq.1) allocate ( VEG(Ngrids) ) +! +! Nonlinear model state. +! + +# if defined VEG_DRAG || defined VEG_BIOMASS + allocate ( VEG(ng) % plant(LBi:UBi,LBj:UBj,NVEG,NVEGP) ) +# endif +# ifdef VEG_DRAG + allocate ( VEG(ng) % ru_veg(LBi:UBi,LBj:UBj,N(ng)) ) + allocate ( VEG(ng) % rv_veg(LBi:UBi,LBj:UBj,N(ng)) ) + allocate ( VEG(ng) % ru_loc_veg(LBi:UBi,LBj:UBj,N(ng),NVEG) ) + allocate ( VEG(ng) % rv_loc_veg(LBi:UBi,LBj:UBj,N(ng),NVEG) ) + allocate ( VEG(ng) % step2d_uveg(LBi:UBi,LBj:UBj) ) + allocate ( VEG(ng) % step2d_vveg(LBi:UBi,LBj:UBj) ) + allocate ( VEG(ng) % Lveg(LBi:UBi,LBj:UBj,N(ng)) ) +# ifdef VEG_FLEX + allocate ( VEG(ng) % bend(LBi:UBi,LBj:UBj,NVEG) ) +# endif +# ifdef VEG_HMIXING + allocate ( VEG(ng) % visc2d_r_veg(LBi:UBi,LBj:UBj) ) + allocate ( VEG(ng) % visc3d_r_veg(LBi:UBi,LBj:UBj,N(ng)) ) +# endif +# ifdef VEG_TURB + allocate ( VEG(ng) % tke_veg(LBi:UBi,LBj:UBj,N(ng)) ) + allocate ( VEG(ng) % gls_veg(LBi:UBi,LBj:UBj,N(ng)) ) +# endif +# endif +# if defined VEG_SWAN_COUPLING && defined VEG_STREAMING + allocate ( VEG(ng) % dissip_veg(LBi:UBi,LBj:UBj) ) + allocate ( VEG(ng) % Cdwave_veg(LBi:UBi,LBj:UBj) ) + allocate ( VEG(ng) % BWDXL_veg(LBi:UBi,LBj:UBj,N(ng)) ) + allocate ( VEG(ng) % BWDYL_veg(LBi:UBi,LBj:UBj,N(ng)) ) +# endif +# ifdef MARSH_DYNAMICS + allocate ( VEG(ng) % marsh_mask(LBi:UBi,LBj:UBj ) ) +# ifdef MARSH_WAVE_THRUST + allocate ( VEG(ng) % umask_marsh(LBi:UBi,LBj:UBj ) ) + allocate ( VEG(ng) % vmask_marsh(LBi:UBi,LBj:UBj ) ) + allocate ( VEG(ng) % Thrust_xi(LBi:UBi,LBj:UBj ) ) + allocate ( VEG(ng) % Thrust_eta(LBi:UBi,LBj:UBj ) ) + allocate ( VEG(ng) % Thrust_total(LBi:UBi,LBj:UBj ) ) +# endif +# if defined MARSH_SED_EROSION + allocate ( VEG(ng) % marsh_flux_out(LBi:UBi,LBj:UBj,NST) ) +# endif +# if defined MARSH_RETREAT + allocate ( VEG(ng) % marsh_retreat(LBi:UBi,LBj:UBj ) ) +# endif +# if defined MARSH_STOCH + allocate ( VEG(ng) % marsh_stoch(LBi:UBi,LBj:UBj ) ) +# endif +# if defined MARSH_TIDAL_RANGE_CALC + allocate ( VEG(ng) % zeta_max1(LBi:UBi,LBj:UBj ) ) + allocate ( VEG(ng) % zeta_min1(LBi:UBi,LBj:UBj ) ) + allocate ( VEG(ng) % zeta_max_rec(LBi:UBi,LBj:UBj,NTIMES_MARSH ) ) + allocate ( VEG(ng) % zeta_min_rec(LBi:UBi,LBj:UBj,NTIMES_MARSH ) ) +! allocate ( VEG(ng) % counter_dim(NTIMES_MARSH ) ) + allocate ( VEG(ng) % marsh_tidal_range(LBi:UBi,LBj:UBj)) +# endif +# if defined MARSH_VERT_GROWTH + allocate ( VEG(ng) % marsh_high_water(LBi:UBi,LBj:UBj)) + allocate ( VEG(ng) % marsh_low_water(LBi:UBi,LBj:UBj)) + allocate ( VEG(ng) % marsh_biomass_peak(LBi:UBi,LBj:UBj) ) + allocate ( VEG(ng) % marsh_vert_rate(LBi:UBi,LBj:UBj) ) + allocate ( VEG(ng) % marsh_accret(LBi:UBi,LBj:UBj) ) +# endif +# endif + +! +!----------------------------------------------------------------------- +! Allocate various input variables for vegetation module. +!----------------------------------------------------------------------- +! + + RETURN + END SUBROUTINE allocate_vegarr +! + SUBROUTINE initialize_vegarr (ng, tile, model) +! +!======================================================================= +! ! +! This routine initialize structure variables in the module using ! +! first touch distribution policy. In shared-memory configuration, ! +! this operation actually performs the propagation of the "shared ! +! arrays" across the cluster, unless another policy is specified ! +! to override the default. ! +! ! +!======================================================================= +! + USE mod_param + USE mod_ncparam + USE mod_vegetation + USE mod_scalars +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile, model +! +! Local variable declarations. +! + integer :: Imin, Imax, Jmin, Jmax + integer :: i, j, k, t, iveg, ivpr +! + real(r8), parameter :: IniVal = 0.0_r8 +! +#include "set_bounds.h" +! +! Set array initialization range. +! +#ifdef _OPENMP + IF (DOMAIN(ng)%Western_Edge(tile)) THEN + Imin=BOUNDS(ng)%LBi(tile) + ELSE + Imin=Istr + END IF + IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN + Imax=BOUNDS(ng)%UBi(tile) + ELSE + Imax=Iend + END IF + IF (DOMAIN(ng)%Southern_Edge(tile)) THEN + Jmin=BOUNDS(ng)%LBj(tile) + ELSE + Jmin=Jstr + END IF + IF (DOMAIN(ng)%Northern_Edge(tile)) THEN + Jmax=BOUNDS(ng)%UBj(tile) + ELSE + Jmax=Jend + END IF +#else + Imin=BOUNDS(ng)%LBi(tile) + Imax=BOUNDS(ng)%UBi(tile) + Jmin=BOUNDS(ng)%LBj(tile) + Jmax=BOUNDS(ng)%UBj(tile) +#endif +! +!----------------------------------------------------------------------- +! Initialize vegetation structure variables. +!----------------------------------------------------------------------- +! +! + IF ((model.eq.0).or.(model.eq.iNLM)) THEN +# if defined VEG_DRAG || defined VEG_BIOMASS + DO ivpr=1,NVEGP + DO iveg=1,NVEG + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % plant(i,j,iveg,ivpr) = IniVal + END DO + END DO + END DO + END DO +# endif +! +# ifdef VEG_DRAG + DO k=1,N(ng) + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % ru_veg(i,j,k) = IniVal + VEG(ng) % rv_veg(i,j,k) = IniVal + END DO + END DO + END DO + DO k=1,N(ng) + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % Lveg(i,j,k) = IniVal + END DO + END DO + END DO +! + DO iveg=1,NVEG + DO k=1,N(ng) + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % ru_loc_veg(i,j,k,iveg) = IniVal + VEG(ng) % rv_loc_veg(i,j,k,iveg) = IniVal + END DO + END DO + END DO + END DO +! + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % step2d_uveg(i,j) = IniVal + VEG(ng) % step2d_vveg(i,j) = IniVal + END DO + END DO +! +# ifdef VEG_FLEX + DO iveg=1,NVEG + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % bend(i,j,iveg) = IniVal + END DO + END DO + END DO +# endif +! +# ifdef VEG_TURB + DO k=1,N(ng) + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % tke_veg(i,j,k) = IniVal + VEG(ng) % gls_veg(i,j,k) = IniVal + END DO + END DO + END DO +# endif +! +# if defined VEG_SWAN_COUPLING && defined VEG_STREAMING + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % dissip_veg(i,j) = IniVal + VEG(ng) % Cdwave_veg(i,j) = IniVal + END DO + END DO + DO k=1,N(ng) + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % BWDXL_veg(i,j,k) = IniVal + VEG(ng) % BWDYL_veg(i,j,k) = IniVal + END DO + END DO + END DO +# endif +# endif +! +# ifdef MARSH_DYNAMICS + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % marsh_mask(i,j) = IniVal + END DO + END DO +# ifdef MARSH_WAVE_THRUST + DO j=Jmin,Jmax + DO i=Imin,Imax +! VEG(ng) % marsh_mask(i,j) = IniVal + VEG(ng) % umask_marsh(i,j) = IniVal + VEG(ng) % vmask_marsh(i,j) = IniVal + VEG(ng) % Thrust_xi(i,j) = IniVal + VEG(ng) % Thrust_eta(i,j) = IniVal + VEG(ng) % Thrust_total(i,j) = IniVal +# ifdef MARSH_SED_EROSION + DO k=1,NST + VEG(ng) % marsh_flux_out(i,j,k) = IniVal + END DO +# endif + END DO + END DO +# endif +# if defined MARSH_RETREAT + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % marsh_retreat(i,j) = IniVal + END DO + END DO +# endif +# if defined MARSH_STOCH + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % marsh_stoch(i,j) = IniVal + END DO + END DO +# endif +# if defined MARSH_TIDAL_RANGE_CALC + VEG(ng) % counter_loc_rl=1.0_r8 ! IniVal + DO j=Jmin,Jmax + DO i=Imin,Imax + DO t=1,NTIMES_MARSH + VEG(ng) % zeta_max_rec(i,j,t) = IniVal + VEG(ng) % zeta_min_rec(i,j,t) = IniVal +! VEG(ng) % counter_dim(t) = INT(IniVal) + END DO + END DO + END DO + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % zeta_max1(i,j) = -10.0_r8 ! IniVal + VEG(ng) % zeta_min1(i,j) = 10.0_r8 ! IniVal + END DO + END DO + VEG(ng) % marsh_tidal_range(i,j) = IniVal +# endif +# if defined MARSH_VERT_GROWTH + DO j=Jmin,Jmax + DO i=Imin,Imax + VEG(ng) % marsh_high_water(i,j) = IniVal + VEG(ng) % marsh_low_water(i,j) = IniVal +! + VEG(ng) % marsh_biomass_peak(i,j) = IniVal + VEG(ng) % marsh_vert_rate(i,j) = IniVal + VEG(ng) % marsh_accret(i,j) = IniVal + END DO + END DO +# endif +# endif +! + END IF +! + RETURN + END SUBROUTINE initialize_vegarr diff --git a/ROMS/Nonlinear/Vegetation/vegetation_biomass.F b/ROMS/Nonlinear/Vegetation/vegetation_biomass.F new file mode 100644 index 00000000..82ad0051 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_biomass.F @@ -0,0 +1,231 @@ +#include "cppdefs.h" +! This file is not used so check with John and Neil if we need this in +! the distribution. It is an old method to update vegetation properties. +! It is not used anywhere in the model. + MODULE sed_biomass_mod + +#if defined NONLINEAR && defined SEDIMENT && defined SED_BIOMASS +! +!git $Id$ +!==================================================== Neil K. Ganju ==== +! Copyright (c) 2002-2024 The ROMS/TOMS Group Hernan G. Arango ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!======================================================================= +! ! +! This computes sediment biomass due to vegation growth ! +! ! +! References: ! +! ! +! ! +!======================================================================= +! + implicit none + + PRIVATE + PUBLIC :: sed_biomass + + CONTAINS +! +!*********************************************************************** + SUBROUTINE sed_biomass (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_grid + USE mod_sedbed + USE mod_stepping +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL sed_biomass_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & +# ifdef MASKING + & GRID(ng) % rmask, & +# ifdef WET_DRY + & GRID(ng) % rmask_wet, & +# endif +# endif +# ifdef SPECTRAL_LIGHT + & OCEAN(ng) % SgrN, & +# endif + & GRID(ng) % z_w, & + & SEDBED(ng) % Dstp_max, & + & SEDBED(ng) % bottom, & + & SEDBED(ng) % settling_flux) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE sed_biomass +! +!*********************************************************************** + SUBROUTINE sed_biomass_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & +# ifdef MASKING + & rmask, & +# ifdef WET_DRY + & rmask_wet, & +# endif +# endif +# ifdef SPECTRAL_LIGHT + & SgrN, & +# endif + & z_w, & + & Dstp_max, & + & bottom, settling_flux) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_sediment +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:,LBj:) +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:,LBj:) +# endif +# endif +# ifdef SPECTRAL_LIGHT + real(r8), intent(in) :: SgrN(LBi:,LBj:) +# endif + real(r8), intent(in) :: z_w(LBi:,LBj:,0:) + real(r8), intent(inout) :: Dstp_max(LBi:,LBj:,:) + real(r8), intent(inout) :: bottom(LBi:,LBj:,:) + real(r8), intent(inout) :: settling_flux(LBi:,LBj:,:) +# else +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj) +# ifdef WET_DRY + real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj) +# endif +# endif +# ifdef SPECTRAL_LIGHT + real(r8), intent(in) :: SgrN(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk) + real(r8), intent(inout) :: Dstp_max(LBi:UBi,LBj:UBj,24) + real(r8), intent(inout) :: bottom(LBi:UBi,LBj:UBj,MBOTP) + real(r8), intent(inout) :: settling_flux(LBi:UBi,LBj:UBj,NST) +# endif +! +! Local variable declarations. +! + integer :: i, j, k, ised + integer :: sstp, nbio_steps + real(r8) :: cff, Dstp +# ifdef SEAGRASS_BOTTOM + real(r8) :: sgr_kgmmol +# endif + +# include "set_bounds.h" + +! +!----------------------------------------------------------------------- +! Compute +!----------------------------------------------------------------------- +! +! Compute number of model steps for each hour. +! + nbio_steps=MAX(1,INT(3600.0_r8/dt(ng))) +! +! Compute number of hourly values we need to save. +! If we want a 1 day avg, then need 24 values. +! + J_LOOP : DO j=Jstr,Jend +! +! Only update the max depth once per hour. +! + IF (MOD(iic(ng),nbio_steps).eq.0) THEN + DO i=Istr,Iend +! +! Determine the index for placement of new value. +! + sstp=1+MOD(iic(ng)-ntstart(ng),24) +! +! Save instantaneous depth at this instance and recompute max daily depth. +! + Dstp=z_w(i,j,N(ng))-z_w(i,j,0) + Dstp_max(i,j,sstp)=Dstp + cff=0.0_r8 + DO k=1,nTbiom + cff=MAX(cff,Dstp_max(i,j,k)) + END DO + bottom(i,j,imaxD)=cff + END DO + END IF +! +! Seagrass as a bottom property +! +# ifdef SEAGRASS_BOTTOM + DO i=Istr,Iend +! sgr_diam=0.01_r8 +# ifdef SEAGRASS_SINK +! SgrN has units of millimole_nitrogen meter-3 +! change moles to kg (2.8e-5 kg/millimole N2) switch to right formula +! cylinder height is mass over (density*pi*r*r) +! shoot height is cylinder height / shoot density + sgr_kgmmol = 2.8e-5_r8 +! sgr_density = 500.0_r8 +! sgr_Hthres = 1.25_r8 + cff = SgrN(i,j)*sgr_kgmmol/ & + & (0.25_r8*sgr_diam*sgr_diam*pi*sgr_density) +! + bottom(i,j,isgrH) = cff/bottom(i,j,isgrD) +! + IF (bottom(i,j,isgrH).lg.sgr_Hthres) THEN + bottom(i,j,isgrD)=bottom(i,j,isgrD)* & + & bottom(i,j,isgrH)/sgr_Hthres + bottom(i,j,isgrH) = sgr_Hthres + END IF +!# else +! bottom(i,j,isgrH)=1.25_r8 +! bottom(i,j,isgrD)=400.0_r8 +# endif + END DO +# endif +! +! Update settling flux for depositing bio mass. +! + DO i=Istr,Iend +! +! Require (for now) that the first sed class be the new biomass. +! + ised=1 + cff=0.0_r8 ! remove this line +! cff= funct( bottom(i,j,imaxD), dt(ng)) ! need real eq. in kg/m^2 +# ifdef MASKING + cff=cff*rmask(i,j) +# ifdef WET_DRY + cff=cff*rmask_wet(i,j) ! not sure this is needed +# endif +# endif + settling_flux(i,j,ised)=settling_flux(i,j,ised)+cff + END DO + END DO J_LOOP + + RETURN + END SUBROUTINE sed_biomass_tile +#endif + END MODULE sed_biomass_mod diff --git a/ROMS/Nonlinear/Vegetation/vegetation_def_his.h b/ROMS/Nonlinear/Vegetation/vegetation_def_his.h new file mode 100644 index 00000000..9093cb42 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_def_his.h @@ -0,0 +1,302 @@ +/* +** git $Id$ +*************************************************** Hernan G. Arango *** +** Copyright (c) 2002-2024 The ROMS/TOMS Group ** +** Licensed under a MIT/X style license ** +** See License_ROMS.txt ** +*************************************************** John C. Warner ** +*************************************************** Neil K. Ganju ** +*************************************************** Alexis Beudin ** +*************************************************** Tarandeep S. Kalra** +** ** +** Defines vegetation module input parameters in output NetCDF files.** +** It is included in routine "def_his.F". ** +** ** +************************************************************************ +*/ +#if defined VEG_DRAG || defined VEG_BIOMASS +! +! Define vegetation module parameters. +! + DO i=1,NVEGP + IF (Hout(idvprp(i),ng)) THEN + Vinfo( 1)=Vname(1,idvprp(i)) + Vinfo( 2)=Vname(2,idvprp(i)) + Vinfo( 3)=Vname(3,idvprp(i)) + Vinfo(14)=Vname(4,idvprp(i)) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idvprp(i)) +! Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idvprp(i),ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid,HIS(ng)%Vid(idvprp(i)) & + & ,NF_FOUT, nvd4, v3pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF + END DO +#endif +#if defined VEG_STREAMING +! +! Define wave dissipation due to vegetation. +! + IF (Hout(idWdvg,ng)) THEN + Vinfo( 1)=Vname(1,idWdvg) + Vinfo( 2)=Vname(2,idWdvg) + Vinfo( 3)=Vname(3,idWdvg) + Vinfo(14)=Vname(4,idWdvg) +! Vinfo(16)=Vname(1,idWdvg) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdvg) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdvg,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWdvg), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define spectral Cd due to wave vegetation. +! + IF (Hout(idCdvg,ng)) THEN + Vinfo( 1)=Vname(1,idCdvg) + Vinfo( 2)=Vname(2,idCdvg) + Vinfo( 3)=Vname(3,idCdvg) + Vinfo(14)=Vname(4,idCdvg) +! Vinfo(16)=Vname(1,idCdvg) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idCdvg) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idCdvg,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idCdvg), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + + END IF +#endif +#ifdef MARSH_DYNAMICS +! +! Store masking marsh of marsh cells. +! + IF (Hout(idTims,ng)) THEN + Vinfo( 1)=Vname(1,idTims) + Vinfo( 2)=Vname(2,idTims) + Vinfo( 3)=Vname(3,idTims) + Vinfo(14)=Vname(4,idTims) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTims) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTims,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTims), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname , & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# ifdef MARSH_WAVE_THRUST +! +! Total thrust from all directions due to waves. +! + IF (Hout(idTtot,ng)) THEN + Vinfo( 1)=Vname(1,idTtot) + Vinfo( 2)=Vname(2,idTtot) + Vinfo( 3)=Vname(3,idTtot) + Vinfo(14)=Vname(4,idTtot) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTtot) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTtot,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTtot), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +# ifdef MARSH_SED_EROSION +! +! Marsh sediment flux out from marsh cells from each sedclass type. +! + DO i=1,NST + IF (Hout(idTmfo(i),ng)) THEN + Vinfo( 1)=Vname(1,idTmfo(i)) + Vinfo( 2)=Vname(2,idTmfo(i)) + Vinfo( 3)=Vname(3,idTmfo(i)) + Vinfo(14)=Vname(4,idTmfo(i)) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTmfo(i)) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmfo(i),ng)) + status=def_var(ng, iNLM, HIS(ng)%ncid, & + & HIS(ng)%Vid(idTmfo(i)), NF_FOUT, & + & nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF + END DO +! +# ifdef MARSH_RETREAT +! +! Amount of marsh retreat from all directions. +! + IF (Hout(idTmmr,ng)) THEN + Vinfo( 1)=Vname(1,idTmmr) + Vinfo( 2)=Vname(2,idTmmr) + Vinfo( 3)=Vname(3,idTmmr) + Vinfo(14)=Vname(4,idTmmr) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTmmr) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmmr,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmmr), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# endif +# endif +# ifdef MARSH_TIDAL_RANGE_CALC +! +! Amount of marsh tidal range over a given frequency. +! + IF (Hout(idTmtr,ng)) THEN + Vinfo( 1)=Vname(1,idTmtr) + Vinfo( 2)=Vname(2,idTmtr) + Vinfo( 3)=Vname(3,idTmtr) + Vinfo(14)=Vname(4,idTmtr) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTmtr) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmtr,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmtr), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +! +# if defined MARSH_VERT_GROWTH +! + IF (Hout(idTmhw,ng)) THEN + Vinfo( 1)=Vname(1,idTmhw) + Vinfo( 2)=Vname(2,idTmhw) + Vinfo( 3)=Vname(3,idTmhw) + Vinfo(14)=Vname(4,idTmhw) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTmhw) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmhw,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmhw), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Amount of marsh mean low water over a given frequency. +! + IF (Hout(idTmlw,ng)) THEN + Vinfo( 1)=Vname(1,idTmlw) + Vinfo( 2)=Vname(2,idTmlw) + Vinfo( 3)=Vname(3,idTmlw) + Vinfo(14)=Vname(4,idTmlw) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTmlw) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmlw,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmlw), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! +! Amount of marsh biomass peak (kg/sq.m). +! + IF (Hout(idTmbp,ng)) THEN + Vinfo( 1)=Vname(1,idTmbp) + Vinfo( 2)=Vname(2,idTmbp) + Vinfo( 3)=Vname(3,idTmbp) + Vinfo(14)=Vname(4,idTmbp) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTmbp) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmbp,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmbp), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Rate of marsh vertical growth (m/year). +! + IF (Hout(idTmvg,ng)) THEN + Vinfo( 1)=Vname(1,idTmvg) + Vinfo( 2)=Vname(2,idTmvg) + Vinfo( 3)=Vname(3,idTmvg) + Vinfo(14)=Vname(4,idTmvg) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTmvg) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmvg,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmvg), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Amount of marsh vertical growth (m). +! + IF (Hout(idTmvt,ng)) THEN + Vinfo( 1)=Vname(1,idTmvt) + Vinfo( 2)=Vname(2,idTmvt) + Vinfo( 3)=Vname(3,idTmvt) + Vinfo(14)=Vname(4,idTmvt) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idTmvt) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmvt,ng),r8) + status=def_var(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmvt), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & + & SetFillVal = .FALSE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +#endif diff --git a/ROMS/Nonlinear/Vegetation/vegetation_def_rst.h b/ROMS/Nonlinear/Vegetation/vegetation_def_rst.h new file mode 100644 index 00000000..9f657eca --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_def_rst.h @@ -0,0 +1,184 @@ +/* +** git $Id$ +*************************************************** Hernan G. Arango *** +** Copyright (c) 2002-2024 The ROMS/TOMS Group ** +** Licensed under a MIT/X style license ** +** See License_ROMS.txt ** +*************************************************** John C. Warner ** +*************************************************** Neil K. Ganju ** +*************************************************** Alexis Beudin ** +*************************************************** Tarandeep S. Kalra** +** ** +** Defines vegetation module input parameters in output restart ** +** NetCDF files. ** +** It is included in routine "def_rst.F". ** +** ** +************************************************************************ +*/ +! +! Define vegetation module parameters. +! +#if defined VEG_DRAG || defined VEG_BIOMASS + DO i=1,NVEGP + Vinfo( 1)=Vname(1,idvprp(i)) + Vinfo( 2)=Vname(2,idvprp(i)) + Vinfo( 3)=Vname(3,idvprp(i)) + Vinfo(14)=Vname(4,idvprp(i)) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING +# if defined PERFECT_RESTART + Vinfo(24)='_FillValue' + Aval(6)=spval +# else + Vinfo(20)='mask_rho' +# endif +# endif +! Vinfo(22)='coordinates' + Vinfo(21)=Vname(6,idvprp(i)) + Aval(5)=REAL(Iinfo(1,idvprp(i),ng),r8) + status=def_var(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idvprp(i)),& + & NF_FRST, nvd4, v3pgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END DO +#endif +! +#if defined VEG_STREAMING +! +! Define wave dissipation due to vegetation +! + Vinfo( 1)=Vname(1,idWdvg) + Vinfo( 2)=Vname(2,idWdvg) + Vinfo( 3)=Vname(3,idWdvg) + Vinfo(14)=Vname(4,idWdvg) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdvg) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdvg,ng),r8) + status=def_var(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idWdvg), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! +! Define spectral Cd due to veg on waves. +! + Vinfo( 1)=Vname(1,idCdvg) + Vinfo( 2)=Vname(2,idCdvg) + Vinfo( 3)=Vname(3,idCdvg) + Vinfo(14)=Vname(4,idCdvg) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idCdvg) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idCdvg,ng),r8) + status=def_var(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idCdvg), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + +#endif +! +#ifdef MARSH_DYNAMICS +! +! Store marsh masking marsh from marsh cells. +! + Vinfo( 1)=Vname(1,idTims) + Vinfo( 2)=Vname(2,idTims) + Vinfo( 3)=Vname(3,idTims) + Vinfo(14)=Vname(4,idTims) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING +# if defined PERFECT_RESTART + Vinfo(24)='_FillValue' + Aval(6)=spval +# else + Vinfo(20)='mask_rho' +# endif +# endif + Vinfo(21)=Vname(6,idTims) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTims,ng),r8) + status=def_var(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idTims), & + & NF_FRST, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! +# ifdef MARSH_WAVE_THRUST +! +! Total thrust from all directions due to waves. +! + Vinfo( 1)=Vname(1,idTtot) + Vinfo( 2)=Vname(2,idTtot) + Vinfo( 3)=Vname(3,idTtot) + Vinfo(14)=Vname(4,idTtot) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING +# if defined PERFECT_RESTART + Vinfo(24)='_FillValue' + Aval(6)=spval +# else + Vinfo(20)='mask_rho' +# endif +# endif + Vinfo(21)=Vname(6,idTtot) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTtot,ng),r8) + status=def_var(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idTtot), & + & NF_FRST, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! +# ifdef MARSH_SED_EROSION +! +! Marsh sediment flux out from marsh cells from each sedclass. +! + DO i=1,NST + Vinfo( 1)=Vname(1,idTmfo(i)) + Vinfo( 2)=Vname(2,idTmfo(i)) + Vinfo( 3)=Vname(3,idTmfo(i)) + Vinfo(14)=Vname(4,idTmfo(i)) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING +# if defined PERFECT_RESTART + Vinfo(24)='_FillValue' + Aval(6)=spval +# else + Vinfo(20)='mask_rho' +# endif +# endif + Vinfo(21)=Vname(6,idTmfo(i)) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmfo(i),ng),r8) + status=def_var(ng, iNLM, RST(ng)%ncid, & + & RST(ng)%Vid(idTmfo(i)), NF_FRST, & + & nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END DO +! +# ifdef MARSH_RETREAT +! +! Amount of marsh retreat from all four directions. +! + Vinfo( 1)=Vname(1,idTmmr) + Vinfo( 2)=Vname(2,idTmmr) + Vinfo( 3)=Vname(3,idTmmr) + Vinfo(14)=Vname(4,idTmmr) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING +# if defined PERFECT_RESTART + Vinfo(24)='_FillValue' + Aval(6)=spval +# else + Vinfo(20)='mask_rho' +# endif +# endif + Vinfo(21)=Vname(6,idTmmr) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idTmmr,ng),r8) + status=def_var(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idTmmr), & + & NF_FRST, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +# endif +# endif +# endif +#endif diff --git a/ROMS/Nonlinear/Vegetation/vegetation_drag.F b/ROMS/Nonlinear/Vegetation/vegetation_drag.F new file mode 100644 index 00000000..c71bf29a --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_drag.F @@ -0,0 +1,458 @@ +#include "cppdefs.h" + + MODULE vegetation_drag_mod + +#if defined VEGETATION && defined VEG_DRAG +! +!git $Id$ +!======================================================================! +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.txt Alexander F. Shchepetkin ! +!==================================================== John C. Warner ==! +!==================================================== Neil K. Ganju ==! +!==================================================== Alexis Beudin ==! +!==================================================Tarandeep S. Kalra==! +! ! +! This routine computes the vegetation (posture-dependent) drag ! +! for rhs3d.F ! +! ! +! References: ! +! ! +! Luhar M., and H. M. Nepf (2011), Flow-induced reconfiguration of ! +! buoyant and flexible aquatic vegetation, Limnology and Oceanography,! +! 56(6): 2003-2017. ! +! ! +!======================================================================! +! ! + implicit none + + PRIVATE + PUBLIC :: vegetation_drag_cal + + CONTAINS +! +!*********************************************************************** + SUBROUTINE vegetation_drag_cal (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_stepping + USE mod_grid + USE mod_ocean + USE mod_vegarr +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL vegetation_drag_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nrhs(ng), & + & GRID(ng) % Hz, & + & OCEAN(ng) % u, & + & OCEAN(ng) % v, & + & VEG(ng) % plant, & +# ifdef VEG_FLEX + & VEG(ng) % bend, & +# endif +# if defined MARSH_DYNAMICS && defined MARSH_RETREAT + & VEG(ng) % marsh_mask, & +# endif + & VEG(ng) % ru_loc_veg, & + & VEG(ng) % rv_loc_veg, & + & VEG(ng) % ru_veg, & + & VEG(ng) % rv_veg, & + & VEG(ng) % step2d_uveg, & + & VEG(ng) % step2d_vveg, & + & VEG(ng) % Lveg) + +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE vegetation_drag_cal +! +!*********************************************************************** + SUBROUTINE vegetation_drag_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nrhs, & + & Hz, & + & u, v, & + & plant, & +# ifdef VEG_FLEX + & bend, & +# endif +# if defined MARSH_DYNAMICS && defined MARSH_RETREAT + & marsh_mask, & +# endif + & ru_loc_veg, rv_loc_veg, & + & ru_veg, rv_veg, & + & step2d_uveg, step2d_vveg, & + & Lveg) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_vegetation + USE mod_vegarr + USE bc_3d_mod, ONLY: bc_r3d_tile + USE exchange_2d_mod + USE exchange_3d_mod +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, & + & mp_exchange3d, mp_exchange4d +# endif +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nrhs +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: Hz(LBi:,LBj:,:) + real(r8), intent(in) :: u(LBi:,LBj:,:,:) + real(r8), intent(in) :: v(LBi:,LBj:,:,:) + real(r8), intent(inout) :: plant(LBi:,LBj:,:,:) +# ifdef VEG_FLEX + real(r8), intent(inout) :: bend(LBi:,LBj:,:) +# endif +# if defined MARSH_DYNAMICS && defined MARSH_RETREAT + real(r8), intent(inout) :: marsh_mask(LBi:,LBj:) +# endif + real(r8), intent(inout) :: ru_loc_veg(LBi:,LBj:,:,:) + real(r8), intent(inout) :: rv_loc_veg(LBi:,LBj:,:,:) + real(r8), intent(inout) :: ru_veg(LBi:,LBj:,:) + real(r8), intent(inout) :: rv_veg(LBi:,LBj:,:) + real(r8), intent(inout) :: step2d_uveg(LBi:,LBj:) + real(r8), intent(inout) :: step2d_vveg(LBi:,LBj:) + real(r8), intent(inout) :: Lveg(LBi:,LBj:,:) +# else + real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2) + real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2) + real(r8), intent(inout) :: plant(LBi:UBi,LBj:UBj,NVEG,NVEGP) +# ifdef VEG_FLEX + real(r8), intent(inout) :: bend(LBi:UBi,LBj:UBj,N(ng),NVEG) +# endif +# if defined MARSH_DYNAMICS && defined MARSH_RETREAT + real(r8), intent(inout) :: marsh_mask(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(inout) :: & + & ru_loc_veg(LBi:UBi,LBj:UBj,N(ng),NVEG), & + & rv_loc_veg(LBi:UBi,LBj:UBj,N(ng),NVEG) + real(r8), intent(inout) :: ru_veg(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(inout) :: rv_veg(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(inout) :: step2d_uveg(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: step2d_vveg(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: Lveg(LBi:UBi,LBj:UBj,N(ng)) +# endif +! +! Local variable declarations. +! + integer :: i, j, k, ivpr, iveg +! + real(r8), parameter :: one_third = 1.0_r8/3.0_r8 + real(r8), parameter :: one_twelfth = 1.0_r8/12.0_r8 + real(r8), parameter :: Inival = 0.0_r8 + real(r8), parameter :: min_eps = 1.0E-12_r8 + real(r8), parameter :: max_eps = 1.0E12_r8 + real(r8) :: cff, inv_cff1, cff1, cff2, cff3, cff4, Hz_inverse + real(r8) :: cff5, cff6 + real(r8) :: sma, buoy, Umag, Ca, cflex + real(r8) :: Lveg_loc, plant_height_eff + real(r8), dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: dab + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wrk +! +# include "set_bounds.h" +! +!----------------------------------------------------------------------- +! Resistance imposed on the flow by vegetation. +!----------------------------------------------------------------------- +! + dab=Inival + ru_veg=Inival + rv_veg=Inival + Lveg=Inival +! +# ifdef WET_DRY +! +! Set limiting factor for drag force. The drag force is adjusted +! to not change the direction of momentum. It only should slow down +! to zero. The value of 0.75 is arbitrary limitation assigment +! (same as for bottom stress). +! + cff=0.75_r8/dt(ng) +# endif +! +# if defined MARSH_DYNAMICS && defined MARSH_RETREAT + DO ivpr=1,NVEGP + DO iveg=1,NVEG + DO j=Jstr,Jend + DO i=Istr,Iend + plant(i,j,iveg,pdens)=plant(i,j,iveg,pdens)* & + & marsh_mask(i,j) + plant(i,j,iveg,phght)=plant(i,j,iveg,phght)* & + & marsh_mask(i,j) + plant(i,j,iveg,pthck)=plant(i,j,iveg,pthck)* & + & marsh_mask(i,j) + plant(i,j,iveg,pdiam)=plant(i,j,iveg,pdiam)* & + & marsh_mask(i,j) + END DO + END DO + END DO + END DO +# endif +! + VEG_LOOP: DO iveg=1,NVEG + K_LOOP: DO k=1,N(ng) + DO j=JstrV-1,Jend + DO i=IstrU-1,Iend +! +# ifdef VEG_FLEX +! +! Flexible vegetation +! +! Second moment of area +! + sma=(plant(i,j,iveg,pdiam)* & + & plant(i,j,iveg,pthck)**3.0_r8)*(one_twelfth) +! +! Avoid division by zero +! + cff1=MAX( (E_veg(iveg,ng)*sma), min_eps) + inv_cff1=1.0_r8/cff1 +! +! Buoyancy parameter +! + buoy=(rhow-veg_massdens(iveg,ng))*g*plant(i,j,iveg,pdiam)*& + & plant(i,j,iveg,pthck)* & + & plant(i,j,iveg,phght)**3.0_r8*inv_cff1 +! +! Current speed at rho points +! + cff2=0.5_r8*(u(i,j,k,nrhs)+u(i+1,j,k,nrhs)) + cff3=0.5_r8*(v(i,j,k,nrhs)+v(i,j+1,k,nrhs)) + Umag=SQRT(cff2*cff2+cff3*cff3) +! +! Cauchy number +! + Ca=0.5_r8*rhow*Cd_veg(iveg,ng)*plant(i,j,iveg,pdiam)* & + & Umag**2.0_r8*plant(i,j,iveg,phght)**3.0_r8*inv_cff1 +! +! Avoid infinity in Cauchy's number +! + cff4=MIN(Ca**-1.5_r8, max_eps) +! +! Denominator for cflex calculation +! + cff5=1.0_r8+(cff4*(8.0_r8+buoy**(1.5_r8))) +! +! Avoid infinity in Cauchy's number +! + cff6=MIN(Ca**(-one_third), max_eps) +! +! set a minimum for cflex to be 1 , cflex will exceed 1 if Ca<0.7290 +! but don't allow those values +! + cflex=1.0_r8-((1.0_r8-0.9_r8*cff6)/(cff5)) + cflex=MIN(cflex, 1.0_r8) +! +! Effective blade length +! + plant_height_eff=cflex*plant(i,j,iveg,phght) +! +! Blade bending angle +! + bend(i,j,iveg)=ACOS(cflex**one_third)*rad2deg +# else +! +! For stiff vegetation +! + plant_height_eff=plant(i,j,iveg,phght) +# endif +! +! Select the grid cell (full or part) within the canopy layer +! + dab(i,j,k)=dab(i,j,k-1)+Hz(i,j,k) + Hz_inverse=1.0_r8/Hz(i,j,k) + cff1=MIN((dab(i,j,k)-plant_height_eff)*Hz_inverse,1.0_r8) + Lveg_loc=MIN(1.0_r8-cff1,1.0_r8) +! +! Prepare drag term (at rho points) +! + wrk(i,j)=0.5_r8*cd_veg(iveg,ng)*plant(i,j,iveg,pdiam)* & + & plant(i,j,iveg,pdens)*Hz(i,j,k)*Lveg_loc +! +! Store Lveg_loc for all vegetation types +! + Lveg(i,j,k)=Lveg_loc+Lveg(i,j,k) + END DO + END DO +! +! Exchange boundary data +! + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + CALL exchange_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & wrk) + ENDIF + +! + CALL mp_exchange2d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & wrk(:,:)) +! +! Compute friction force (at cell faces) +! + DO j=Jstr,Jend + DO i=IstrU,Iend + cff1=0.25_r8*(v(i ,j ,k,nrhs)+ & + & v(i ,j+1,k,nrhs)+ & + & v(i-1,j ,k,nrhs)+ & + & v(i-1,j+1,k,nrhs)) + cff2=SQRT(u(i,j,k,nrhs)*u(i,j,k,nrhs)+cff1*cff1) + cff3=u(i,j,k,nrhs)*cff2 + ru_loc_veg(i,j,k,iveg)=0.5_r8*(wrk(i-1,j)+wrk(i,j))*cff3 +! +! Add the ru_iveg from this veg type to another veg type +! which can be there at the same point (i,j,k) +! Alexis's comment: not confident in what is happening when +! multiple vegetation types are concomitant +! + ru_veg(i,j,k)=ru_loc_veg(i,j,k,iveg)+ru_veg(i,j,k) + +! +# ifdef WET_DRY + cff4=cff*0.5_r8*(Hz(i-1,j,k)+Hz(i,j,k)) + ru_veg(i,j,k)=SIGN(1.0_r8, ru_veg(i,j,k))* & + & MIN(ABS(ru_veg(i,j,k)), & + & ABS(u(i,j,k,nrhs))*cff4) +# endif +! + END DO + END DO +! + DO j=JstrV,Jend + DO i=Istr,Iend + cff1=0.25_r8*(u(i ,j ,k,nrhs)+ & + & u(i+1,j ,k,nrhs)+ & + & u(i ,j-1,k,nrhs)+ & + & u(i+1,j-1,k,nrhs)) + cff2=SQRT(cff1*cff1+v(i,j,k,nrhs)*v(i,j,k,nrhs)) + cff3=v(i,j,k,nrhs)*cff2 + rv_loc_veg(i,j,k,iveg)=0.5_r8*(wrk(i,j-1)+wrk(i,j))*cff3 +! +! Add the rv_iveg from this veg type to another veg type +! which can be there at the same point (i,j,k) +! + rv_veg(i,j,k)=rv_loc_veg(i,j,k,iveg)+rv_veg(i,j,k) + +! +# ifdef WET_DRY + cff4=cff*0.5_r8*(Hz(i,j-1,k)+Hz(i,j,k)) + rv_veg(i,j,k)=SIGN(1.0_r8, rv_veg(i,j,k))* & + & MIN(ABS(rv_veg(i,j,k)), & + & ABS(v(i,j,k,nrhs))*cff4) +# endif +! + END DO + END DO + END DO K_LOOP + END DO VEG_LOOP +! +! Exchange boundary data +! + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN + DO iveg=1,NVEG + CALL exchange_u3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & ru_loc_veg(:,:,:,iveg)) + CALL exchange_v3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & rv_loc_veg(:,:,:,iveg)) + END DO + CALL exchange_u3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & ru_veg(:,:,:)) + CALL exchange_v3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & rv_veg(:,:,:)) + END IF +! +# if defined MARSH_DYNAMICS && defined MARSH_RETREAT + DO ivpr=1,NVEGP + CALL bc_r3d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, 1, NVEG, & + & plant(:,:,:,ivpr)) + END DO +# endif +! +# ifdef DISTRIBUTE +! + CALL mp_exchange4d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, N(ng), 1, NVEG, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & ru_loc_veg(:,:,:,:), & + & rv_loc_veg(:,:,:,:)) +! + CALL mp_exchange3d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & ru_veg, rv_veg) +! +# if defined MARSH_DYNAMICS && defined MARSH_RETREAT + CALL mp_exchange4d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, NVEG, 1, NVEGP, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & plant(:,:,:,:)) +# endif +# endif +! +!----------------------------------------------------------------------- +! Add in resistance imposed on the flow by the vegetation (3D->2D). +! Changes feedback in Nonlinear/step2d_LF_AM3.F +!----------------------------------------------------------------------- +! + DO j=Jstr,Jend + DO i=IstrU,Iend + cff=0.5_r8*(Hz(i-1,j,1)+Hz(i,j,1)) + cff2=cff*ru_veg(i,j,1) + DO k=2,N(ng) + cff=0.5_r8*(Hz(i-1,j,k)+Hz(i,j,k)) + cff2=cff2+cff*ru_veg(i,j,k) + END DO + step2d_uveg(i,j)=cff2 + END DO + END DO +! + DO i=Istr,Iend + DO j=JstrV,Jend + cff=0.5_r8*(Hz(i,j-1,1)+Hz(i,j,1)) + cff2=cff*rv_veg(i,j,1) + DO k=2,N(ng) + cff=0.5_r8*(Hz(i,j-1,k)+Hz(i,j,k)) + cff2=cff2+cff*rv_veg(i,j,k) + END DO + step2d_vveg(i,j)=cff2 + END DO + END DO +! + RETURN + END SUBROUTINE vegetation_drag_tile +#endif + END MODULE vegetation_drag_mod diff --git a/ROMS/Nonlinear/Vegetation/vegetation_inp.h b/ROMS/Nonlinear/Vegetation/vegetation_inp.h new file mode 100644 index 00000000..e71c98e0 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_inp.h @@ -0,0 +1,480 @@ + SUBROUTINE read_VegPar (model, inp, out, Lwrite) +! +!======================================================================= +! ! +! This routine reads in vegetation model parameters. ! +! Equivalent of read_phypar.F so it gets read in that ! +! This routine also outputs vegetation model parameters. ! +!======================================================================= +! + USE mod_param + USE mod_parallel + USE mod_ncparam + USE mod_scalars + USE mod_vegetation +! + USE inp_decode_mod +#if defined MARSH_SED_EROSION + USE mod_sediment +#endif +! + implicit none +! +! Imported variable declarations +! + logical, intent(in) :: Lwrite + integer, intent(in) :: model, inp, out +! +! Local variable declarations. +! + integer :: Npts, Nval + integer :: iTrcStr, iTrcEnd + integer :: i, ifield, igrid, itracer, itrc, ng, nline, status + integer :: iveg, ised, it +! integer :: decode_line, load_i, load_l, load_lbc, load_r +! + real(r8), dimension(200) :: Rval +#if defined MARSH_SED_EROSION || defined MARSH_VERT_GROWTH + real(r8), dimension(Ngrids) :: Rmarsh +#endif +#ifdef VEG_DRAG + real(r8), allocatable :: Rveg(:,:) +#endif + logical, dimension(NNS,Ngrids) :: Lsand1 +! + character (len=40 ) :: KeyWord + character (len=256) :: line + character (len=256), dimension(200) :: Cval +! +!----------------------------------------------------------------------- +! Read input parameters from vegetation.in +!----------------------------------------------------------------------- +! + DO WHILE (.TRUE.) + READ (inp,'(a)',ERR=10,END=20) line + status=decode_line(line, KeyWord, Nval, Cval, Rval) + IF (status.gt.0) THEN + SELECT CASE (TRIM(KeyWord)) +#ifdef VEG_DRAG + CASE ('NVEG') + Npts=load_i(Nval, Rval, Ngrids, NVEG) + IF (NVEG.lt.0) THEN + IF (Master) WRITE (out,30) 'NVEG', ng, & + & 'must be greater than zero.' + exit_flag=5 + RETURN + END IF + IF (.not.allocated(Rveg)) allocate(Rveg(NVEG,Ngrids)) + CASE ('CD_VEG') + IF (.not.allocated(CD_VEG)) allocate(CD_VEG(NVEG,Ngrids)) + Npts=load_r(Nval, Rval, NVEG, Ngrids, Rveg) + DO ng=1,Ngrids + DO iveg=1,NVEG + CD_VEG(iveg,ng)=Rveg(iveg,ng) + END DO + END DO + CASE ('E_VEG') + IF (.not.allocated(E_VEG)) allocate(E_VEG(NVEG,Ngrids)) + Npts=load_r(Nval, Rval, NVEG, Ngrids, Rveg) + DO ng=1,Ngrids + DO iveg=1,NVEG + E_VEG(iveg,ng)=Rveg(iveg,ng) + END DO + END DO + CASE ('VEG_MASSDENS') + IF (.not.allocated(VEG_MASSDENS)) & + & allocate(VEG_MASSDENS(NVEG,Ngrids)) + Npts=load_r(Nval, Rval, NVEG, Ngrids, Rveg) + DO ng=1,Ngrids + DO iveg=1,NVEG + VEG_MASSDENS(iveg,ng)=Rveg(iveg,ng) + END DO + END DO + CASE ('VEGHMIXCOEF') + IF (.not.allocated(VEGHMIXCOEF)) & + & allocate(VEGHMIXCOEF(NVEG,Ngrids)) + Npts=load_r(Nval, Rval, NVEG, Ngrids, Rveg) + DO ng=1,Ngrids + DO iveg=1,NVEG + VEGHMIXCOEF(iveg,ng)=Rveg(iveg,ng) + END DO + END DO +#endif +#if defined MARSH_SED_EROSION +! IF (.not.allocated(Rmarsh)) allocate(Rmarsh(Ngrids)) + CASE ('KFAC_MARSH') + IF (.not.allocated(KFAC_MARSH)) & + & allocate(KFAC_MARSH(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + KFAC_MARSH(ng)=Rmarsh(ng) + END DO +# if defined MARSH_RETREAT + CASE ('SCARP_HGHT') + IF (.not.allocated(SCARP_HGHT)) & + & allocate(SCARP_HGHT(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + SCARP_HGHT(ng)=Rmarsh(ng) + END DO +# endif +#endif +#if defined MARSH_TIDAL_RANGE_CALC + CASE ('NTIMES_MARSH') + Npts=load_i(Nval, Rval, Ngrids, NTIMES_MARSH) + IF (NTIMES_MARSH.lt.0) THEN + IF (Master) WRITE (out,30) 'NTIMES_MARSH', ng, & + & 'must be greater than zero.' + exit_flag=5 + RETURN + END IF +#endif +#if defined MARSH_VERT_GROWTH + IF (.not.allocated(Rveg)) allocate(Rveg(NVEG,Ngrids)) + CASE ('PAR_FAC1') + IF (.not.allocated(PAR_FAC1)) & + & allocate(PAR_FAC1(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + PAR_FAC1(ng)=Rmarsh(ng) + END DO + CASE ('PAR_FAC2') + IF (.not.allocated(PAR_FAC2)) & + & allocate(PAR_FAC2(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + PAR_FAC2(ng)=Rmarsh(ng) + END DO + CASE ('TDAYS_MARSH_GROWTH') + IF (.not.allocated(TDAYS_MARSH_GROWTH)) & + & allocate(TDAYS_MARSH_GROWTH(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + TDAYS_MARSH_GROWTH(ng)=Rmarsh(ng) + END DO + IF (TDAYS_MARSH_GROWTH(ng).lt.0) THEN + IF (Master) WRITE (out,30) 'TDAYS_MARSH_GROWTH', ng, & + & 'must be greater than zero.' + exit_flag=5 + RETURN + END IF +! CASE ('MARSH_BULK_DENS') +! IF (.not.allocated(MARSH_BULK_DENS)) & +! & allocate(MARSH_BULK_DENS(Ngrids)) +! Npts=load_r(Nval, Rval, Ngrids, Rmarsh) +! DO ng=1,Ngrids +! MARSH_BULK_DENS(ng)=Rmarsh(ng) +! END DO + CASE ('NUGP') + IF (.not.allocated(NUGP)) & + & allocate(NUGP(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + NUGP(ng)=Rmarsh(ng) + END DO + CASE ('BMAX') + IF (.not.allocated(BMAX)) & + & allocate(BMAX(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + BMAX(ng)=Rmarsh(ng) + END DO + CASE ('CHIREF') + IF (.not.allocated(CHIREF)) & + & allocate(CHIREF(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + CHIREF(ng)=Rmarsh(ng) + END DO +# if defined MARSH_BIOMASS_VEG + CASE ('ALPHA_PDENS') + IF (.not.allocated(ALPHA_PDENS)) & + & allocate(ALPHA_PDENS(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + ALPHA_PDENS(ng)=Rmarsh(ng) + END DO + CASE ('BETA_PDENS') + IF (.not.allocated(BETA_PDENS)) & + & allocate(BETA_PDENS(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + BETA_PDENS(ng)=Rmarsh(ng) + END DO + CASE ('ALPHA_PHGHT') + IF (.not.allocated(ALPHA_PHGHT)) & + & allocate(ALPHA_PHGHT(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + ALPHA_PHGHT(ng)=Rmarsh(ng) + END DO + CASE ('BETA_PHGHT') + IF (.not.allocated(BETA_PHGHT)) & + & allocate(BETA_PHGHT(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + BETA_PHGHT(ng)=Rmarsh(ng) + END DO + CASE ('ALPHA_PDIAM') + IF (.not.allocated(ALPHA_PDIAM)) & + & allocate(ALPHA_PDIAM(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + ALPHA_PDIAM(ng)=Rmarsh(ng) + END DO + CASE ('BETA_PDIAM') + IF (.not.allocated(BETA_PDIAM)) & + & allocate(BETA_PDIAM(Ngrids)) + Npts=load_r(Nval, Rval, Ngrids, Rmarsh) + DO ng=1,Ngrids + BETA_PDIAM(ng)=Rmarsh(ng) + END DO +# endif +#endif +! +!----------------------------------------------------------------------- +! Read output ids from vegetation.in +!----------------------------------------------------------------------- +! +#if defined VEG_DRAG || defined VEG_BIOMASS + CASE ('Hout(ipdens)') + IF (idvprp(pdens).eq.0) THEN + IF (Master) WRITE (out,30) 'ipdens' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idvprp(pdens),:)) + CASE ('Hout(iphght)') + IF (idvprp(phght).eq.0) THEN + IF (Master) WRITE (out,30) 'iphght' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idvprp(phght),:)) + CASE ('Hout(ipdiam)') + IF (idvprp(pdiam).eq.0) THEN + IF (Master) WRITE (out,30) 'ipdiam' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idvprp(pdiam),:)) + CASE ('Hout(ipthck)') + IF (idvprp(pthck).eq.0) THEN + IF (Master) WRITE (out,30) 'ipthck' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idvprp(pthck),:)) +#endif +#ifdef VEG_STREAMING + CASE ('Hout(idWdvg)') + IF ((idWdvg).eq.0) THEN + IF (Master) WRITE (out,30) 'idWdvg' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idWdvg,:)) + CASE ('Hout(idCdvg)') + IF ((idCdvg).eq.0) THEN + IF (Master) WRITE (out,30) 'idCdvg' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idCdvg,:)) +#endif +#ifdef MARSH_DYNAMICS + CASE ('Hout(idTims)') + IF (idTims.eq.0) THEN + IF (Master) WRITE (out,30) 'idTims' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTims,:)) +# ifdef MARSH_WAVE_THRUST + CASE ('Hout(idTtot)') + IF (idTtot.eq.0) THEN + IF (Master) WRITE (out,30) 'idTtot' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTtot,:)) +# ifdef MARSH_SED_EROSION + CASE ('Hout(idTmfo)') + DO ng=1,Ngrids + DO ised=1,NST + IF (idTmfo(ised).eq.0) THEN + IF (Master) WRITE (out,30) 'idTmfo' + exit_flag=5 + RETURN + END IF + END DO + END DO + Npts=load_l(Nval, Cval, NNS, Ngrids, Lsand1) + DO ng=1,Ngrids + DO ised=1,NST + i=idTmfo(ised) + Hout(i,ng)=Lsand1(ised,ng) + END DO + END DO +# ifdef MARSH_RETREAT + CASE ('Hout(idTmmr)') + IF (idTmmr.eq.0) THEN + IF (Master) WRITE (out,30) 'idTmmr' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTmmr,:)) +# endif +# endif +# endif +# ifdef MARSH_TIDAL_RANGE_CALC + CASE ('Hout(idTmtr)') + IF (idTmtr.eq.0) THEN + IF (Master) WRITE (out,40) 'idTmtr' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTmtr,1:Ngrids)) +# endif +! +# ifdef MARSH_VERT_GROWTH + CASE ('Hout(idTmhw)') + IF (idTmhw.eq.0) THEN + IF (Master) WRITE (out,40) 'idTmhw' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTmhw,1:Ngrids)) + CASE ('Hout(idTmlw)') + IF (idTmlw.eq.0) THEN + IF (Master) WRITE (out,40) 'idTmlw' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTmlw,1:Ngrids)) + CASE ('Hout(idTmvg)') + IF (idTmvg.eq.0) THEN + IF (Master) WRITE (out,40) 'idTmvg' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTmvg,:)) + CASE ('Hout(idTmvt)') + IF (idTmvt.eq.0) THEN + IF (Master) WRITE (out,40) 'idTmvt' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTmvt,:)) + CASE ('Hout(idTmbp)') + IF (idTmbp.eq.0) THEN + IF (Master) WRITE (out,40) 'idTmbp' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Hout(idTmbp,1:Ngrids)) +# endif +#endif + END SELECT + END IF + END DO + 10 IF (Master) WRITE (out,30) line + exit_flag=4 + RETURN + 20 CONTINUE +! +!----------------------------------------------------------------------- +! Print/Report input parameters (values specified in vegetation.in). +!----------------------------------------------------------------------- +! + IF (Lwrite) THEN + DO ng=1,Ngrids +#if defined VEG_DRAG || defined VEG_BIOMASS + WRITE (out,50) ng + WRITE (out,60) + DO iveg=1,NVEG + WRITE (out,70) NVEG, CD_VEG(iveg,ng), E_VEG(iveg,ng), & + & VEG_MASSDENS(iveg,ng), VEGHMIXCOEF(iveg,ng) + END DO +#endif +#if defined MARSH_DYNAMICS + WRITE (out,80) ng +# if defined MARSH_SED_EROSION + WRITE (out,90) KFAC_MARSH(ng) +# endif +# if defined MARSH_RETREAT + WRITE (out,100) SCARP_HGHT(ng) +# endif +# ifdef MARSH_TIDAL_RANGE_CALC +! WRITE (out,110) + WRITE (out,120) NTIMES_MARSH +# endif +# ifdef MARSH_VERT_GROWTH +! WRITE(out,130) + WRITE(out,130) PAR_FAC1(ng) + WRITE(out,140) PAR_FAC2(ng) + WRITE(out,150) TDAYS_MARSH_GROWTH(ng) + WRITE (out,160) NUGP(ng) + WRITE (out,170) BMAX(ng) + WRITE (out,180) CHIREF(ng) +# ifdef MARSH_BIOMASS_VEG + WRITE (out,190) + WRITE (out,200) + WRITE (out,210) ALPHA_PDENS(ng), BETA_PDENS(ng), & + & ALPHA_PHGHT(ng), BETA_PHGHT(ng), & + & ALPHA_PDIAM(ng), BETA_PDIAM(ng) +# endif +# endif +#endif + END DO + ENDIF +! +!----------------------------------------------------------------------- +! Report output parameters (switched on in vegetation.in). +!----------------------------------------------------------------------- +! + 30 FORMAT (/,' read_VegPar - variable info not yet loaded, ',a) + 40 FORMAT (/,' read_VegPar - Error while processing line: ',/,a) +#if defined VEG_DRAG || defined VEG_BIOMASS + 50 FORMAT (/,/,' Vegetation Parameters, Grid: ',i2.2, & + & /, ' =====================================',/) + 60 FORMAT (/,1x,'Nveg(unitless)',2x,'Cd_veg(unitless)',2x, & + & 'E_veg(N/m2)',2x,'Veg_massdens(kg/m3)',2x,'VegHMixCoef'/) + 70 FORMAT (2x,i2,2(10x,1p,e11.4),2(5x,1p,e11.4)) +#endif +#ifdef MARSH_DYNAMICS + 80 FORMAT (/,/,' Marsh dynamics model Parameters, Grid: ',i2.2, & + & /, ' =====================================',/) +# if defined MARSH_SED_EROSION + 90 FORMAT ('Marsh erosion coefficient (s/m) = ',e11.3,/,a) +# if defined MARSH_RETREAT + 100 FORMAT ('Marsh scarp height (m) = ',e11.3,/,a) +# endif +! 110 FORMAT (1x,l1,2x,a,t29,a,i2.2,':',1x,a) +# endif +# ifdef MARSH_TIDAL_RANGE_CALC + 120 FORMAT ('Days after which MHW calc. starts = ', i4,/,a) +# endif +# ifdef MARSH_VERT_GROWTH + 130 FORMAT ('Parabolic growth factor 1 = ',e11.3,/,a) + 140 FORMAT ('Parabolic growth factor 2 = ',e11.3,/,a) + 150 FORMAT ('Number of growing days for marsh biomass = ',e11.3,/,a) +! 160 FORMAT ('Marsh organic sed. bulk density (kg/m3)= ',e11.3,/,a) +! 130 FORMAT (/,1x,'par_fac1',5x,'par_fac2',7x, & +! & 'tdays_marsh_growth(tdays)',3x,'marsh_bulk_dens(kg/m3)'/) +! 140 FORMAT ((1x,1p,e11.4),(2x,1p,e11.4),(5x,1p,e11.3),(5x,1p,e11.4)) + 160 FORMAT ('Fraction of below ground biomass = ',e11.3,/,a) + 170 FORMAT ('Peak biomass (kg/m2) = ',e11.3,/,a) + 180 FORMAT ('Fraction of recalcitrant Carbon = ',e11.3,/,a) +# ifdef MARSH_BIOMASS_VEG + 190 FORMAT (/,'Marsh vegetation growth parameters: ',/,a) + 200 FORMAT (/,2x,'alpha_pdens', 4x,'beta_pdens', & + & 4x, 'alpha_phght',4x,'beta_phght', & + & 4x,'alpha_pdiam', 4x,'beta_pdiam'/) + 210 FORMAT (6(3x,1p,e11.3)) +# endif +# endif +#endif + RETURN + END SUBROUTINE read_VegPar + diff --git a/ROMS/Nonlinear/Vegetation/vegetation_mod.h b/ROMS/Nonlinear/Vegetation/vegetation_mod.h new file mode 100644 index 00000000..809c7a15 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_mod.h @@ -0,0 +1,193 @@ +! +!git $Id$ +!================================================== Hernan G. Arango === +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license ! +! See License_ROMS.txt ! +!================================================= John C. Warner =====! +!================================================= Neil K. Ganju ======! +!================================================= Alexis Beudin ======! +!================================================= Tarandeep S. Kalra =! +!======================================================================= +! ! +! Vegetation Model Kernel Input Variables: ! +! ======================================= ! +! NVEG Number of vegetation types ! +! NVEGP Number of vegetation array properties ! +! CD_VEG Drag coefficient from each veg type ! +! E_VEG Youngs modulus from each veg type ! +! VEG_MASSDEN Mass density from each veg type ! +! VEGHMIXCOEF Viscosity coefficient from vegetation boundary ! +! ! +! Marsh Wave Induced Thrust Model Input Variables: ! +! =============================================== ! +! KFAC_MARSH Marsh sediment erodibility coefficient ! +! SCARP_HGHT Absolute change in scarp hght to convert marsh to ! +! open water cell (only to be used for high res. model) ! +! ! +! Marsh Vertical Growth Model Input Variables: ! +! =============================================== ! +! PAR_FAC1 Marsh parabolic curve growth parameter 1 ! +! PAR_FAC2 Marsh parabolic curve growth parameter 2 ! +!TDAYS_MARSH_GROWTH Growing number of days for marsh ! +! MARSH_BULK_DENS Bulk density for marsh organic sediment ! +! NUGP Fraction of below ground biomass ! +! BMAX Peak biomass ! +! CHIREF Fraction of recalcitrant Carbon ! +! ALPHA_PDENS Growth parameter 1 for marsh veg. density ! +! BETA_PDENS Growth parameter 2 for marsh veg. density ! +! ALPHA_PHGHT Growth parameter 1 for marsh veg. height ! +! BETA_PHGHT Growth parameter 2 for marsh veg. height ! +! ALPHA_PDIAM Growth parameter 1 for marsh veg. diameter ! +! BETA_PDIAM Growth parameter 2 for marsh veg. diameter ! +! ! +! Plant Property indices: ! +! ====================== ! +! pdens Density ! +! phght Height ! +! pdiam Diameter ! +! pthck Thickness ! +! ! +! Plant Property indices: ! +! ====================== ! +! idvprp Indices storing plant properties ! +! ! +! Plant Property Output IDs: ! +! ========================== ! +! ipdens Id to output plant density ! +! iphght Id to output plant height ! +! ipdiam Id to output plant diameter ! +! ipthck Id to output plant thickness ! +! ipupbm Id to output above ground biomass ! +! ipdwbm Id to output below ground biomass ! +! idWdvg Id to output wave dissipation from vegetation ! +! idCdvg Id to output spectral Cd from waves vegetation ! +! ! +! Marsh wave induced erosion Output: ! +! ========================== ! +! idTims Store masking marsh from marsh cells ! +! idTtot Total thrust from all directions due to waves ! +! idTmfo Marsh sediment flux from marsh cells ! +! idTmmr Amount of marsh retreat from all directions ! +! ! +! Marsh vertical growth model: ! +! ============================== ! +! idTmtr Mean tidal range (MHHW-MLLW) ! +! idTmhw Mean high high water (MHWW) ! +! idTmbp Below ground biomass for marsh growth ! +! idTmvg Rate of marsh vertical growth ! +! idTmvt Amount of marsh vertical growth ! +!======================================================================! +! ! + USE mod_param + USE mod_sediment +! + implicit none +! +#if defined VEG_DRAG || defined VEG_BIOMASS + integer :: NVEG, NVEGP + integer :: counter + integer :: phght, pdens, pdiam, pthck + integer :: ipdens, iphght, ipdiam, ipthck +#endif +! +#ifdef VEG_STREAMING + integer :: idWdvg, idCdvg +#endif +#if defined VEG_DRAG || defined VEG_BIOMASS + integer, allocatable :: idvprp(:) +#endif +! +#ifdef MARSH_DYNAMICS + integer :: idTims +# if defined MARSH_WAVE_THRUST + integer :: idTtot +# endif +# if defined MARSH_SED_EROSION + integer, allocatable :: idTmfo(:) +# endif +# if defined MARSH_RETREAT + integer :: idTmmr +# endif +# if defined MARSH_TIDAL_RANGE_CALC + integer :: NTIMES_MARSH + integer :: idTmtr +# endif +# if defined MARSH_VERT_GROWTH + integer :: idTmhw, idTmlw + integer :: idTmbp + integer :: idTmvg + integer :: idTmvt +# endif +#endif +! +#if defined VEG_DRAG || defined VEG_BIOMASS + real(r8), allocatable :: E_VEG(:,:) + real(r8), allocatable :: CD_VEG(:,:) + real(r8), allocatable :: VEG_MASSDENS(:,:) + real(r8), allocatable :: VEGHMIXCOEF(:,:) +#endif +! +#ifdef MARSH_DYNAMICS +# if defined MARSH_SED_EROSION + real(r8), allocatable :: KFAC_MARSH(:) +# if defined MARSH_RETREAT + real(r8), allocatable :: SCARP_HGHT(:) +# endif +# endif +# if defined MARSH_VERT_GROWTH + real(r8), allocatable :: PAR_FAC1(:), PAR_FAC2(:) + real(r8), allocatable :: TDAYS_MARSH_GROWTH(:) +! real(r8), allocatable :: MARSH_BULK_DENS(:) + real(r8), allocatable :: NUGP(:) + real(r8), allocatable :: BMAX(:) + real(r8), allocatable :: CHIREF(:) +# if defined MARSH_BIOMASS_VEG + real(r8), allocatable :: ALPHA_PDENS(:), BETA_PDENS(:) + real(r8), allocatable :: ALPHA_PHGHT(:), BETA_PHGHT(:) + real(r8), allocatable :: ALPHA_PDIAM(:), BETA_PDIAM(:) +# endif +# endif +#endif +! + CONTAINS +! + SUBROUTINE initialize_vegetation +! + USE mod_param + USE mod_sediment +! + implicit none +! +! Setup property indices +! +#if defined VEG_DRAG || defined VEG_BIOMASS + counter = 1 + pdens = counter + counter = counter+1 + phght = counter + counter = counter+1 + pdiam = counter + counter = counter+1 + pthck = counter +#endif +!#ifdef VEG_BIOMASS +! counter = counter+1 +! pabbm = counter +! counter = counter+1 +! pbgbm = counter +!#endif +#if defined VEG_DRAG || defined VEG_BIOMASS + NVEGP = counter + IF (.not.allocated(idvprp)) THEN + allocate ( idvprp(NVEGP) ) + END IF +#endif +#ifdef MARSH_DYNAMICS +# if defined MARSH_SED_EROSION + IF (.not.allocated(idTmfo)) THEN + allocate ( idTmfo(NST) ) + END IF +# endif +#endif + END SUBROUTINE initialize_vegetation diff --git a/ROMS/Nonlinear/Vegetation/vegetation_stream.F b/ROMS/Nonlinear/Vegetation/vegetation_stream.F new file mode 100644 index 00000000..c13a03d0 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_stream.F @@ -0,0 +1,167 @@ +#include "cppdefs.h" + + MODULE vegetation_stream_mod +#if defined VEGETATION && defined VEG_STREAMING +! +!git $Id$ +!======================================================================! +! Copyright (c) 2002-2019 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.txt Alexander F. Shchepetkin ! +!================================================John C. Warner========! +!================================================Neil K. Ganju =======! +!================================================Alexis Beudin =======! +!==============================================Tarandeep S. Kalra======! +! ! +! Calculates the effect of changes in current on waves due to ! +! the presence of vegetation. ! +! ! +!======================================================================! +! ! + implicit none + + PRIVATE + PUBLIC :: vegetation_stream_cal + + CONTAINS +! +!*********************************************************************** + SUBROUTINE vegetation_stream_cal (ng, tile) +!*********************************************************************** +! + USE mod_param + USE mod_forces + USE mod_grid + USE mod_vegarr +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL vegetation_stream_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & GRID(ng) % angler, & +# ifdef SOLVE3D + & GRID(ng) % z_w, & +# endif + & FORCES(ng) % Dwave, & + & FORCES(ng) % Lwave, & + & VEG(ng) % dissip_veg, & + & VEG(ng) % Lveg, & + & VEG(ng) % BWDXL_veg, & + & VEG(ng) % BWDYL_veg) + +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE vegetation_stream_cal + +!*********************************************************************** + SUBROUTINE vegetation_stream_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & angler, & +# ifdef SOLVE3D + & z_w, & +# endif + & Dwave, & + & Lwave, & + & dissip_veg, Lveg, & + & BWDXL_veg, BWDYL_veg) +!*********************************************************************** +! + USE mod_param + USE mod_grid + USE mod_scalars + USE mod_vegetation + USE mod_vegarr +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: angler(LBi:,LBj:) +# ifdef SOLVE3D + real(r8), intent(in) :: z_w(LBi:,LBj:,0:) +# endif + real(r8), intent(in) :: Lwave(LBi:,LBj:) + real(r8), intent(in) :: Dwave(LBi:,LBj:) + real(r8), intent(in) :: dissip_veg(LBi:,LBj:) + real(r8), intent(in) :: Lveg(LBi:,LBj:,:) + real(r8), intent(inout) :: BWDXL_veg(LBi:,LBj:,:) + real(r8), intent(inout) :: BWDYL_veg(LBi:,LBj:,:) +# else + real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj) +# ifdef SOLVE3D + real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,UBk) +# endif + real(r8), intent(in) :: Lwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Dwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: dissip_veg(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Lveg(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(inout) :: BWDXL_veg(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(inout) :: BWDYL_veg(LBi:UBi,LBj:UBj,N(ng)) +# endif + +! Local variable declarations. +! + integer :: i, j, k, iveg + real(r8) :: cff1, cff2 + real(r8) :: EWD_veg + real(r8), parameter :: Lwave_min = 1.0_r8 + + real(r8) :: Dstp + real(r8) :: waven, wavenx, waveny + real(r8) :: sigma, osigma + +# include "set_bounds.h" +! +!---------------------------------------------------------------------- +!----------Executing the code------------------------------------------ +!---------------------------------------------------------------------- +! + DO k=1,N(ng) + DO j=Jstr,Jend + DO i=Istr,Iend + Dstp=z_w(i,j,N(ng))-z_w(i,j,0) +! +!---------------------------------------------------------------------- +! Compute wave amplitude (0.5*Hrms), wave number, intrinsic frequency. +!---------------------------------------------------------------------- +! + waven=2.0_r8*pi/MAX(Lwave(i,j),Lwave_min) + cff1=1.5_r8*pi-Dwave(i,j)-angler(i,j) + wavenx=waven*COS(cff1) + waveny=waven*SIN(cff1) + sigma=MIN(SQRT(g*waven*TANH(waven*Dstp)),2.0_r8) + osigma=1.0_r8/sigma +! +!---------------------------------------------------------------------- +! Note: Alexis - check if we need a local dissip_veg here +! Also Lveg is for 1 veg type only +!---------------------------------------------------------------------- +! + EWD_veg=dissip_veg(i,j) + cff2=EWD_veg*osigma*Lveg(i,j,k) + BWDXL_veg(i,j,k)=cff2*wavenx + BWDYL_veg(i,j,k)=cff2*waveny +! + END DO + END DO + END DO +! + END SUBROUTINE vegetation_stream_tile +#endif + END MODULE vegetation_stream_mod diff --git a/ROMS/Nonlinear/Vegetation/vegetation_turb_cal.F b/ROMS/Nonlinear/Vegetation/vegetation_turb_cal.F new file mode 100644 index 00000000..ad5d98e4 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_turb_cal.F @@ -0,0 +1,259 @@ +#include "cppdefs.h" + + MODULE vegetation_turb_mod + +#if defined NONLINEAR && defined VEGETATION && defined VEG_TURB +! +!git $Id$ +!======================================================================! +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.txt ! +!==================================================== John C. Warner ==! +!==================================================== Neil K. Ganju ==! +!==================================================== Alexis Beudin ==! +!==================================================Tarandeep S. Kalra==! +! ! +! This routine computes the turbulent kinetic energy and length scale ! +! modifications due to vegetation for gls_corstep.F ! +! ! +! References: ! +! ! +! Uittenbogaard R. (2003): Modelling turbulence in vegetated aquatic ! +! flows. International workshop on RIParian FORest vegetated ! +! channels: hydraulic, morphological and ecological aspects, ! +! 20-22 February 2003, Trento, Italy. ! +! ! +! Warner J.C., C.R. Sherwood, H.G. Arango, and R.P. Signell (2005): ! +! Performance of four turbulence closure models implemented using a ! +! generic length scale method, Ocean Modelling 8: 81-113. ! +! ! +!======================================================================! +! ! + implicit none + + PRIVATE + PUBLIC :: vegetation_turb_cal + + CONTAINS +! +!*********************************************************************** + SUBROUTINE vegetation_turb_cal (ng, tile) +!*********************************************************************** +! + USE mod_stepping + USE mod_grid + USE mod_ocean + USE mod_param + USE mod_mixing + USE mod_vegarr + USE vegetation_drag_mod +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 16) +# endif + CALL vegetation_turb_tile ( ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp(ng), nnew(ng), & + & OCEAN(ng) % u, & + & OCEAN(ng) % v, & + & VEG(ng) % ru_loc_veg, & + & VEG(ng) % rv_loc_veg, & + & VEG(ng) % plant, & +# ifdef VEG_FLEX + & VEG(ng) % bend, & +# endif + & MIXING(ng) % gls, & + & MIXING(ng) % tke, & + & VEG(ng) % gls_veg, & + & VEG(ng) % tke_veg ) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 16) +# endif + RETURN + END SUBROUTINE vegetation_turb_cal +! +!*********************************************************************** + SUBROUTINE vegetation_turb_tile ( ng, tile, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & + & nstp, nnew, & + & u, v, & + & ru_loc_veg, rv_loc_veg, & + & plant, & +# ifdef VEG_FLEX + & bend, & +# endif + & gls, tke, & + & gls_veg, tke_veg ) +!*********************************************************************** +! + USE mod_param + USE mod_scalars + USE mod_vegetation + USE mod_vegarr + USE vegetation_drag_mod +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nstp, nnew +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: u(LBi:,LBj:,:,:) + real(r8), intent(in) :: v(LBi:,LBj:,:,:) + real(r8), intent(in) :: ru_loc_veg(LBi:,LBj:,:,:) + real(r8), intent(in) :: rv_loc_veg(LBi:,LBj:,:,:) + real(r8), intent(in) :: plant(LBi:,LBj:,:,:) +# ifdef VEG_FLEX + real(r8), intent(in) :: bend(LBi:,LBj:,:) +# endif + real(r8), intent(in) :: gls(LBi:,LBj:,0:,:) + real(r8), intent(in) :: tke(LBi:,LBj:,0:,:) + real(r8), intent(inout) :: gls_veg(LBi:,LBj:,0:) + real(r8), intent(inout) :: tke_veg(LBi:,LBj:,0:) +# else + real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),nstp) + real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),nstp) + real(r8), intent(in) :: ru_loc_veg(LBi:UBi,LBj:UBj,N(ng),NVEG) + real(r8), intent(in) :: rv_loc_veg(LBi:UBi,LBj:UBj,N(ng),NVEG) + real(r8), intent(in) :: plant(LBi:UBi,LBj:UBj,NVEG,NVEGP) +# ifdef VEG_FLEX + real(r8), intent(in) :: bend(LBi:UBi,LBj:UBj,NVEG) +# endif + real(r8), intent(in) :: gls(LBi:UBi,LBj:UBj,0:N(ng),nnew) + real(r8), intent(in) :: tke(LBi:UBi,LBj:UBj,0:N(ng),nnew) + real(r8), intent(inout) :: gls_veg(LBi:UBi,LBj:UBj,0:N(ng)) + real(r8), intent(inout) :: tke_veg(LBi:UBi,LBj:UBj,0:N(ng)) +# endif +! +! Local variable declarations. +! + integer :: i, j, k, iveg +! + real(r8), parameter :: one_half=1.0_r8/2.0_r8 + real(r8), parameter :: one_third=1.0_r8/3.0_r8 + real(r8), parameter :: Inival=0.0_r8 + real(r8), parameter :: cl_veg=1.0_r8, ck=0.09_r8 + real(r8), parameter :: max_L=10.0e10_r8 + real(r8), parameter :: min_eps=1.0e-12_r8 + real(r8), parameter :: max_eps=1.0e14_r8 + real(r8) :: wrku1, wrku2, wrku3, wrku4, wrku + real(r8) :: wrkv1, wrkv2, wrkv3, wrkv4, wrkv + real(r8) :: wrk, cff1, cff2, cff3, dissip, inverse_dissip + real(r8) :: solid, L, eqvegT + real(r8) :: taufree, tauveg, taueff + real(r8) :: tke_loc_veg, gls_loc_veg + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: vegu + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: vegv + +# include "set_bounds.h" +! + DO k=1,N(ng)-1 + DO j=Jstr,Jend + DO i=Istr,Iend + tke_veg(i,j,k)=Inival + gls_veg(i,j,k)=Inival + END DO + END DO + END DO + + cff1=3.0_r8+gls_p(ng)/gls_n(ng) + cff2=1.5_r8+gls_m(ng)/gls_n(ng) + cff3=-1.0_r8/gls_n(ng) + + VEG_LOOP: DO iveg=1,NVEG + DO k=1,N(ng)-1 + DO j=Jstr,Jend + DO i=Istr,Iend +! +!----------------------------------------------------------------------- +! Additional turbulence generated by the vegetation = +! work spent by the fluid against the plants (in m3/s3) +!----------------------------------------------------------------------- +! + wrku1=ru_loc_veg(i,j,k,iveg)*u(i,j,k,nstp) + wrku2=ru_loc_veg(i,j,k+1,iveg)*u(i,j,k+1,nstp) + wrku3=ru_loc_veg(i+1,j,k,iveg)*u(i+1,j,k,nstp) + wrku4=ru_loc_veg(i+1,j,k+1,iveg)*u(i+1,j,k+1,nstp) + wrku=0.25_r8*(wrku1+wrku2+wrku3+wrku4) + wrkv1=rv_loc_veg(i,j,k,iveg)*v(i,j,k,nstp) + wrkv2=rv_loc_veg(i,j,k+1,iveg)*v(i,j,k+1,nstp) + wrkv3=rv_loc_veg(i,j+1,k,iveg)*v(i,j+1,k,nstp) + wrkv4=rv_loc_veg(i,j+1,k+1,iveg)*v(i,j+1,k+1,nstp) + wrkv=0.25_r8*(wrkv1+wrkv2+wrkv3+wrkv4) + tke_loc_veg=sqrt(wrku*wrku+wrkv*wrkv) +! +!----------------------------------------------------------------------- +! Dissipation due to vegetation +!----------------------------------------------------------------------- +! Dissipation in GLS (Eq. 12 in Warner et al., 2005) +! + wrk=MAX(tke(i,j,k,nstp),gls_Kmin(ng)) + dissip=(gls_cmu0(ng)**cff1)*(wrk**cff2)* & + & (gls(i,j,k,nstp)**cff3) +! inverse_dissip=1.0_r8/MAX(dissip,min_eps) + inverse_dissip=MAX( (1.0_r8/dissip), max_eps) +! +! Dissipation time-scale for free turbulence +! + taufree=wrk*inverse_dissip +! +!# ifdef VEG_FLEX +! +! Equivalent thickness: horizontal projection of the bending plant +! +! eqvegT=plant(i,j,iveg,pthck)+sin(bend(i,j,iveg))* & +! & plant(i,j,iveg,phght) +!# else + eqvegT=plant(i,j,iveg,pthck) +!# endif +! +! +! Solidity:cross-sectional area of a plant the number of plants per m2 +! +! + solid=plant(i,j,iveg,pdiam)*eqvegT*plant(i,j,iveg,pdens) +! +! Eddies typical size constrained by distance in between the plants +! + L=cl_veg*((1.0_r8-MIN(solid,1.0_r8))/ & + & plant(i,j,iveg,pdens))**one_half + L=MIN(L,max_L) +! +! Dissipation time-scale of eddies in between the plants +! + cff2=MIN( (1.0_r8/(ck**2.0_r8*tke_loc_veg)), max_eps ) + tauveg=(L**2.0_r8*cff2)**one_third +! tauveg=(L**2.0_r8/(ck**2.0_r8*tke_loc_veg))**one_third +! +! Effective dissipation time-scale +! + taueff=MIN(taufree,tauveg) + gls_loc_veg=gls_c2(ng)*tke_loc_veg/taueff +! +!----------------------------------------------------------------------- +! Add the tke and gls changes from all vegetation types +!----------------------------------------------------------------------- +! + tke_veg(i,j,k)=tke_loc_veg + tke_veg(i,j,k) + gls_veg(i,j,k)=gls_loc_veg + gls_veg(i,j,k) + + END DO + END DO + END DO + END DO VEG_LOOP +! + RETURN + END SUBROUTINE vegetation_turb_tile +#endif + END MODULE vegetation_turb_mod diff --git a/ROMS/Nonlinear/Vegetation/vegetation_var.h b/ROMS/Nonlinear/Vegetation/vegetation_var.h new file mode 100644 index 00000000..0c8e34ca --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_var.h @@ -0,0 +1,98 @@ +/* +** git $Id$ +*************************************************** Hernan G. Arango *** +** Copyright (c) 2002-2024 The ROMS/TOMS Group ** +** Licensed under a MIT/X style license ** +** See License_ROMS.txt ** +*************************************************** John C. Warner ** +*************************************************** Neil K. Ganju ** +*************************************************** Alexis Beudin ** +*************************************************** Tarandeep S. Kalra** +** ** +** Assigns metadata indices for the vegetation module variables that ** +** are used in input and output NetCDF files. The metadata ** +** information is read from "varinfo.dat". ** +** ** +** This file is included in file "mod_ncparam.F", routine ** +** "initialize_ncparm". ** +** ** +************************************************************************ +*/ +#if defined VEG_DRAG || defined VEG_BIOMASS + CASE ('idvprp(pdens)') + idvprp(pdens)=varid + CASE ('idvprp(pdiam)') + idvprp(pdiam)=varid + CASE ('idvprp(pthck)') + idvprp(pthck)=varid + CASE ('idvprp(phght)') + idvprp(phght)=varid +!#if defined VEG_BIOMASS +! CASE ('idvprp(pabbm)') +! idvprp(pabbm)=varid +! CASE ('idvprp(pbgbm)') +! idvprp(pbgbm)=varid +!#endif +#endif +#if defined VEG_STREAMING + CASE ('idWdvg') + idWdvg=varid + CASE ('idCdvg') + idCdvg=varid +#endif +! +#if defined MARSH_DYNAMICS + CASE ('idTims') + idTims=varid +# if defined MARSH_WAVE_THRUST + CASE ('idTtot') + idTtot=varid +# endif +# if defined MARSH_SED_EROSION + CASE ('idTmfo') + load=.FALSE. + IF ((NST.gt.0).and. & + (Vinfo(1)(1:15).eq.'marsh_flux_out_')) THEN + varid=varid-1 + DO i=1,NST + varid=varid+1 + idTmfo(i)=varid + DO ng=1,Ngrids + Fscale(varid,ng)=scale + Iinfo(1,varid,ng)=gtype + END DO + WRITE (Vname(1,varid),'(a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(1))), i + WRITE (Vname(2,varid),'(a,a,i2.2)') & + & TRIM(ADJUSTL(Vinfo(2))), ', size class ', i + WRITE (Vname(3,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(3))) + WRITE (Vname(4,varid),'(a,a)') & + & TRIM(Vname(1,varid)), ', scalar, series' + WRITE (Vname(5,varid),'(a)') & + & TRIM(ADJUSTL(Vinfo(5))) + END DO + varid=varid+1 + END IF +# endif +# if defined MARSH_RETREAT + CASE ('idTmmr') + idTmmr=varid +# endif +# if defined MARSH_TIDAL_RANGE_CALC + CASE('idTmtr') + idTmtr=varid +# endif +# if defined MARSH_VERT_GROWTH + CASE('idTmhw') + idTmhw=varid + CASE('idTmlw') + idTmlw=varid + CASE('idTmbp') + idTmbp=varid + CASE('idTmvg') + idTmvg=varid + CASE('idTmvt') + idTmvt=varid +# endif +#endif diff --git a/ROMS/Nonlinear/Vegetation/vegetation_wrt_his.h b/ROMS/Nonlinear/Vegetation/vegetation_wrt_his.h new file mode 100644 index 00000000..d8e8a772 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_wrt_his.h @@ -0,0 +1,336 @@ +/* +** git $Id$ +*************************************************** Hernan G. Arango *** +** Copyright (c) 2002-2024 The ROMS/TOMS Group ** +** See License_ROMS.txt ** +*************************************************** John C. Warner ** +*************************************************** Neil K. Ganju ** +*************************************************** Alexis Beudin ** +*************************************************** Tarandeep S. Kalra** +** ** +** Writes vegetation input parameters into output NetCDF files. ** +** It is included in routine "wrt_his.F". ** +** ** +************************************************************************ +*/ +# if defined VEG_DRAG || defined VEG_BIOMASS +! +! Write out vegetation properties +! + DO i=1,NVEGP + IF (Hout(idvprp(i),ng)) THEN + scale=1.0_r8 + gtype=gfactor*r3dvar + status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, & + & HIS(ng)%Vid(idvprp(i)), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, NVEG, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng) % plant(:,:,:,i), & + & SetFillVal= .FALSE.) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idvprp(i))), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF + END DO +# endif +! +# ifdef VEG_STREAMING +! +! Write out wave dissipation due to vegetation +! + IF (Hout(idWdvg,ng)) THEN + scale=rho0 ! W m /kg to W/m2 +! scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWdvg), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%Dissip_veg) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdvg)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out spectral Cd due to vegetation. +! + IF (Hout(idCdvg,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idCdvg), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%Cdwave_veg) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idCdvg)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +! +# ifdef MARSH_DYNAMICS +! +! Write out masking for marsh cells. +! + IF (Hout(idTims,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTims), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_mask) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTims)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +# ifdef MARSH_WAVE_THRUST +! +! Write total thrust in all directions due to waves. +! + IF (Hout(idTtot,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTtot), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%Thrust_total) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTtot)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +! +# if defined MARSH_SED_EROSION +! +! Write out marsh sediment flux out from marsh cells from each sedclass. +! + DO i=1,NST + IF (Hout(idTmfo(i),ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & + & HIS(ng)%Vid(idTmfo(i)), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng) % marsh_flux_out(:,:,i)) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmfo(i))), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF + END DO +# endif +! +# if defined MARSH_RETREAT +! +! Amount of marsh lateral retreat from all directions. +! + IF (Hout(idTmmr,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmmr), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_retreat) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmmr)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +!# endif +! +# if defined MARSH_TIDAL_RANGE_CALC +! +! Write tidal range over a given frequency. +! + IF (Hout(idTmtr,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmtr), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_tidal_range) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmtr)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +! +# if defined MARSH_VERT_GROWTH +! +! Write mean high high water over a given frequency. +! + IF (Hout(idTmhw,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmhw), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_high_water) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmhw)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write mean low water over a given frequency. +! + IF (Hout(idTmlw,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmlw), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_low_water) + IF (FoundError(status, nf90_noerr, __LINE__, & + & __FILE__)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmlw)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write amount of marsh biomass peak. +! + IF (Hout(idTmbp,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmbp), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_biomass_peak) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmbp)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write rate of marsh vertical growth in m/year. +! + IF (Hout(idTmvg,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmvg), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_vert_rate) + IF (FoundError(status, nf90_noerr, __LINE__, & + & __FILE__)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmvg)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write amount of marsh vertical growth in m. +! + IF (Hout(idTmvt,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTmvt), & + & HIS(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_accret) + IF (FoundError(status, nf90_noerr, __LINE__, & + & __FILE__)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmvt)), HIS(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# endif diff --git a/ROMS/Nonlinear/Vegetation/vegetation_wrt_rst.h b/ROMS/Nonlinear/Vegetation/vegetation_wrt_rst.h new file mode 100644 index 00000000..694ffc93 --- /dev/null +++ b/ROMS/Nonlinear/Vegetation/vegetation_wrt_rst.h @@ -0,0 +1,194 @@ +/* +** git $Id$ +*************************************************** Hernan G. Arango *** +** Copyright (c) 2002-2024 The ROMS/TOMS Group ** +** See License_ROMS.txt ** +*************************************************** John C. Warner ** +*************************************************** Neil K. Ganju ** +*************************************************** Alexis Beudin ** +*************************************************** Tarandeep S. Kalra** +** ** +** Writes vegetation input parameters into output restart ** +** NetCDF files. ** +** It is included in routine "wrt_rst.F". ** +** ** +************************************************************************ +*/ +# if defined VEG_DRAG || defined VEG_BIOMASS +! +! Write out vegetation properties +! + DO i=1,NVEGP + IF (Hout(idvprp(i),ng)) THEN + scale=1.0_r8 + gtype=gfactor*r3dvar + status=nf_fwrite3d(ng, iNLM, RST(ng)%ncid, & + & RST(ng)%Vid(idvprp(i)), & + & RST(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, NVEG, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng) % plant(:,:,:,i)) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idvprp(i))), RST(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF + END DO +# endif +! +# ifdef VEG_STREAMING +! +! Write out wave dissipation due to vegetation +! + IF (Hout(idWdvg,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idWdvg), & + & RST(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%Dissip_veg ) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdvg)), RST(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out spectral Cd due to wave vegetation. +! + IF (Hout(idCdvg,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idCdvg), & + & RST(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%Cdwave_veg ) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idCdvg)), RST(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +! +# ifdef MARSH_DYNAMICS +! +! Store marsh masking from marsh cells. +! + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idTims), & + & RST(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_mask) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTims)), RST(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF +! END IF +# ifdef MARSH_WAVE_THRUST +! +! Write total thrust in all directions due to waves. +! +! IF (Hout(idTtot,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idTtot), & + & RST(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%Thrust_total) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTtot)), RST(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF +! END IF +! END DO +# endif +! +# if defined MARSH_SED_EROSION +! +! Write out marsh sediment flux out from marsh cells from each sedclass. +! + DO i=1,NST +! IF (Hout(idTmfo(i),ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, RST(ng)%ncid, & + & RST(ng)%Vid(idTmfo(i)), & + & RST(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng) % marsh_flux_out(:,:,i)) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmfo(i))), RST(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END DO +# endif +! +# ifdef MARSH_RETREAT +! +! Amount of marsh retreat from all directions. +! +! IF (Hout(idTmmr,ng)) THEN + scale=1.0_r8 + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, iNLM, RST(ng)%ncid, RST(ng)%Vid(idTmmr), & + & RST(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & VEG(ng)%marsh_retreat) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idTmmr)), RST(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF +! END IF +! +# endif +# endif +!# endif + diff --git a/ROMS/Nonlinear/gls_corstep.F b/ROMS/Nonlinear/gls_corstep.F index 8c998e10..50bcc642 100644 --- a/ROMS/Nonlinear/gls_corstep.F +++ b/ROMS/Nonlinear/gls_corstep.F @@ -43,6 +43,11 @@ SUBROUTINE gls_corstep (ng, tile) USE mod_mixing USE mod_ocean USE mod_stepping +# if defined VEGETATION && defined VEG_TURB + USE mod_vegarr + USE vegetation_turb_mod, ONLY : vegetation_turb_cal +# endif + ! ! Imported variable declarations. ! @@ -52,9 +57,17 @@ SUBROUTINE gls_corstep (ng, tile) ! character (len=*), parameter :: MyFile = & & __FILE__ -! # include "tile.h" ! +# if defined VEGETATION && defined VEG_TURB +! +!----------------------------------------------------------------------- +! Add the effect of vegetation on the turbulence model. +!----------------------------------------------------------------------- +! + CALL vegetation_turb_cal (ng, tile) +# endif + # ifdef PROFILE CALL wclock_on (ng, iNLM, 19, __LINE__, MyFile) # endif @@ -79,6 +92,10 @@ SUBROUTINE gls_corstep (ng, tile) & OCEAN(ng) % W, & # ifdef WEC_VF & OCEAN(ng) % W_stokes, & +# endif +# if defined VEGETATION && defined VEG_TURB + & VEG(ng) % tke_veg, & + & VEG(ng) % gls_veg, & # endif & FORCES(ng) % bustr, & & FORCES(ng) % bvstr, & @@ -119,6 +136,9 @@ SUBROUTINE gls_corstep_tile (ng, tile, & & u, v, W, & # ifdef WEC_VF & W_stokes, & +# endif +# if defined VEGETATION && defined VEG_TURB + & tke_veg, gls_veg, & # endif & bustr, bvstr, sustr, svstr, & # ifdef ZOS_HSIG @@ -166,6 +186,10 @@ SUBROUTINE gls_corstep_tile (ng, tile, & real(r8), intent(in) :: W(LBi:,LBj:,0:) # ifdef WEC_VF real(r8), intent(in) :: W_stokes(LBi:,LBj:,0:) +# endif +# if defined VEGETATION && defined VEG_TURB + real(r8), intent(in) :: tke_veg(LBi:,LBj:,0:) + real(r8), intent(in) :: gls_veg(LBi:,LBj:,0:) # endif real(r8), intent(in) :: bustr(LBi:,LBj:) real(r8), intent(in) :: bvstr(LBi:,LBj:) @@ -205,6 +229,10 @@ SUBROUTINE gls_corstep_tile (ng, tile, & real(r8), intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng)) # ifdef WEC_VF real(r8), intent(in) :: W_stokes(LBi:UBi,LBj:UBj,0:N(ng)) +# endif +# if defined VEGETATION && defined VEG_TURB + real(r8), intent(in) :: tke_veg(LBi:UBi,LBj:UBj,0:N(ng)) + real(r8), intent(in) :: gls_veg(LBi:UBi,LBj:UBj,0:N(ng)) # endif real(r8), intent(in) :: bustr(LBi:UBi,LBj:UBj) real(r8), intent(in) :: bvstr(LBi:UBi,LBj:UBj) @@ -240,6 +268,7 @@ SUBROUTINE gls_corstep_tile (ng, tile, & real(r8) :: Gh, Gm, Kprod, Ls_unlmt, Ls_lmt, Pprod, Sh, Sm real(r8) :: cff, cff1, cff2, cff3 real(r8) :: cmu_fac1, cmu_fac2, cmu_fac3, cmu_fac4 + real(r8) :: cmu, cmup, alphan, alpham real(r8) :: gls_c3, gls_exp1, gls_fac1, gls_fac2, gls_fac3 real(r8) :: gls_fac4, gls_fac5, gls_fac6, ql, sqrt2, strat2 real(r8) :: tke_exp1, tke_exp2, tke_exp3, tke_exp4, wall_fac @@ -777,6 +806,14 @@ SUBROUTINE gls_corstep_tile (ng, tile, & gls(i,j,k,nnew)=gls(i,j,k,nnew)+ & & dt(ng)*cff*Pprod*gls(i,j,k,nstp)/ & & MAX(tke(i,j,k,nstp),gls_Kmin(ng)) + +# if defined VEGETATION && defined VEG_TURB +! +! Add the effect of vegetation on tke and gls +! + tke(i,j,k,nnew)=tke(i,j,k,nnew)+dt(ng)*tke_veg(i,j,k) + gls(i,j,k,nnew)=gls(i,j,k,nnew)+dt(ng)*gls_veg(i,j,k) +# endif ! ! Compute dissipation of turbulent energy (m3/s3). ! @@ -840,7 +877,7 @@ SUBROUTINE gls_corstep_tile (ng, tile, & !----------------------------------------------------------------------- ! ! Set Dirichlet surface and bottom boundary conditions. Compute -! surface roughness from wind stress (Charnock) and set Craig and +! surface roughness from wind stress (Charnok) and set Craig and ! Banner wave breaking surface flux, if appropriate. ! DO i=Istr,Iend diff --git a/ROMS/Nonlinear/hmixing.F b/ROMS/Nonlinear/hmixing.F index badcdd36..d2a15336 100644 --- a/ROMS/Nonlinear/hmixing.F +++ b/ROMS/Nonlinear/hmixing.F @@ -58,6 +58,10 @@ SUBROUTINE hmixing (ng, tile) USE mod_mixing USE mod_ocean USE mod_stepping +# if defined VEGETATION && defined VEG_HMIXING + USE mod_vegarr + USE vegetation_hmixing_mod, ONLY:vegetation_hmixing_cal +# endif ! ! Imported variable declarations. ! @@ -67,9 +71,19 @@ SUBROUTINE hmixing (ng, tile) ! character (len=*), parameter :: MyFile = & & __FILE__ -! + # include "tile.h" ! +! +# if defined VEGETATION && defined VEG_HMIXING +! +!----------------------------------------------------------------------- +! Add the effect of vegetation on horizontal viscosity. +!----------------------------------------------------------------------- +! + CALL vegetation_hmixing_cal (ng, tile) +# endif +! # ifdef PROFILE CALL wclock_on (ng, iNLM, 28, __LINE__, MyFile) # endif @@ -106,6 +120,9 @@ SUBROUTINE hmixing (ng, tile) # else & MIXING(ng) % visc3d_r, & # endif +# endif +# if defined VEGETATION && defined VEG_HMIXING + & VEG(ng) % visc3d_r_veg, & # endif & OCEAN(ng) % u, & & OCEAN(ng) % v) @@ -141,6 +158,9 @@ SUBROUTINE hmixing_tile (ng, tile, & # else & visc3d_r, & # endif +# endif +# if defined VEGETATION && defined VEG_HMIXING + & visc3d_r_veg, & # endif & u, v) !*********************************************************************** @@ -198,7 +218,9 @@ SUBROUTINE hmixing_tile (ng, tile, & real(r8), intent(out) :: visc3d_r(LBi:,LBj:,:) # endif # endif - +# if defined VEGETATION && defined VEG_HMIXING + real(r8), intent(in) :: visc3d_r_veg(LBi:,LBj:,:) +# endif # else # ifdef MASKING @@ -237,6 +259,9 @@ SUBROUTINE hmixing_tile (ng, tile, & real(r8), intent(out) :: visc3d_r(LBi:UBi,LBj:UBj,N(ng)) # endif # endif +# if defined VEGETATION && defined VEG_HMIXING + real(r8), intent(in) :: visc3d_r_veg(LBi:UBi,LBj:UBj,N(ng)) +# endif # endif ! ! Local variable declarations. @@ -383,6 +408,31 @@ SUBROUTINE hmixing_tile (ng, tile, & END DO # endif +# if defined VEGETATION && defined VEG_HMIXING + + clip_scale=0.01_r8*grdmax(ng)**3 + + DO k=1,N(ng) + DO j=JstrV-1,Jend + DO i=IstrU-1,Iend +! +# if defined UV_VIS2 + visc3d_r(i,j,k)=visc3d_r(i,j,k)+visc3d_r_veg(i,j,k) +# elif defined UV_VIS4 + visc3d_r(i,j,k)=visc3d_r(i,j,k)+visc3d_r_veg(i,j,k) +# ifdef MIX_GEO_UV + visc3d_r(i,j,k)=MIN(clip_scale, visc3d_r(i,j,k)) +# endif + visc3d_r(i,j,k)=SQRT(visc3d_r(i,j,k)) +# endif +# ifdef MASKING + visc3d_r(i,j,k)=visc3d_r(i,j,k)*rmask(i,j) +# endif + END DO + END DO + END DO +# endif + # if defined TS_U3ADV_SPLIT ! !----------------------------------------------------------------------- diff --git a/ROMS/Nonlinear/ini_fields.F b/ROMS/Nonlinear/ini_fields.F index db12bbf2..c4c4998e 100644 --- a/ROMS/Nonlinear/ini_fields.F +++ b/ROMS/Nonlinear/ini_fields.F @@ -948,6 +948,7 @@ SUBROUTINE ini_zeta_tile (ng, tile, model, & END DO bed_thick(i,j,1)=bed_thick0(i,j) bed_thick(i,j,2)=bed_thick0(i,j) + bed_thick(i,j,3)=bed_thick0(i,j) END DO END DO ! diff --git a/ROMS/Nonlinear/initial.F b/ROMS/Nonlinear/initial.F index 85880ef9..de507b55 100644 --- a/ROMS/Nonlinear/initial.F +++ b/ROMS/Nonlinear/initial.F @@ -405,6 +405,20 @@ SUBROUTINE initial END DO #endif +#if defined ANA_VEGETATION && defined SOLVE3D +! +! Analytical initial conditions for vegetation types. +! + DO ng=1,Ngrids + IF (nrrec(ng).eq.0) THEN + DO tile=first_tile(ng),last_tile(ng),+1 + CALL ana_vegetation (ng, tile, iNLM) + END DO +!$OMP BARRIER + END IF + END DO +#endif + #if defined INI_FILE && !defined RBL4DVAR_FCT_SENSITIVITY ! ! Read in initial conditions from initial NetCDF file. diff --git a/ROMS/Nonlinear/main3d.F b/ROMS/Nonlinear/main3d.F index 2d23e141..a4a94ea9 100644 --- a/ROMS/Nonlinear/main3d.F +++ b/ROMS/Nonlinear/main3d.F @@ -106,6 +106,11 @@ SUBROUTINE main3d (RunInterval) USE obc_adjust_mod, ONLY : obc_adjust, load_obc # endif USE omega_mod, ONLY : omega +# if defined VEGETATION && defined MARSH_DYNAMICS + USE mod_vegetation + USE mod_vegarr + USE marsh_dynamics_mod, ONLY : marsh_dynamics +# endif USE post_initial_mod, ONLY : post_initial # ifndef TS_FIXED USE rho_eos_mod, ONLY : rho_eos @@ -1033,6 +1038,19 @@ SUBROUTINE main3d (RunInterval) !$OMP BARRIER END DO +# if defined VEGETATION && defined MARSH_DYNAMICS +! +!----------------------------------------------------------------------- +! Calculate marsh erosion due to wave thrust. +!----------------------------------------------------------------------- +! + DO ig=1,GridsInLayer(nl) + ng=GridNumber(ig,nl) + DO tile=first_tile(ng),last_tile(ng),+1 + CALL marsh_dynamics (ng, tile) + END DO + END DO +# endif # ifndef TS_FIXED ! !----------------------------------------------------------------------- diff --git a/ROMS/Nonlinear/rhs3d.F b/ROMS/Nonlinear/rhs3d.F index 7be909b7..2f16aea6 100644 --- a/ROMS/Nonlinear/rhs3d.F +++ b/ROMS/Nonlinear/rhs3d.F @@ -37,6 +37,9 @@ SUBROUTINE rhs3d (ng, tile) # endif USE mod_ocean USE mod_stepping +# ifdef VEGETATION + USE mod_vegarr +# endif ! USE pre_step3d_mod, ONLY : pre_step3d USE prsgrd_mod, ONLY : prsgrd @@ -60,6 +63,9 @@ SUBROUTINE rhs3d (ng, tile) USE wec_streaming_mod, ONLY : wec_streaming # endif # endif +# if defined VEGETATION && defined VEG_DRAG + USE vegetation_drag_mod, ONLY : vegetation_drag_cal +# endif ! ! Imported variable declarations. ! @@ -115,6 +121,16 @@ SUBROUTINE rhs3d (ng, tile) CALL t3dmix4 (ng, tile) # endif # endif + +# if defined VEGETATION && defined VEG_DRAG + +!----------------------------------------------------------------------- +! Add the effect of vegetation on the momentum terms. +!----------------------------------------------------------------------- +! + CALL vegetation_drag_cal (ng, tile) +# endif + ! !----------------------------------------------------------------------- ! Compute right-hand-side terms for the 3D momentum equations. @@ -152,6 +168,10 @@ SUBROUTINE rhs3d (ng, tile) & OCEAN(ng) % u, & & OCEAN(ng) % v, & & OCEAN(ng) % W, & +# if defined VEGETATION && defined VEG_DRAG + & VEG(ng) % ru_veg, & + & VEG(ng) % rv_veg, & +# endif # ifdef WEC & OCEAN(ng) % u_stokes, & & OCEAN(ng) % v_stokes, & @@ -209,6 +229,9 @@ SUBROUTINE rhs3d_tile (ng, tile, & & bustr, bvstr, & & sustr, svstr, & & u, v, W, & +# if defined VEGETATION && defined VEG_DRAG + & ru_veg, rv_veg, & +# endif # ifdef WEC & u_stokes, v_stokes, W_stokes, & & rustr3d, rvstr3d, & @@ -258,6 +281,10 @@ SUBROUTINE rhs3d_tile (ng, tile, & real(r8), intent(in) :: u(LBi:,LBj:,:,:) real(r8), intent(in) :: v(LBi:,LBj:,:,:) real(r8), intent(in) :: W(LBi:,LBj:,0:) +# if defined VEGETATION && defined VEG_DRAG + real(r8), intent(in) :: ru_veg(LBi:,LBj:,:) + real(r8), intent(in) :: rv_veg(LBi:,LBj:,:) +# endif # ifdef WEC real(r8), intent(in) :: u_stokes(LBi:,LBj:,:) real(r8), intent(in) :: v_stokes(LBi:,LBj:,:) @@ -302,6 +329,10 @@ SUBROUTINE rhs3d_tile (ng, tile, & real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2) real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2) real(r8), intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng)) +# if defined VEGETATION && defined VEG_DRAG + real(r8), intent(in) :: ru_veg(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(in) :: rv_veg(LBi:UBi,LBj:UBj,N(ng)) +# endif # ifdef WEC real(r8), intent(in) :: u_stokes(LBi:UBi,LBj:UBj,N(ng)) real(r8), intent(in) :: v_stokes(LBi:UBi,LBj:UBj,N(ng)) @@ -329,6 +360,7 @@ SUBROUTINE rhs3d_tile (ng, tile, & real(r8), parameter :: Gadv = -0.25_r8 real(r8) :: cff, cff1, cff2, cff3, cff4 + real(r8) :: cff5, cff6, cff7, cff8 real(r8) :: fac, fac1, fac2 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CF @@ -494,6 +526,36 @@ SUBROUTINE rhs3d_tile (ng, tile, & END DO END DO # endif +! +# if defined VEGETATION && defined VEG_DRAG +! +!----------------------------------------------------------------------- +! Resistance imposed on the flow by the submerged (seagrass) +! or emergent (marsh) vegetation. +!----------------------------------------------------------------------- +! + DO k=1,N(ng) +! Interpolate at cell face + DO j=Jstr,Jend + DO i=IstrU,Iend + cff=ru_veg(i,j,k)*om_u(i,j)*on_u(i,j) + ru(i,j,k,nrhs)=ru(i,j,k,nrhs)-cff +# ifdef DIAGNOSTICS_UV + DiaRU(i,j,k,nrhs,M3fveg)=-cff +# endif + END DO + END DO + DO j=JstrV,Jend + DO i=Istr,Iend + cff=rv_veg(i,j,k)*om_v(i,j)*on_v(i,j) + rv(i,j,k,nrhs)=rv(i,j,k,nrhs)-cff +# ifdef DIAGNOSTICS_UV + DiaRV(i,j,k,nrhs,M3fveg)=-cff +# endif + END DO + END DO + END DO +# endif ! K_LOOP : DO k=1,N(ng) @@ -1739,6 +1801,9 @@ SUBROUTINE rhs3d_tile (ng, tile, & DiaRUfrc(i,j,3,M2yvis)=0.0_r8 DiaRUfrc(i,j,3,M2hvis)=0.0_r8 # endif +# if defined VEGETATION && defined VEG_DRAG + DiaRUfrc(i,j,3,M2fveg)=DiaRU(i,j,1,nrhs,M3fveg) +# endif # ifdef BODYFORCE !! DiaRUfrc(i,j,3,M2strs)=DiaRU(i,j,1,nrhs,M3vvis) # endif @@ -1787,6 +1852,10 @@ SUBROUTINE rhs3d_tile (ng, tile, & DiaRUfrc(i,j,3,M2wbrk)=DiaRUfrc(i,j,3,M2wbrk)+ & & DiaRU(i,j,k,nrhs,M3wbrk) # endif +# if defined VEGETATION && defined VEG_DRAG + DiaRUfrc(i,j,3,M2fveg)=DiaRUfrc(i,j,3,M2fveg)+ & + & DiaRU(i,j,k,nrhs,M3fveg) +# endif # ifdef BODYFORCE !! DiaRUfrc(i,j,3,M2strs)=DiaRUfrc(i,j,3,M2strs)+ & !! & DiaRU(i,j,k,nrhs,M3vvis) @@ -1845,6 +1914,9 @@ SUBROUTINE rhs3d_tile (ng, tile, & DiaRVfrc(i,j,3,M2xvis)=0.0_r8 DiaRVfrc(i,j,3,M2yvis)=0.0_r8 # endif +# if defined VEGETATION && defined VEG_DRAG + DiaRVfrc(i,j,3,M2fveg)=DiaRV(i,j,1,nrhs,M3fveg) +# endif # ifdef BODYFORCE ! DiaRVfrc(i,j,3,M2strs)=DiaRV(i,j,1,nrhs,M3vvis) # endif @@ -1893,6 +1965,10 @@ SUBROUTINE rhs3d_tile (ng, tile, & DiaRVfrc(i,j,3,M2wbrk)=DiaRVfrc(i,j,3,M2wbrk)+ & & DiaRV(i,j,k,nrhs,M3wbrk) # endif +# if defined VEGETATION && defined VEG_DRAG + DiaRVfrc(i,j,3,M2fveg)=DiaRVfrc(i,j,3,M2fveg)+ & + & DiaRV(i,j,k,nrhs,M3fveg) +# endif # ifdef BODYFORCE !! DiaRVfrc(i,j,3,M2strs)=DiaRVfrc(i,j,3,M2strs)+ & !! & DiaRV(i,j,k,nrhs,M3vvis) diff --git a/ROMS/Nonlinear/step2d_LF_AM3.h b/ROMS/Nonlinear/step2d_LF_AM3.h index 548ceed3..6b2ba7eb 100644 --- a/ROMS/Nonlinear/step2d_LF_AM3.h +++ b/ROMS/Nonlinear/step2d_LF_AM3.h @@ -32,6 +32,14 @@ USE mod_ocean #if defined SEDIMENT && defined SED_MORPH && defined SOLVE3D USE mod_sedbed +#endif +#if defined VEGETATION && defined VEG_DRAG + USE mod_vegarr + USE vegetation_drag_mod, ONLY : vegetation_drag_cal +#endif +#if defined VEGETATION && defined VEG_HMIXING + USE mod_vegarr + USE vegetation_hmixing_mod, ONLY : vegetation_hmixing_cal #endif USE mod_stepping ! @@ -92,7 +100,13 @@ #if defined SEDIMENT && defined SED_MORPH & SEDBED(ng) % bed_thick, & #endif - +#if defined VEGETATION && defined VEG_DRAG + & VEG(ng) % step2d_uveg, & + & VEG(ng) % step2d_vveg, & +#endif +#if defined VEGETATION && defined VEG_HMIXING + & VEG(ng) % visc2d_r_veg, & +#endif #ifdef WEC # ifdef WEC_VF # ifdef WEC_ROLLER @@ -197,6 +211,12 @@ #if defined SEDIMENT && defined SED_MORPH & bed_thick, & #endif +#if defined VEGETATION && defined VEG_DRAG + & step2d_uveg, step2d_vveg, & +#endif +#if defined VEGETATION && defined VEG_HMIXING + & visc2d_r_veg, & +#endif #ifdef WEC # ifdef WEC_VF # ifdef WEC_ROLLER @@ -322,6 +342,13 @@ # if defined SEDIMENT && defined SED_MORPH real(r8), intent(in ) :: bed_thick(LBi:,LBj:,:) # endif +# if defined VEGETATION && defined VEG_DRAG + real(r8), intent(in) :: step2d_uveg(LBi:,LBj:) + real(r8), intent(in) :: step2d_vveg(LBi:,LBj:) +# endif +# if defined VEGETATION && defined VEG_HMIXING + real(r8), intent(in) :: visc2d_r_veg(LBi:,LBj:) +# endif # ifdef WEC # ifdef WEC_VF # ifdef WEC_ROLLER @@ -456,6 +483,13 @@ # if defined SEDIMENT && defined SED_MORPH real(r8), intent(in ) :: bed_thick(LBi:UBi,LBj:UBj,1:3) # endif +# if defined VEGETATION && defined VEG_DRAG + real(r8), intent(in) :: step2d_uveg(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: step2d_vveg(LBi:UBi,LBj:UBj) +# endif +# if defined VEGETATION && defined VEG_HMIXING + real(r8), intent(in) :: visc2d_r_veg(LBi:UBi,LBj:UBj) +# endif # ifdef WEC # ifdef WEC_VF # ifdef WEC_ROLLER @@ -2171,6 +2205,33 @@ END DO # endif #endif +#if defined VEGETATION && defined VEG_DRAG && defined SOLVE3D +! +!----------------------------------------------------------------------- +! Add in resistance imposed on the flow by the seagrass (3D->2D). +!----------------------------------------------------------------------- +! + DO j=Jstr,Jend + DO i=IstrU,Iend + cff3=2.0_r8/(Drhs(i-1,j)+Drhs(i,j)) + fac=step2d_uveg(i,j)*cff3*om_u(i,j)*on_u(i,j) + rhs_ubar(i,j)=rhs_ubar(i,j)-fac +# ifdef DIAGNOSTICS_UV + DiaU2rhs(i,j,M2fveg)=-fac +# endif + END DO + END DO + DO i=Istr,Iend + DO j=JstrV,Jend + cff3=2.0_r8/(Drhs(i-1,j)+Drhs(i,j)) + fac=step2d_vveg(i,j)*cff3*om_v(i,j)*on_v(i,j) + rhs_vbar(i,j)=rhs_vbar(i,j)-fac +# ifdef DIAGNOSTICS_UV + DiaV2rhs(i,j,M2fveg)=-fac +# endif + END DO + END DO +# endif ! !----------------------------------------------------------------------- ! Add in nudging of 2D momentum climatology. diff --git a/ROMS/Utility/checkdefs.F b/ROMS/Utility/checkdefs.F index af2488cb..205a2588 100644 --- a/ROMS/Utility/checkdefs.F +++ b/ROMS/Utility/checkdefs.F @@ -396,6 +396,12 @@ SUBROUTINE checkdefs is=LEN_TRIM(Coptions)+1 Coptions(is:is+14)=' ANA_SEDIMENT,' #endif +#if defined VEGETATION && defined ANA_VEGETATION + IF (Master) WRITE (stdout,20) 'ANA_VEGETATION', & + & 'Analytical vegetation initial conditions.' + is=LEN_TRIM(Coptions)+1 + Coptions(is:is+16)=' ANA_VEGETATION,' +#endif #ifdef ANA_SMFLUX ! IF (Master) WRITE (stdout,20) 'ANA_SMFLUX', & @@ -996,6 +1002,30 @@ SUBROUTINE checkdefs is=LEN_TRIM(Coptions)+1 Coptions(is:is+17)=' DIAGNOSTICS_BIO,' #endif +#if defined VEGETATION && defined VEG_DRAG + IF (Master) WRITE (stdout,20) 'VEGETATION', & + & 'Active submerged/emergent vegetation effects.' + is=LEN_TRIM(Coptions)+1 + Coptions(is:is+12)=' VEGETATION,' +#endif +#if defined VEGETATION && defined MARSH_WAVE_THRUST + IF (Master) WRITE (stdout,20) 'MARSH_WAVE_THRUST', & + & 'Vegetation module containing wave thrust effect on marshes' + is=LEN_TRIM(Coptions)+1 + Coptions(is:is+19)=' MARSH_WAVE_THRUST,' +#endif +#if defined VEGETATION && defined MARSH_VERT_GROWTH + IF (Master) WRITE (stdout,20) 'MARSH_VERT_GROWTH', & + & 'Vegetation module containing marsh vertical growth routines' + is=LEN_TRIM(Coptions)+1 + Coptions(is:is+19)=' MARSH_VERT_GROWTH,' +#endif +#if defined MARSH_BIOMASS_VEG + IF (Master) WRITE (stdout,20) 'MARSH_BIOMASS_VEG', & + & 'Marsh colonization and veg growth with organic sed. in Class 1' + is=LEN_TRIM(Coptions)+1 + Coptions(is:is+17)=' MARSH_BIOMASS_VEG' +#endif #ifdef DIAGNOSTICS_TS ! IF (Master) WRITE (stdout,20) 'DIAGNOSTICS_TS', & diff --git a/ROMS/Utility/def_his.F b/ROMS/Utility/def_his.F index a065d786..d96b2525 100644 --- a/ROMS/Utility/def_his.F +++ b/ROMS/Utility/def_his.F @@ -19,6 +19,10 @@ MODULE def_his_mod #ifdef BIOLOGY USE mod_biology #endif +#ifdef VEGETATION + USE mod_vegetation + USE mod_vegarr +#endif #ifdef FOUR_DVAR USE mod_fourdvar #endif @@ -140,6 +144,11 @@ SUBROUTINE def_his_nf90 (ng, model, ldef) # ifdef SEDIMENT integer :: b3dgrd(4) # endif +#if defined VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + integer :: v3pgrd(4) +# endif +#endif integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4) # ifdef ADJUST_BOUNDARY integer :: t3dobc(5) @@ -327,6 +336,14 @@ SUBROUTINE def_his_nf90 (ng, model, ldef) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN #endif +#if defined VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + status=def_dim(ng, iNLM, HIS(ng)%ncid, ncname, 'NVEG', & + & NVEG, DimIDs(35)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +# endif +#endif + #ifdef ADJUST_BOUNDARY status=def_dim(ng, model, HIS(ng)%ncid, ncname, 'obc_adjust', & & Nbrec(ng), DimIDs(31)) @@ -416,6 +433,17 @@ SUBROUTINE def_his_nf90 (ng, model, ldef) # endif #endif ! +! Define dimensions for the plant array variables +! +#ifdef VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + v3pgrd(1)=DimIDs( 1) + v3pgrd(2)=DimIDs( 5) + v3pgrd(3)=DimIDs(35) + v3pgrd(4)=DimIDs(12) +# endif +#endif +! ! Define dimension vectors for staggered v-momentum type variables. ! #if defined WRITE_WATER && defined MASKING @@ -1809,6 +1837,9 @@ SUBROUTINE def_his_nf90 (ng, model, ldef) END IF # endif #endif +#if defined VEGETATION +#include "vegetation_def_his.h" +#endif ! ! Define surface U-momentum stress. ! @@ -2218,6 +2249,16 @@ SUBROUTINE def_his_nf90 (ng, model, ldef) got_var(idVbms)=.TRUE. HIS(ng)%Vid(idVbms)=var_id(i) END IF +#if defined VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + DO itrc=1,NVEGP + IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idvprp(itrc)))) THEN + got_var(idvprp(itrc))=.TRUE. + HIS(ng)%Vid(idvprp(itrc))=var_id(i) + END IF + END DO +# endif +#endif #ifdef SOLVE3D DO itrc=1,NT(ng) IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idTvar(itrc)))) THEN @@ -2696,6 +2737,28 @@ SUBROUTINE def_his_nf90 (ng, model, ldef) END IF # endif END DO +# ifdef VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + DO i=1,NVEGP + IF (.not.got_var(idvprp(i)).and.Hout(idvprp(i),ng)) THEN + IF (Master) WRITE (stdout,70) TRIM(Vname(1,idvprp(i))), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + END DO +# endif +# endif +# ifdef SEDIMENT + DO i=1,NST + IF (.not.got_var(idfrac(i)).and.Hout(idfrac(i),ng)) THEN + IF (Master) WRITE (stdout,70) TRIM(Vname(1,idfrac(i))), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + END DO +# endif #endif #if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D @@ -2796,6 +2859,11 @@ SUBROUTINE def_his_pio (ng, model, ldef) # ifdef SEDIMENT integer :: b3dgrd(4) # endif +# if defined VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + integer :: v3pgrd(4) +# endif +# endif integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4) # ifdef ADJUST_BOUNDARY integer :: t3dobc(5) @@ -2973,6 +3041,13 @@ SUBROUTINE def_his_pio (ng, model, ldef) & Nfec, DimIDs(28)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif +# endif +# if defined VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + status=def_dim(ng, iNLM, HIS(ng)%pioFile, ncname, 'NVEG', & + & Nfec, DimIDs(35)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +# endif # endif status=def_dim(ng, model, HIS(ng)%pioFile, ncname, 'boundary', & @@ -3073,6 +3148,17 @@ SUBROUTINE def_his_pio (ng, model, ldef) u3dgrd(4)=DimIDs(12) # endif # endif +# ifdef VEGETATION +! +! Define dimensions for the plant array variables +! +# if defined VEG_DRAG || defined VEG_BIOMASS + v3pgrd(1)=DimIDs( 1) + v3pgrd(2)=DimIDs( 5) + v3pgrd(3)=DimIDs(35) + v3pgrd(4)=DimIDs(12) +# endif +# endif ! ! Define dimension vectors for staggered v-momentum type variables. ! diff --git a/ROMS/Utility/def_rst.F b/ROMS/Utility/def_rst.F index 8e106610..7afadc74 100644 --- a/ROMS/Utility/def_rst.F +++ b/ROMS/Utility/def_rst.F @@ -24,6 +24,10 @@ MODULE def_rst_mod #ifdef BIOLOGY USE mod_biology #endif +#ifdef VEGETATION + USE mod_vegetation + USE mod_vegarr +#endif #ifdef FOUR_DVAR USE mod_fourdvar #endif @@ -117,6 +121,18 @@ SUBROUTINE def_rst_nf90 (ng, model) integer :: sp2dgrd(3), sr2dgrd(3), su2dgrd(3), sv2dgrd(3) integer :: sr3dgrd(4), su3dgrd(4), sv3dgrd(4) integer :: t2dgrd(4), u2dgrd(4), v2dgrd(4) +#if defined VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + integer :: v3pgrd(4) +# endif +#endif + +#ifdef INWAVE_MODEL + integer :: r3degrd(4) + integer :: u3degrd(4) + integer :: v3degrd(4) + integer :: t3degrd(4) +#endif #ifdef SOLVE3D integer :: itrc @@ -278,6 +294,13 @@ SUBROUTINE def_rst_nf90 (ng, model) # endif # endif +# if defined VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + status=def_dim(ng, iNLM, RST(ng)%ncid, ncname, 'NVEG', & + & NVEG, DimIDs(35)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +# endif +# endif # ifdef ECOSIM status=def_dim(ng, model, RST(ng)%ncid, ncname, 'Nbands', & & NBands, DimIDs(33)) @@ -422,6 +445,15 @@ SUBROUTINE def_rst_nf90 (ng, model) # endif #endif ! +! Define dimensions for the plant array variables +! +# if defined VEG_DRAG || defined VEG_BIOMASS + v3pgrd(1)=DimIDs( 1) + v3pgrd(2)=DimIDs( 5) + v3pgrd(3)=DimIDs(35) + v3pgrd(4)=DimIDs(12) +# endif + ! Define dimension vectors for staggered v-momentum type variables. ! #if !defined PERFECT_RESTART && \ @@ -741,6 +773,11 @@ SUBROUTINE def_rst_nf90 (ng, model) & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN #endif +! +#if defined VEGETATION +#include "vegetation_def_rst.h" +#endif +! #if defined SEDIMENT && defined SED_MORPH ! ! Define time-varying bathymetry. @@ -1818,6 +1855,17 @@ SUBROUTINE def_rst_nf90 (ng, model) # endif #endif END DO +#if defined VEGETATION +# if defined VEG_DRAG || defined VEG_BIOMASS + DO i=1,NVEGP + IF (TRIM(var_name(i)).eq. & + & TRIM(Vname(1,idvprp(i)))) THEN + got_var(idvprp(i))=.TRUE. + RST(ng)%Vid(idvprp(i))=var_id(i) + END IF + END DO +# endif +#endif ! ! Check if initialization variables are available in input NetCDF ! file. diff --git a/ROMS/Utility/inp_par.F b/ROMS/Utility/inp_par.F index c026b490..88cebba2 100644 --- a/ROMS/Utility/inp_par.F +++ b/ROMS/Utility/inp_par.F @@ -539,6 +539,17 @@ SUBROUTINE inp_par (model) CALL read_StaPar (model, 55, out, Lwrite) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN #endif +! +#ifdef VEGETATION +! +!----------------------------------------------------------------------- +! Read in vegetation model input parameters. +!----------------------------------------------------------------------- +! + OPEN (65, FILE=TRIM(vegnam), FORM='formatted', STATUS='old') + + CALL read_VegPar (model, 65, out, Lwrite) +#endif #ifdef SOLVE3D ! !----------------------------------------------------------------------- diff --git a/ROMS/Utility/read_phypar.F b/ROMS/Utility/read_phypar.F index 16811b95..a66fd393 100644 --- a/ROMS/Utility/read_phypar.F +++ b/ROMS/Utility/read_phypar.F @@ -38,6 +38,9 @@ SUBROUTINE read_PhyPar (model, inp, out, Lwrite) USE mod_scalars #if defined SEDIMENT || defined BBL_MODEL USE mod_sediment +#endif +#if defined VEGETATION + USE mod_vegetation #endif USE mod_stepping #ifdef PROPAGATOR @@ -380,6 +383,9 @@ SUBROUTINE read_PhyPar (model, inp, out, Lwrite) #endif #if defined SEDIMENT || defined BBL_MODEL CALL initialize_sediment +#endif +#ifdef VEGETATION + CALL initialize_vegetation #endif CALL initialize_param ! Continue allocating/initalizing CALL allocate_scalars ! variables since the application @@ -3500,6 +3506,17 @@ SUBROUTINE read_PhyPar (model, inp, out, Lwrite) Dout(idDu3d(M3vjvf),ng)=Lswitch(ng) Dout(idDv3d(M3vjvf),ng)=Lswitch(ng) END DO + CASE ('Dout(M3hjvf)') + IF (M3hjvf.le.0) THEN + IF (Master) WRITE (out,280) 'M3hjvf' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Lswitch) + DO ng=1,Ngrids + Dout(idDu3d(M3hjvf),ng)=Lswitch(ng) + Dout(idDv3d(M3hjvf),ng)=Lswitch(ng) + END DO CASE ('Dout(M3kvrf)') IF (M3kvrf.le.0) THEN IF (Master) WRITE (out,280) 'M3kvrf' @@ -3619,6 +3636,30 @@ SUBROUTINE read_PhyPar (model, inp, out, Lwrite) Dout(idDu3d(M3vvis),ng)=Lswitch(ng) Dout(idDv3d(M3vvis),ng)=Lswitch(ng) END DO +# if defined VEGETATION && defined VEG_DRAG + CASE ('Dout(M3fveg)') + IF (M3fveg.le.0) THEN + IF (Master) WRITE (out,280) 'M3fveg' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Lswitch) + DO ng=1,Ngrids + Dout(idDu3d(M3fveg),ng)=Lswitch(ng) + Dout(idDv3d(M3fveg),ng)=Lswitch(ng) + END DO + CASE ('Dout(M2fveg)') + IF (M2fveg.le.0) THEN + IF (Master) WRITE (out,280) 'M2fveg' + exit_flag=5 + RETURN + END IF + Npts=load_l(Nval, Cval, Ngrids, Lswitch) + DO ng=1,Ngrids + Dout(idDu2d(M2fveg),ng)=Lswitch(ng) + Dout(idDv2d(M2fveg),ng)=Lswitch(ng) + END DO +# endif # endif #endif #if defined DIAGNOSTICS_TS && defined SOLVE3D @@ -4285,6 +4326,11 @@ SUBROUTINE read_PhyPar (model, inp, out, Lwrite) sparnam(i:i)=blank END DO sparnam=TRIM(ADJUSTL(Cval(Nval))) + CASE ('VEGNAM') + DO i=1,LEN(vegnam) + vegnam(i:i)=blank + END DO + vegnam=TRIM(ADJUSTL(Cval(Nval))) CASE ('USRNAME') DO i=1,LEN(USRname) USRname(i:i)=blank @@ -7733,6 +7779,15 @@ SUBROUTINE read_PhyPar (model, inp, out, Lwrite) & ' Biology Parameters File: ', TRIM(fname) END IF # endif +# ifdef VEGETATION + fname=vegnam + IF (.not.find_file(ng, out, fname, 'VEGNAM')) THEN + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + ELSE + IF (Master.and.Lwrite) WRITE (out,230) & + & ' Vegetation Parameters File: ', TRIM(fname) + END IF +# endif #endif fname=varname IF (.not.find_file(ng, out, fname, 'VARNAME')) THEN diff --git a/ROMS/Utility/read_vegpar.F b/ROMS/Utility/read_vegpar.F new file mode 100755 index 00000000..585241a2 --- /dev/null +++ b/ROMS/Utility/read_vegpar.F @@ -0,0 +1,19 @@ +#include "cppdefs.h" +#ifdef VEGETATION +!! +!!git $Id$ +!!================================================= Hernan G. Arango === +!! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +!! Licensed under a MIT/X style license ! +!! See License_ROMS.txt ! +!!====================================================================== +!! ! +!! This routine reads and reports vegetation model input parameters. ! +!! ! +!!====================================================================== +!! +# include +#else + SUBROUTINE read_vegpar + END SUBROUTINE read_vegpar +#endif diff --git a/ROMS/Utility/wrt_his.F b/ROMS/Utility/wrt_his.F index f5487505..9e46752c 100644 --- a/ROMS/Utility/wrt_his.F +++ b/ROMS/Utility/wrt_his.F @@ -39,6 +39,10 @@ MODULE wrt_his_mod #if defined SEDIMENT || defined BBL_MODEL USE mod_sedbed USE mod_sediment +#endif +#if defined VEGETATION + USE mod_vegetation + USE mod_vegarr #endif USE mod_stepping ! @@ -1895,6 +1899,9 @@ SUBROUTINE wrt_his_nf90 (ng, model, tile, & & Hout, HIS) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN #endif +#ifdef VEGETATION +#include "vegetation_wrt_his.h" +#endif #if defined ICE_MODEL && defined SOLVE3D !