diff --git a/cfgs/ORCA2_OFF_TRC/EXPREF/file_def_nemo-innerttrc.xml b/cfgs/ORCA2_OFF_TRC/EXPREF/file_def_nemo-innerttrc.xml
index 747e6cd31de566188e305adab97ded2242f55108..d1d25f865840fe17302211b34338375cd44bafc6 100644
--- a/cfgs/ORCA2_OFF_TRC/EXPREF/file_def_nemo-innerttrc.xml
+++ b/cfgs/ORCA2_OFF_TRC/EXPREF/file_def_nemo-innerttrc.xml
@@ -36,12 +36,23 @@
<field field_ref="ssh" name="zos" />
</file>
- <file id="file1" name_suffix="_trc" description="passive tracers variables" >
+ <file id="file2" name_suffix="_trc" description="passive tracers variables" >
<field field_ref="Age" name="Age" operation="average" freq_op="1y" > @Age_e3t / @e3t </field>
<field field_ref="CFC11" name="CFC11" operation="average" freq_op="1y" > @CFC11_e3t / @e3t </field>
<field field_ref="CFC12" name="CFC12" operation="average" freq_op="1y" > @CFC12_e3t / @e3t </field>
<field field_ref="SF6" name="SF6" operation="average" freq_op="1y" > @SF6_e3t / @e3t </field>
- <field field_ref="RC14" name="RC14" operation="average" freq_op="1y" > @RC14_e3t / @e3t </field>
+ <field field_ref="RC14" name="RC14" operation="average" freq_op="1y" > @RC14_e3t / @e3t </field>
+ <field field_ref="qtr_CFC11" />
+ <field field_ref="qint_CFC11" />
+ <field field_ref="qtr_CFC12" />
+ <field field_ref="qint_CFC12" />
+ <field field_ref="qtr_SF6" />
+ <field field_ref="qint_SF6" />
+ <field field_ref="qtr_c14" />
+ <field field_ref="qint_c14" />
+ <field field_ref="DeltaC14" />
+ <field field_ref="C14Age" />
+ <field field_ref="RAge" />
</file>
</file_group>
diff --git a/cfgs/SHARED/field_def_nemo-innerttrc.xml b/cfgs/SHARED/field_def_nemo-innerttrc.xml
index d54a667b23c34113463a49218fcfb8aa24c6e3dc..ccf4b8b587fb91ce660f84c3719b9ff543d9ecca 100644
--- a/cfgs/SHARED/field_def_nemo-innerttrc.xml
+++ b/cfgs/SHARED/field_def_nemo-innerttrc.xml
@@ -16,7 +16,7 @@
-->
- <field_group id="inerttrc" grid_ref="grid_T_2D">
+ <field_group id="inerttrc" grid_ref="grid_T_2D_inner">
<!-- CFC11 : variables available with ln_cfc11 -->
<field id="CFC11" long_name="Chlorofluoro carbon11 Concentration" unit="umol/m3" grid_ref="grid_T_3D" />
@@ -39,8 +39,8 @@
<!-- C14 : variables available with ln_c14 -->
<field id="RC14" long_name="Radiocarbon ratio" unit="-" grid_ref="grid_T_3D" />
<field id="RC14_e3t" long_name="RC14 * e3t" unit="m" grid_ref="grid_T_3D" > RC14 * e3t </field >
- <field id="DeltaC14" long_name="Delta C14" unit="permil" grid_ref="grid_T_3D" />
- <field id="C14Age" long_name="Radiocarbon age" unit="yr" grid_ref="grid_T_3D" />
+ <field id="DeltaC14" long_name="Delta C14" unit="permil" grid_ref="grid_T_3D_inner" />
+ <field id="C14Age" long_name="Radiocarbon age" unit="yr" grid_ref="grid_T_3D_inner" />
<field id="RAge" long_name="Reservoir Age" unit="yr" />
<field id="qtr_c14" long_name="Air-sea flux of C14" unit="1/m2/s" />
<field id="qint_c14" long_name="Cumulative air-sea flux of C14" unit="1/m2" />
@@ -52,7 +52,7 @@
<!-- AGE : variables available with ln_age -->
<field id="Age" long_name="Sea water age since surface contact" unit="yr" grid_ref="grid_T_3D" />
- <field id="Age_e3t" long_name="Age * e3t" unit="yr * m" grid_ref="grid_T_3D" > Age * e3t </field >
+ <field id="Age_e3t" long_name="Age * e3t" unit="yr * m" grid_ref="grid_T_3D" > Age * e3t </field >
</field_group>
diff --git a/cfgs/SHARED/field_def_nemo-pisces.xml b/cfgs/SHARED/field_def_nemo-pisces.xml
index 5ed5b7043bf43d7f5971c1f101fe2b2503cb1ea5..32ed08bc8f7070696025c03ac60bbac623606cad 100644
--- a/cfgs/SHARED/field_def_nemo-pisces.xml
+++ b/cfgs/SHARED/field_def_nemo-pisces.xml
@@ -172,113 +172,113 @@
<!-- PISCES additional diagnostics on T grid -->
- <field_group id="diad_T" grid_ref="grid_T_2D">
- <field id="PH" long_name="PH" unit="1" grid_ref="grid_T_3D" />
- <field id="CO3" long_name="Bicarbonates" unit="mol/m3" grid_ref="grid_T_3D" />
- <field id="CO3sat" long_name="CO3 saturation" unit="mol/m3" grid_ref="grid_T_3D" />
- <field id="PAR" long_name="Photosynthetically Available Radiation" unit="W/m2" grid_ref="grid_T_3D" />
- <field id="PPPHYN" long_name="Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PPPHYP" long_name="Primary production of picophyto" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PPPHYD" long_name="Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PPNEWN" long_name="New Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PPNEWP" long_name="New Primary production of picophyto" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PPNEWD" long_name="New Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PBSi" long_name="Primary production of Si diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PFeN" long_name="Primary production of nano iron" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PFeP" long_name="Primary production of pico iron" unit="molC/m3/s" grid_ref="grid_T_3D" />
- <field id="PFeD" long_name="Primary production of diatoms iron" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="xfracal" long_name="Calcifying fraction" unit="1" grid_ref="grid_T_3D" />
- <field id="PCAL" long_name="Calcite production" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="DCAL" long_name="Calcite dissolution" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="GRAZ1" long_name="Grazing by microzooplankton" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="GRAZ2" long_name="Grazing by mesozooplankton" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="REMIN" long_name="Oxic remineralization of OM" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="DENIT" long_name="Anoxic remineralization of OM" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="REMINP" long_name="Oxic remineralization rate of POC" unit="d-1" grid_ref="grid_T_3D" />
- <field id="REMING" long_name="Oxic remineralization rate of GOC" unit="d-1" grid_ref="grid_T_3D" />
- <field id="Nfix" long_name="Nitrogen fixation" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="Mumax" long_name="Maximum growth rate" unit="s-1" grid_ref="grid_T_3D" />
- <field id="MuN" long_name="Realized growth rate for nanophyto" unit="s-1" grid_ref="grid_T_3D" />
- <field id="MuP" long_name="Realized growth rate for picophyto" unit="s-1" grid_ref="grid_T_3D" />
- <field id="MuD" long_name="Realized growth rate for diatomes" unit="s-1" grid_ref="grid_T_3D" />
- <field id="MunetN" long_name="Net growth rate for nanophyto" unit="s-1" grid_ref="grid_T_3D" />
- <field id="MunetP" long_name="Net growth rate for picophyto" unit="s-1" grid_ref="grid_T_3D" />
- <field id="MunetD" long_name="Net growth rate for diatomes" unit="s-1" grid_ref="grid_T_3D" />
- <field id="LNnut" long_name="Nutrient limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" />
- <field id="LPnut" long_name="Nutrient limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" />
- <field id="LDnut" long_name="Nutrient limitation term in Diatoms" unit="" grid_ref="grid_T_3D" />
- <field id="LNFe" long_name="Iron limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" />
- <field id="LPFe" long_name="Iron limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" />
- <field id="LDFe" long_name="Iron limitation term in Diatoms" unit="" grid_ref="grid_T_3D" />
- <field id="LNlight" long_name="Light limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" />
- <field id="LPlight" long_name="Light limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" />
- <field id="LDlight" long_name="Light limitation term in Diatoms" unit="" grid_ref="grid_T_3D" />
- <field id="SIZEN" long_name="Mean relative size of nanophyto." unit="-" grid_ref="grid_T_3D" />
- <field id="SIZEP" long_name="Mean relative size of picophyto." unit="-" grid_ref="grid_T_3D" />
- <field id="SIZED" long_name="Mean relative size of diatoms" unit="-" grid_ref="grid_T_3D" />
- <field id="RASSD" long_name="Size of the protein machinery (Diat.)" unit="-" grid_ref="grid_T_3D" />
- <field id="RASSN" long_name="Size of the protein machinery (Nano.)" unit="-" grid_ref="grid_T_3D" />
- <field id="RASSP" long_name="Size of the protein machinery (Pico.)" unit="-" grid_ref="grid_T_3D" />
- <field id="Fe3" long_name="Iron III concentration" unit="nmol/m3" grid_ref="grid_T_3D" />
- <field id="FeL1" long_name="Complexed Iron concentration with L1" unit="nmol/m3" grid_ref="grid_T_3D" />
- <field id="TL1" long_name="Total L1 concentration" unit="nmol/m3" grid_ref="grid_T_3D" />
- <field id="pdust" long_name="dust concentration" unit="g/m3" />
- <field id="Totlig" long_name="Total ligand concentation" unit="nmol/m3" grid_ref="grid_T_3D" />
- <field id="Biron" long_name="Bioavailable iron" unit="nmol/m3" grid_ref="grid_T_3D" />
- <field id="Sdenit" long_name="Nitrate reduction in the sediments" unit="mol/m2/s" />
- <field id="Ironice" long_name="Iron input/uptake due to sea ice" unit="mol/m2/s" />
- <field id="SedCal" long_name="Calcite burial in the sediments" unit="molC/m2/s" />
- <field id="SedSi" long_name="Silicon burial in the sediments" unit="molSi/m2/s" />
- <field id="SedC" long_name="Organic C burial in the sediments" unit="molC/m2/s" />
- <field id="HYDR" long_name="Iron input from hydrothemal vents" unit="mol/m2/s" grid_ref="grid_T_3D" />
- <field id="EPC100" long_name="Export of carbon particles at 100 m" unit="mol/m2/s" />
- <field id="EPFE100" long_name="Export of biogenic iron at 100 m" unit="mol/m2/s" />
- <field id="EPSI100" long_name="Export of Silicate at 100 m" unit="mol/m2/s" />
- <field id="EPCAL100" long_name="Export of Calcite at 100 m" unit="mol/m2/s" />
- <field id="EXPC" long_name="Export of carbon" unit="mol/m2/s" grid_ref="grid_T_3D" />
- <field id="EXPFE" long_name="Export of biogenic iron" unit="mol/m2/s" grid_ref="grid_T_3D" />
- <field id="EXPSI" long_name="Export of Silicate" unit="mol/m2/s" grid_ref="grid_T_3D" />
- <field id="EXPCAL" long_name="Export of Calcite" unit="mol/m2/s" grid_ref="grid_T_3D" />
- <field id="Cflx" long_name="DIC flux" unit="mol/m2/s" />
- <field id="Oflx" long_name="Oxygen flux" unit="mol/m2/s" />
- <field id="Kg" long_name="Gas transfer" unit="mol/m2/s/uatm" />
- <field id="Dpco2" long_name="Delta CO2" unit="uatm" />
- <field id="pCO2sea" long_name="surface ocean pCO2" unit="uatm" />
- <field id="Dpo2" long_name="Delta O2" unit="uatm" />
- <field id="Heup" long_name="Euphotic layer depth" unit="m" />
- <field id="AtmCo2" long_name="Atmospheric CO2 concentration" unit="ppm" />
- <field id="Irondep" long_name="Iron deposition from dust" unit="mol/m2/s" />
- <field id="Ironsed" long_name="Iron deposition from sediment" unit="mol/m2/s" grid_ref="grid_T_3D" />
- <field id="FESCAV" long_name="Scavenging of Iron" unit="mmol-Fe/m3/s" grid_ref="grid_T_3D" />
- <field id="FECOLL" long_name="Colloidal Pumping of FeL" unit="mmol-FeL/m3/s" grid_ref="grid_T_3D" />
- <field id="LGWCOLL" long_name="Coagulation loss of ligands" unit="mmol-L/m3/s" grid_ref="grid_T_3D" />
- <field id="REMINF" long_name="Oxic remineralization suppy of Fe" unit="mmol-Fe/m3/s" grid_ref="grid_T_3D" />
- <field id="BACT" long_name="Bacterial Biomass" unit="mmol/m3" grid_ref="grid_T_3D" />
- <field id="FEBACT" long_name="Bacterial uptake of Fe" unit="molFe/m3/s" grid_ref="grid_T_3D" />
- <field id="FEPREC" long_name="Precipitation of Fe" unit="molFe/m3/s" grid_ref="grid_T_3D" />
- <field id="LPRODR" long_name="OM remineralisation ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D" />
- <field id="LPRODP" long_name="phytoplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D" />
- <field id="LIGREM" long_name="Remineralisation loss of ligands" unit="nmol-L/m3/s" grid_ref="grid_T_3D" />
- <field id="LIGPR" long_name="Photochemical loss of ligands" unit="nmol-L/m3/s" grid_ref="grid_T_3D" />
- <field id="LDETP" long_name="Ligand destruction during phytoplankton uptake" unit="nmol-L/m3/s" grid_ref="grid_T_3D" />
- <field id="LPRODZ2" long_name="mesozooplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D" />
- <field id="LPRODZ" long_name="microzooplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D" />
- <field id="FEZOO" long_name="microzooplankton iron recycling rate" unit="nmol-FeL/m3/s" grid_ref="grid_T_3D" />
- <field id="FEZOO2" long_name="mesozooplankton iron recycling rate" unit="nmol-FeL/m3/s" grid_ref="grid_T_3D" />
+ <field_group id="diad_T" grid_ref="grid_T_2D_inner" >
+ <field id="PH" long_name="PH" unit="1" grid_ref="grid_T_3D_inner" />
+ <field id="CO3" long_name="Bicarbonates" unit="mol/m3" grid_ref="grid_T_3D_inner" />
+ <field id="CO3sat" long_name="CO3 saturation" unit="mol/m3" grid_ref="grid_T_3D_inner" />
+ <field id="DCAL" long_name="Calcite dissolution" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PAR" long_name="Photosynthetically Available Radiation" unit="W/m2" grid_ref="grid_T_3D_inner" />
+ <field id="PPPHYN" long_name="Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PPPHYP" long_name="Primary production of picophyto" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PPPHYD" long_name="Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PPNEWN" long_name="New Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PPNEWP" long_name="New Primary production of picophyto" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PPNEWD" long_name="New Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PBSi" long_name="Primary production of Si diatoms" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PFeN" long_name="Primary production of nano iron" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PFeP" long_name="Primary production of pico iron" unit="molC/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="PFeD" long_name="Primary production of diatoms iron" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="xfracal" long_name="Calcifying fraction" unit="1" grid_ref="grid_T_3D_inner" />
+ <field id="PCAL" long_name="Calcite production" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="GRAZ1" long_name="Grazing by microzooplankton" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="GRAZ2" long_name="Grazing by mesozooplankton" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="REMIN" long_name="Oxic remineralization of OM" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="DENIT" long_name="Anoxic remineralization of OM" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="REMINP" long_name="Oxic remineralization rate of POC" unit="d-1" grid_ref="grid_T_3D_inner" />
+ <field id="REMING" long_name="Oxic remineralization rate of GOC" unit="d-1" grid_ref="grid_T_3D_inner" />
+ <field id="Nfix" long_name="Nitrogen fixation" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="Mumax" long_name="Maximum growth rate" unit="s-1" grid_ref="grid_T_3D_inner" />
+ <field id="MuN" long_name="Realized growth rate for nanophyto" unit="s-1" grid_ref="grid_T_3D_inner" />
+ <field id="MuP" long_name="Realized growth rate for picophyto" unit="s-1" grid_ref="grid_T_3D_inner" />
+ <field id="MuD" long_name="Realized growth rate for diatomes" unit="s-1" grid_ref="grid_T_3D_inner" />
+ <field id="MunetN" long_name="Net growth rate for nanophyto" unit="s-1" grid_ref="grid_T_3D_inner" />
+ <field id="MunetP" long_name="Net growth rate for picophyto" unit="s-1" grid_ref="grid_T_3D_inner" />
+ <field id="MunetD" long_name="Net growth rate for diatomes" unit="s-1" grid_ref="grid_T_3D_inner" />
+ <field id="LNnut" long_name="Nutrient limitation term in Nanophyto" unit="" grid_ref="grid_T_3D_inner" />
+ <field id="LPnut" long_name="Nutrient limitation term in Picophyto" unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="LDnut" long_name="Nutrient limitation term in Diatoms" unit="" grid_ref="grid_T_3D_inner" />
+ <field id="LNFe" long_name="Iron limitation term in Nanophyto" unit="" grid_ref="grid_T_3D_inner" />
+ <field id="LPFe" long_name="Iron limitation term in Picophyto" unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="LDFe" long_name="Iron limitation term in Diatoms" unit="" grid_ref="grid_T_3D_inner" />
+ <field id="LNlight" long_name="Light limitation term in Nanophyto" unit="" grid_ref="grid_T_3D_inner" />
+ <field id="LPlight" long_name="Light limitation term in Picophyto" unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="LDlight" long_name="Light limitation term in Diatoms" unit="" grid_ref="grid_T_3D_inner" />
+ <field id="SIZEN" long_name="Mean relative size of nanophyto." unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="SIZEP" long_name="Mean relative size of picophyto." unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="SIZED" long_name="Mean relative size of diatoms" unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="RASSD" long_name="Size of the protein machinery (Diat.)" unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="RASSN" long_name="Size of the protein machinery (Nano.)" unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="RASSP" long_name="Size of the protein machinery (Pico.)" unit="-" grid_ref="grid_T_3D_inner" />
+ <field id="Fe3" long_name="Iron III concentration" unit="nmol/m3" grid_ref="grid_T_3D_inner" />
+ <field id="FeL1" long_name="Complexed Iron concentration with L1" unit="nmol/m3" grid_ref="grid_T_3D_inner" />
+ <field id="TL1" long_name="Total L1 concentration" unit="nmol/m3" grid_ref="grid_T_3D_inner" />
+ <field id="pdust" long_name="dust concentration" unit="g/m3" />
+ <field id="Totlig" long_name="Total ligand concentation" unit="nmol/m3" grid_ref="grid_T_3D_inner" />
+ <field id="Biron" long_name="Bioavailable iron" unit="nmol/m3" grid_ref="grid_T_3D_inner" />
+ <field id="Sdenit" long_name="Nitrate reduction in the sediments" unit="mol/m2/s" />
+ <field id="Ironice" long_name="Iron input/uptake due to sea ice" unit="mol/m2/s" />
+ <field id="SedCal" long_name="Calcite burial in the sediments" unit="molC/m2/s" />
+ <field id="SedSi" long_name="Silicon burial in the sediments" unit="molSi/m2/s" />
+ <field id="SedC" long_name="Organic C burial in the sediments" unit="molC/m2/s" />
+ <field id="HYDR" long_name="Iron input from hydrothemal vents" unit="mol/m2/s" grid_ref="grid_T_3D_inner" />
+ <field id="EPC100" long_name="Export of carbon particles at 100 m" unit="mol/m2/s" />
+ <field id="EPFE100" long_name="Export of biogenic iron at 100 m" unit="mol/m2/s" />
+ <field id="EPSI100" long_name="Export of Silicate at 100 m" unit="mol/m2/s" />
+ <field id="EPCAL100" long_name="Export of Calcite at 100 m" unit="mol/m2/s" />
+ <field id="EXPC" long_name="Export of carbon" unit="mol/m2/s" grid_ref="grid_T_3D_inner" />
+ <field id="EXPFE" long_name="Export of biogenic iron" unit="mol/m2/s" grid_ref="grid_T_3D_inner" />
+ <field id="EXPSI" long_name="Export of Silicate" unit="mol/m2/s" grid_ref="grid_T_3D_inner" />
+ <field id="EXPCAL" long_name="Export of Calcite" unit="mol/m2/s" grid_ref="grid_T_3D_inner" />
+ <field id="Cflx" long_name="DIC flux" unit="mol/m2/s" />
+ <field id="Oflx" long_name="Oxygen flux" unit="mol/m2/s" />
+ <field id="Kg" long_name="Gas transfer" unit="mol/m2/s/uatm" />
+ <field id="Dpco2" long_name="Delta CO2" unit="uatm" />
+ <field id="pCO2sea" long_name="surface ocean pCO2" unit="uatm" />
+ <field id="Dpo2" long_name="Delta O2" unit="uatm" />
+ <field id="Heup" long_name="Euphotic layer depth" unit="m" grid_ref="grid_T_2D_inner" />
+ <field id="AtmCo2" long_name="Atmospheric CO2 concentration" unit="ppm" />
+ <field id="Irondep" long_name="Iron deposition from dust" unit="mol/m2/s" />
+ <field id="Ironsed" long_name="Iron deposition from sediment" unit="mol/m2/s" grid_ref="grid_T_3D_inner" />
+ <field id="FESCAV" long_name="Scavenging of Iron" unit="mmol-Fe/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="FECOLL" long_name="Colloidal Pumping of FeL" unit="mmol-FeL/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="LGWCOLL" long_name="Coagulation loss of ligands" unit="mmol-L/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="REMINF" long_name="Oxic remineralization suppy of Fe" unit="mmol-Fe/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="BACT" long_name="Bacterial Biomass" unit="mmol/m3" grid_ref="grid_T_3D_inner" />
+ <field id="FEBACT" long_name="Bacterial uptake of Fe" unit="molFe/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="FEPREC" long_name="Precipitation of Fe" unit="molFe/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="LPRODR" long_name="OM remineralisation ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="LPRODP" long_name="phytoplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="LIGREM" long_name="Remineralisation loss of ligands" unit="nmol-L/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="LIGPR" long_name="Photochemical loss of ligands" unit="nmol-L/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="LDETP" long_name="Ligand destruction during phytoplankton uptake" unit="nmol-L/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="LPRODZ2" long_name="mesozooplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="LPRODZ" long_name="microzooplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="FEZOO" long_name="microzooplankton iron recycling rate" unit="nmol-FeL/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="FEZOO2" long_name="mesozooplankton iron recycling rate" unit="nmol-FeL/m3/s" grid_ref="grid_T_3D_inner" />
<!-- PISCES tracers trends -->
- <field id="INTdtAlk" long_name="Vertically int. of change of alkalinity" unit="mol/m2/s" />
- <field id="INTdtDIC" long_name="Vertically int. of change of dissic " unit="mol/m2/s" />
- <field id="INTdtFer" long_name="Vertically int. of change of iron " unit="mol/m2/s" />
- <field id="INTdtDIN" long_name="Vertically int. of change of nitrogen " unit="mol/m2/s" />
- <field id="INTdtDIP" long_name="Vertically int. of change of phophate " unit="mol/m2/s" />
- <field id="INTdtSil" long_name="Vertically int. of change of silicon " unit="mol/m2/s" />
+ <field id="INTdtAlk" long_name="Vertically int. of change of alkalinity" unit="mol/m2/s" />
+ <field id="INTdtDIC" long_name="Vertically int. of change of dissic " unit="mol/m2/s" />
+ <field id="INTdtFer" long_name="Vertically int. of change of iron " unit="mol/m2/s" />
+ <field id="INTdtDIN" long_name="Vertically int. of change of nitrogen " unit="mol/m2/s" />
+ <field id="INTdtDIP" long_name="Vertically int. of change of phophate " unit="mol/m2/s" />
+ <field id="INTdtSil" long_name="Vertically int. of change of silicon " unit="mol/m2/s" />
<!-- dbio_T on T grid : variables available with diaar5 -->
- <field id="TPP" long_name="Total Primary production of phyto" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="TPNEW" long_name="New Primary production of phyto" unit="mol/m3/s" grid_ref="grid_T_3D" />
- <field id="TPBFE" long_name="Total biogenic iron production" unit="mol/m3/s" grid_ref="grid_T_3D" />
+ <field id="TPP" long_name="Total Primary production of phyto" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="TPNEW" long_name="New Primary production of phyto" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
+ <field id="TPBFE" long_name="Total biogenic iron production" unit="mol/m3/s" grid_ref="grid_T_3D_inner" />
<field id="INTDIC" long_name="DIC content" unit="kg/m2" />
<field id="O2MIN" long_name="Oxygen minimum concentration" unit="mol/m3" />
<field id="ZO2MIN" long_name="Depth of oxygen minimum concentration" unit="m" />
@@ -292,9 +292,9 @@
<field id="INTPBSI" long_name="Vertically integrated of biogenic Si production" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > PBSi * e3t </field >
<!-- PISCES light : variables available with key_pisces_reduced -->
- <field id="FNO3PHY" long_name="FNO3PHY" unit="" grid_ref="grid_T_3D" />
- <field id="FNH4PHY" long_name="FNH4PHY" unit="" grid_ref="grid_T_3D" />
- <field id="FNH4NO3" long_name="FNH4NO3" unit="" grid_ref="grid_T_3D" />
+ <field id="FNO3PHY" long_name="FNO3PHY" unit="" grid_ref="grid_T_3D_inner" />
+ <field id="FNH4PHY" long_name="FNH4PHY" unit="" grid_ref="grid_T_3D_inner" />
+ <field id="FNH4NO3" long_name="FNH4NO3" unit="" grid_ref="grid_T_3D_inner" />
<field id="TNO3PHY" long_name="TNO3PHY" unit="" />
<field id="TNH4PHY" long_name="TNH4PHY" unit="" />
<field id="TPHYDOM" long_name="TPHYDOM" unit="" />
diff --git a/src/OCE/IOM/iom.F90 b/src/OCE/IOM/iom.F90
index 49433e40e524b91b51945c9ccf365502c1e1a0d9..7a102477ce167f8d6c8938337c47de03acd04eb4 100644
--- a/src/OCE/IOM/iom.F90
+++ b/src/OCE/IOM/iom.F90
@@ -1207,6 +1207,8 @@ CONTAINS
!---------------------------------------------------------------------
CHARACTER(LEN=lc) :: context
!
+ ! CE : llok must be initialised otherwise the model crash in debug mode
+ llok = .TRUE.
CALL set_xios_context(kiomid, context)
inlev = -1
IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3)
diff --git a/src/TOP/AGE/trcsms_age.F90 b/src/TOP/AGE/trcsms_age.F90
index a8283edf6df534771cbac7aaa40fa40946b6f4e1..cbf3b61a41428132fb2a994fbe66db6ba2defc23 100644
--- a/src/TOP/AGE/trcsms_age.F90
+++ b/src/TOP/AGE/trcsms_age.F90
@@ -46,7 +46,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time-step index
INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level
- INTEGER :: jn, jk ! dummy loop index
+ INTEGER :: jk ! dummy loop index
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_sms_age')
@@ -74,7 +74,7 @@ CONTAINS
tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear
END DO
!
- IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends
+ IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jp_age, jptra_sms, kt, Kmm ) ! save trends
!
IF( ln_timing ) CALL timing_stop('trc_sms_age')
!
diff --git a/src/TOP/AGE/trcwri_age.F90 b/src/TOP/AGE/trcwri_age.F90
index 98b7c6863ed6ba0d6eac44a892864fc0a6980dc3..3df7b3e7e99e766d7d7f4bd5f7f57555bbfb9998 100644
--- a/src/TOP/AGE/trcwri_age.F90
+++ b/src/TOP/AGE/trcwri_age.F90
@@ -28,7 +28,6 @@ CONTAINS
!!---------------------------------------------------------------------
INTEGER, INTENT(in) :: Kmm ! time level indices
CHARACTER (len=20) :: cltra
- INTEGER :: jn
!!---------------------------------------------------------------------
! write the tracer concentrations in the file
diff --git a/src/TOP/C14/sms_c14.F90 b/src/TOP/C14/sms_c14.F90
index bdea777651132bc10a238c54f572e344b5614de7..a9971f6a2c4a2bb6d957d9c82bc53fcbba36f99d 100644
--- a/src/TOP/C14/sms_c14.F90
+++ b/src/TOP/C14/sms_c14.F90
@@ -51,6 +51,8 @@ MODULE sms_c14
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: spco2 ! Atmospheric CO2
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: tyrco2 ! Time (yr) atmospheric CO2 data
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: sms_c14.F90 10071 2018-08-28 14:49:04Z nicolasmartin $
@@ -64,9 +66,9 @@ CONTAINS
!! *** ROUTINE trc_sms_c14_alloc ***
!!----------------------------------------------------------------------
sms_c14_alloc = 0
- ALLOCATE( exch_c14(jpi,jpj) , exch_co2(jpi,jpj) , &
- & qtr_c14(jpi,jpj) , qint_c14(jpi,jpj) , &
- & c14sbc(jpi,jpj) , STAT = sms_c14_alloc )
+ ALLOCATE( exch_c14(A2D(0)) , exch_co2(A2D(0)) , &
+ & qtr_c14(A2D(0)) , qint_c14(A2D(0)) , &
+ & c14sbc(A2D(0)) , STAT = sms_c14_alloc )
!
!
END FUNCTION sms_c14_alloc
diff --git a/src/TOP/C14/trcatm_c14.F90 b/src/TOP/C14/trcatm_c14.F90
index 54a768067d674bf9b1bdd44bb6a9b5d092a9dd9f..d09dcf5df473af5308d9ba09e79ffa06a97caa53 100644
--- a/src/TOP/C14/trcatm_c14.F90
+++ b/src/TOP/C14/trcatm_c14.F90
@@ -59,6 +59,13 @@ CONTAINS
!
tyrc14_now = 0._wp ! initialize
!
+ IF( kc14typ == 0) THEN
+ co2sbc=pco2at
+ DO_2D( 0, 0, 0, 0 )
+ c14sbc(ji,jj) = rc14at
+ END_2D
+ ENDIF
+ !
IF(kc14typ >= 1) THEN ! Transient atmospheric forcing: CO2
!
clfile = TRIM( cfileco2 )
@@ -116,10 +123,10 @@ CONTAINS
! Linear interpolation of the C-14 source fonction
! in linear latitude bands (20N,40N) and (20S,40S)
!------------------------------------------------------
- ALLOCATE( fareaz (jpi,jpj ,nc14zon) , STAT=ierr3 )
+ ALLOCATE( fareaz(A2D(0) ,nc14zon) , STAT=ierr3 )
IF( ierr3 /= 0 ) CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' )
!
- DO_2D( 1, 1, 1, 1 ) ! from C14b package
+ DO_2D( 0, 0, 0, 0 ) ! from C14b package
IF( gphit(ji,jj) >= yn40 ) THEN
fareaz(ji,jj,1) = 0.
fareaz(ji,jj,2) = 0.
@@ -205,9 +212,9 @@ CONTAINS
!! ** Action : atmospheric values interpolated at time-step kt
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step
- REAL(wp), DIMENSION(:,:), INTENT( out) :: c14sbc ! atm c14 ratio
+ REAL(wp), DIMENSION(A2D(0)), INTENT( out) :: c14sbc ! atm c14 ratio
REAL(wp), INTENT( out) :: co2sbc ! atm co2 p
- INTEGER :: jz ! dummy loop indice
+ INTEGER :: ji, jj, jz ! dummy loop indice
REAL(wp) :: zdint,zint ! work
REAL(wp), DIMENSION(nc14zon) :: zonbc14 ! work
!
@@ -215,10 +222,6 @@ CONTAINS
!
IF( ln_timing ) CALL timing_start('trc_atm_c14')
!
- IF( kc14typ == 0) THEN
- co2sbc=pco2at
- c14sbc(:,:)=rc14at
- ENDIF
!
IF(kc14typ >= 1) THEN ! Transient C14 & CO2
!
diff --git a/src/TOP/C14/trcsms_c14.F90 b/src/TOP/C14/trcsms_c14.F90
index 9ce0a584a8b0bff04ceeaedaf1516f6a01aab9cc..0135dc8c934aca0e0e90a07362ff5bd08c87cfd3 100644
--- a/src/TOP/C14/trcsms_c14.F90
+++ b/src/TOP/C14/trcsms_c14.F90
@@ -80,7 +80,7 @@ CONTAINS
! CO2 solubility (Weiss, 1974; Wanninkhof, 2014)
! -------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) > 0. ) THEN
!
zt = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) )
@@ -121,21 +121,21 @@ CONTAINS
!
! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s
! already masked
- qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr(:,:,1,jp_c14,Kbb) )
+ DO_2D( 0, 0, 0, 0 )
+ qtr_c14(ji,jj) = exch_c14(ji,jj) * ( c14sbc(ji,jj) - tr(ji,jj,1,jp_c14,Kbb) )
+ END_2D
! cumulation of air-to-sea flux at each time step
qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rn_Dt
!
! Add the surface flux to the trend of jp_c14
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm)
END_2D
!
! Computation of decay effects on jp_c14
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
- !
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk)
- !
END_3D
!
IF( lrst_trc ) THEN
diff --git a/src/TOP/C14/trcwri_c14.F90 b/src/TOP/C14/trcwri_c14.F90
index 7f3de9f0c0a731479a0743e0c927443087b26c65..7fcda51a3696560d6d6c0034d4ec6ddaf77925a4 100644
--- a/src/TOP/C14/trcwri_c14.F90
+++ b/src/TOP/C14/trcwri_c14.F90
@@ -38,8 +38,8 @@ CONTAINS
CHARACTER (len=20) :: cltra ! short title for tracer
INTEGER :: ji,jj,jk,jn ! dummy loop indexes
REAL(wp) :: zage,zarea,ztemp ! temporary
- REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zres, z2d ! temporary storage 2D
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d , zz3d ! temporary storage 3D
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! temporary storage 2D
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d ! temporary storage 3D
!!---------------------------------------------------------------------
! write the tracer concentrations in the file
@@ -49,41 +49,35 @@ CONTAINS
! compute and write the tracer diagnostic in the file
! ---------------------------------------
+ IF( iom_use("qtr_c14") ) CALL iom_put( "qtr_c14" , rsiyea * qtr_c14(:,:) ) ! Radiocarbon surf flux [./m2/yr]
+ CALL iom_put( "qint_c14", qint_c14(:,:) ) ! cumulative flux [./m2]
IF( iom_use("DeltaC14") .OR. iom_use("C14Age") .OR. iom_use("RAge") ) THEN
!
- ALLOCATE( z2d(jpi,jpj), zres(jpi,jpj) )
- ALLOCATE( z3d(jpi,jpj,jpk), zz3d(jpi,jpj,jpk) )
+ ALLOCATE( z2d(A2D(0)), z3d(A2D(0),jpk) )
!
zage = -1._wp / rlam14 / rsiyea ! factor for radioages in year
z3d(:,:,:) = 1._wp
- zz3d(:,:,:) = 0._wp
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
IF( tmask(ji,jj,jk) > 0._wp) THEN
- z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm)
- zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) )
+ z3d(ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm)
ENDIF
END_3D
- zres(:,:) = z3d(:,:,1)
+ CALL iom_put( "C14Age", zage * LOG( z3d(:,:,:) ) ) ! Radiocarbon age [yr]
! Reservoir age [yr]
- z2d(:,:) =0._wp
- jk = 1
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- ztemp = zres(ji,jj) / c14sbc(ji,jj)
- IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp )
+ z2d(:,:) = 0._wp
+ DO_2D( 0, 0, 0, 0 )
+ ztemp = z3d(ji,jj,1) / c14sbc(ji,jj)
+ IF( ztemp > 0._wp .AND. tmask(ji,jj,1) > 0._wp ) z2d(ji,jj) = LOG( ztemp )
END_2D
+ CALL iom_put( "RAge" , zage * z2d(:,:) ) ! Reservoir age [yr]
!
z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp )
CALL iom_put( "DeltaC14" , z3d(:,:,:) ) ! Delta C14 [permil]
- CALL iom_put( "C14Age" , zage * zz3d(:,:,:) ) ! Radiocarbon age [yr]
-
- CALL iom_put( "qtr_c14", rsiyea * qtr_c14(:,:) ) ! Radiocarbon surf flux [./m2/yr]
- CALL iom_put( "qint_c14" , qint_c14 ) ! cumulative flux [./m2]
- CALL iom_put( "RAge" , zage * z2d(:,:) ) ! Reservoir age [yr]
!
- DEALLOCATE( z2d, zres, z3d, zz3d )
+ DEALLOCATE( z2d, z3d )
!
ENDIF
!
@@ -91,23 +85,35 @@ CONTAINS
!
CALL iom_put( "AtmCO2", co2sbc ) ! global atmospheric CO2 [ppm]
- IF( iom_use("AtmC14") ) THEN
- zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface
- ztemp = glob_sum( 'trcwri_c14', c14sbc(:,:) * e1e2t(:,:) )
- ztemp = ( ztemp / zarea - 1._wp ) * 1000._wp
- CALL iom_put( "AtmC14" , ztemp ) ! Global atmospheric DeltaC14 [permil]
- ENDIF
- IF( iom_use("K_C14") ) THEN
- ztemp = glob_sum ( 'trcwri_c14', exch_c14(:,:) * e1e2t(:,:) )
- ztemp = rsiyea * ztemp / zarea
- CALL iom_put( "K_C14" , ztemp ) ! global mean exchange velocity for C14/C ratio [m/yr]
- ENDIF
- IF( iom_use("K_CO2") ) THEN
+ IF( iom_use("AtmC14") .OR. iom_use("K_C14") .OR. iom_use("K_CO2") ) THEN
zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface
- ztemp = glob_sum ( 'trcwri_c14', exch_co2(:,:) * e1e2t(:,:) )
- ztemp = 360000._wp * ztemp / zarea ! cm/h units: directly comparable with literature
- CALL iom_put( "K_CO2", ztemp ) ! global mean CO2 piston velocity [cm/hr]
- ENDIF
+ ALLOCATE( z2d(A2D(0)) )
+ IF( iom_use("AtmC14") ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ z2d(ji,jj) = c14sbc(ji,jj) * e1e2t(ji,jj)
+ END_2D
+ ztemp = glob_sum( 'trcwri_c14', z2d(:,:) )
+ ztemp = ( ztemp / zarea - 1._wp ) * 1000._wp
+ CALL iom_put( "AtmC14" , ztemp ) ! Global atmospheric DeltaC14 [permil]
+ ENDIF
+ IF( iom_use("K_C14") ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ z2d(ji,jj) = exch_c14(ji,jj) * e1e2t(ji,jj)
+ END_2D
+ ztemp = glob_sum( 'trcwri_c14', z2d(:,:) )
+ ztemp = rsiyea * ztemp / zarea
+ CALL iom_put( "K_C14" , ztemp ) ! global mean exchange velocity for C14/C ratio [m/yr]
+ ENDIF
+ IF( iom_use("K_CO2") ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ z2d(ji,jj) = exch_co2(ji,jj) * e1e2t(ji,jj)
+ END_2D
+ ztemp = glob_sum( 'trcwri_c14', z2d(:,:) )
+ ztemp = 360000._wp * ztemp / zarea ! cm/h units: directly comparable with literature
+ CALL iom_put( "K_CO2", ztemp ) ! global mean CO2 piston velocity [cm/hr]
+ ENDIF
+ DEALLOCATE( z2d )
+ END IF
IF( iom_use("C14Inv") ) THEN
ztemp = glob_sum( 'trcwri_c14', tr(:,:,:,jp_c14,Kmm) * cvol(:,:,:) )
ztemp = atomc14 * xdicsur * ztemp
diff --git a/src/TOP/CFC/trcini_cfc.F90 b/src/TOP/CFC/trcini_cfc.F90
index cacfee0815d0d70f416da87c07a1167c27484b01..5d759a1364d1540c4f7317f1195aedcce03be7cb 100644
--- a/src/TOP/CFC/trcini_cfc.F90
+++ b/src/TOP/CFC/trcini_cfc.F90
@@ -131,7 +131,7 @@ CONTAINS
! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn
!---------------------------------------------------------------------------------------
zyd = ylatn - ylats
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( gphit(ji,jj) >= ylatn ) THEN ; xphem(ji,jj) = 1.e0
ELSEIF( gphit(ji,jj) <= ylats ) THEN ; xphem(ji,jj) = 0.e0
ELSE ; xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
diff --git a/src/TOP/CFC/trcsms_cfc.F90 b/src/TOP/CFC/trcsms_cfc.F90
index 32e9b63eb19fec4005f8c6e05213681866a466c2..e473c088c8e6d807c85d9aa97d8d8680727d4d17 100644
--- a/src/TOP/CFC/trcsms_cfc.F90
+++ b/src/TOP/CFC/trcsms_cfc.F90
@@ -124,9 +124,9 @@ CONTAINS
& + atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12.
END DO
- ! !------------!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! i-j loop !
- ! !------------!
+ ! !------------!
+ DO_2D( 0, 0, 0, 0 ) ! i-j loop !
+ ! !------------!
! space interpolation
zpp_cfc = xphem(ji,jj) * zpatm(1,jl) &
& + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
@@ -309,8 +309,8 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE trc_sms_cfc_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( xphem (jpi,jpj) , atm_cfc(jpyear,jphem,jp_cfc) , &
- & qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc) , &
+ ALLOCATE( xphem (A2D(0)) , atm_cfc(jpyear,jphem,jp_cfc) , &
+ & qtr_cfc (A2D(0),jp_cfc) , qint_cfc(A2D(0),jp_cfc) , &
& soa(4,jp_cfc) , sob(3,jp_cfc) , sca(5,jp_cfc) , &
& STAT=trc_sms_cfc_alloc )
!
diff --git a/src/TOP/PISCES/P2Z/p2zbio.F90 b/src/TOP/PISCES/P2Z/p2zbio.F90
index ecbfc9f47f8ae64ed1ce18cc35da0fc76bcd5dd5..babf325b7bef50d389d5d63aa87cd471fe5efb31 100644
--- a/src/TOP/PISCES/P2Z/p2zbio.F90
+++ b/src/TOP/PISCES/P2Z/p2zbio.F90
@@ -104,7 +104,6 @@ CONTAINS
!
IF( ln_timing ) CALL timing_start('p2z_bio')
!
- IF( lk_iomput ) ALLOCATE( zw2d(jpi,jpj,17), zw3d(jpi,jpj,jpk,3) )
IF( kt == nittrc000 ) THEN
IF(lwp) WRITE(numout,*)
@@ -112,18 +111,18 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' ~~~~~~~'
ENDIF
- xksi(:,:) = 0.e0 ! zooplakton closure ( fbod)
IF( lk_iomput ) THEN
- zw2d (:,:,:) = 0._wp
- zw3d(:,:,:,:) = 0._wp
+ ALLOCATE( zw3d(A2D(0),jpk,3) ) ; zw3d(:,:,jpk,:) = 0._wp
+ ALLOCATE( zw2d(A2D(0),17) )
ENDIF
+ !
+ xksi(:,:) = 0.e0 ! zooplakton closure ( fbod)
! ! -------------------------- !
- DO jk = 1, jpkbm1 ! Upper ocean (bio-layers) !
+ DO_3D( 0, 0, 0, 0, 1, jpkbm1 ) ! Upper ocean (bio-layers) !
! ! -------------------------- !
- DO_2D( 0, 0, 0, 0 )
- ! trophic variables( det, zoo, phy, no3, nh4, dom)
- ! ------------------------------------------------
+ ! trophic variables( det, zoo, phy, no3, nh4, dom)
+ ! ------------------------------------------------
! negative trophic variables DO not contribute to the fluxes
zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) )
@@ -235,13 +234,11 @@ CONTAINS
zw3d(ji,jj,jk,3) = znh4no3 * 86400
!
ENDIF
- END_2D
- END DO
+ END_3D
! ! -------------------------- !
- DO jk = jpkb, jpkm1 ! Upper ocean (bio-layers) !
+ DO_3D( 0, 0, 0, 0, jpkb, jpkm1 ) ! Upper ocean (bio-layers) !
! ! -------------------------- !
- DO_2D( 0, 0, 0, 0 )
! remineralisation of all quantities towards nitrate
! trophic variables( det, zoo, phy, no3, nh4, dom)
@@ -334,12 +331,9 @@ CONTAINS
zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp
!
ENDIF
- END_2D
- END DO
+ END_3D
!
IF( lk_iomput ) THEN
- CALL lbc_lnk( 'p2zbio', zw2d(:,:,:),'T', 1.0_wp )
- CALL lbc_lnk( 'p2zbio', zw3d(:,:,:,1),'T', 1.0_wp, zw3d(:,:,:,2),'T', 1.0_wp, zw3d(:,:,:,3),'T', 1.0_wp )
! Save diagnostics
CALL iom_put( "TNO3PHY", zw2d(:,:,1) )
CALL iom_put( "TNH4PHY", zw2d(:,:,2) )
@@ -362,6 +356,8 @@ CONTAINS
CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) )
CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) )
!
+ DEALLOCATE( zw2d, zw3d )
+ !
ENDIF
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
diff --git a/src/TOP/PISCES/P2Z/p2zexp.F90 b/src/TOP/PISCES/P2Z/p2zexp.F90
index d5fe6fe115e4f4348607a6c1557d1cbb2971c8a8..71ed7709e6751cff80e933e9508211dc38062736 100644
--- a/src/TOP/PISCES/P2Z/p2zexp.F90
+++ b/src/TOP/PISCES/P2Z/p2zexp.F90
@@ -65,7 +65,7 @@ CONTAINS
!!
INTEGER :: ji, jj, jk, jl, ikt
REAL(wp) :: zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt
- REAL(wp), DIMENSION(jpi,jpj) :: zsedpoca
+ REAL(wp), DIMENSION(A2D(0)) :: zsedpoca
CHARACTER (len=25) :: charout
!!---------------------------------------------------------------------
!
@@ -106,7 +106,7 @@ CONTAINS
tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm)
END_2D
- CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1.0_wp )
+! CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1.0_wp )
! Oa & Ek: diagnostics depending on jpdia2d ! left as example
IF( lk_iomput ) CALL iom_put( "SEDPOC" , sedpocn )
@@ -120,7 +120,7 @@ CONTAINS
!
ELSE
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj) ! time laplacian on tracers
sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd ! sedpocb <-- filtered sedpocn
sedpocn(ji,jj) = zsedpoca(ji,jj) ! sedpocn <-- sedpoca
@@ -156,8 +156,8 @@ CONTAINS
INTEGER, INTENT(in) :: Kmm ! time level index
INTEGER :: ji, jj, jk
REAL(wp) :: zmaskt, zfluo, zfluu
- REAL(wp), DIMENSION(jpi,jpj ) :: zrro
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdm0
+ REAL(wp), DIMENSION(A2D(0) ) :: zrro, zarea
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zdm0
!!---------------------------------------------------------------------
!
IF(lwp) THEN
@@ -171,9 +171,9 @@ CONTAINS
! Calculate vertical distribution of newly formed biogenic poc
! in the water column in the case of max. possible bottom depth
! ------------------------------------------------------------
- zdm0 = 0._wp
- zrro = 1._wp
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, jpkb, jpkm1 )
+ zdm0(:,:,:) = 0._wp
+ zrro(:,:) = 1._wp
+ DO_3D( 0, 0, 0, 0, jpkb, jpkm1 )
zfluo = ( gdepw(ji,jj,jk ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr
zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr
IF( zfluo.GT.1. ) zfluo = 1._wp
@@ -190,14 +190,14 @@ CONTAINS
! ----------------------------------------------------------------------
dminl(:,:) = 0._wp
dmin3(:,:,:) = zdm0
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
IF( tmask(ji,jj,jk) == 0._wp ) THEN
dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
dmin3(ji,jj,jk) = 0._wp
ENDIF
END_3D
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0._wp
END_2D
@@ -209,8 +209,11 @@ CONTAINS
IF( zmaskt == 0. ) cmask(ji,jj) = 1._wp
END IF
END_2D
- CALL lbc_lnk( 'p2zexp', cmask , 'T', 1.0_wp ) ! lateral boundary conditions on cmask (sign unchanged)
- areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) )
+! CALL lbc_lnk( 'p2zexp', cmask , 'T', 1.0_wp ) ! lateral boundary conditions on cmask (sign unchanged)
+ DO_2D( 0, 0, 0, 0 )
+ zarea(ji,jj) = e1e2t(ji,jj) * cmask(ji,jj)
+ END_2D
+ areacot = glob_sum( 'p2zexp', zarea(:,:) )
!
IF( ln_rsttr ) THEN
CALL iom_get( numrtr, jpdom_auto, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
@@ -226,8 +229,8 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE p2z_exp_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( cmask(jpi,jpj) , dminl(jpi,jpj) , dmin3(jpi,jpj,jpk), &
- & sedpocb(jpi,jpj) , sedpocn(jpi,jpj), STAT=p2z_exp_alloc )
+ ALLOCATE( cmask(A2D(0)) , dminl(A2D(0)) , dmin3(A2D(0),jpk), &
+ & sedpocb(A2D(0)) , sedpocn(A2D(0)), STAT=p2z_exp_alloc )
IF( p2z_exp_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p2z_exp_alloc : failed to allocate arrays.' )
!
END FUNCTION p2z_exp_alloc
diff --git a/src/TOP/PISCES/P2Z/p2zopt.F90 b/src/TOP/PISCES/P2Z/p2zopt.F90
index 85f8b3e2aeea2ce5423a4f1e5e4f6b9dc01f5036..4c8268dea0cdb4abbb1f51f1c3eb7e95ddeaa49d 100644
--- a/src/TOP/PISCES/P2Z/p2zopt.F90
+++ b/src/TOP/PISCES/P2Z/p2zopt.F90
@@ -70,8 +70,8 @@ CONTAINS
REAL(wp) :: zpig ! log of the total pigment
REAL(wp) :: zkr, zkg ! total absorption coefficient in red and green
REAL(wp) :: zcoef ! temporary scalar
- REAL(wp), DIMENSION(jpi,jpj ) :: zpar100, zpar0m
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg
+ REAL(wp), DIMENSION(A2D(0) ) :: zpar100, zpar0m
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zparr, zparg
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p2z_opt')
@@ -85,8 +85,14 @@ CONTAINS
! ! surface irradiance
! ! ------------------
- IF( ln_dm2dc ) THEN ; zpar0m(:,:) = qsr_mean(:,:) * 0.43
- ELSE ; zpar0m(:,:) = qsr (:,:) * 0.43
+ IF( ln_dm2dc ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ zpar0m(ji,jj) = qsr_mean(ji,jj) * 0.43
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ zpar0m(ji,jj) = qsr(ji,jj) * 0.43
+ END_2D
ENDIF
zpar100(:,:) = zpar0m(:,:) * 0.01
zparr (:,:,1) = zpar0m(:,:) * 0.5
@@ -94,14 +100,14 @@ CONTAINS
! ! Photosynthetically Available Radiation (PAR)
zcoef = 12 * redf / rcchl / rpig ! --------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk )
+ DO_3D( 0, 0, 0, 0, 2, jpk )
zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef )
zkr = xkr0 + xkrp * EXP( xlr * zpig )
zkg = xkg0 + xkgp * EXP( xlg * zpig )
zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) )
zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) )
END_3D
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) ! mean par at t-levels
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! mean par at t-levels
zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef )
zkr = xkr0 + xkrp * EXP( xlr * zpig )
zkg = xkg0 + xkgp * EXP( xlg * zpig )
@@ -113,11 +119,11 @@ CONTAINS
! ! Euphotic layer
! ! --------------
neln(:,:) = 1 ! euphotic layer level
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) ! (i.e. 1rst T-level strictly below EL bottom)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! (i.e. 1rst T-level strictly below EL bottom)
IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1
END_3D
! ! Euphotic layer depth
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm)
END_2D
diff --git a/src/TOP/PISCES/P2Z/p2zsed.F90 b/src/TOP/PISCES/P2Z/p2zsed.F90
index 66f24308ccef21d867ad1435c0b85a906091d4f6..50d7e76964333e2daf8bad5bf48c2832f138cca0 100644
--- a/src/TOP/PISCES/P2Z/p2zsed.F90
+++ b/src/TOP/PISCES/P2Z/p2zsed.F90
@@ -61,10 +61,11 @@ CONTAINS
INTEGER, INTENT( in ) :: kt ! ocean time-step index
INTEGER, INTENT( in ) :: Kmm, Krhs ! time level indices
!
- INTEGER :: ji, jj, jk, jl, ierr
+ INTEGER :: ji, jj, jk
CHARACTER (len=25) :: charout
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork, ztra
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zwork
+ REAL(wp) :: ztra
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p2z_sed')
@@ -83,22 +84,26 @@ CONTAINS
zwork(:,:,jpk) = 0.e0 ! bottom value set to zero
! tracer flux at w-point: we use -vsed (downward flux) with simplification : no e1*e2
- DO jk = 2, jpkm1
- zwork(:,:,jk) = -vsed * tr(:,:,jk-1,jpdet,Kmm)
- END DO
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+ zwork(ji,jj,jk) = -vsed * tr(ji,jj,jk-1,jpdet,Kmm)
+ END_3D
! tracer flux divergence at t-point added to the general trend
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm)
- tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ ztra = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm)
+ tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra
END_3D
IF( lk_iomput ) THEN
IF( iom_use( "TDETSED" ) ) THEN
- ALLOCATE( zw2d(jpi,jpj) )
- zw2d(:,:) = ztra(:,:,1) * e3t(:,:,1,Kmm) * 86400._wp
+ ALLOCATE( zw2d(A2D(0)) )
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = - ( zwork(ji,jj,1) - zwork(ji,jj,2) ) * 86400._wp
+ END_2D
DO jk = 2, jpkm1
- zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t(:,:,jk,Kmm) * 86400._wp
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = zw2d(ji,jj) - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) * 86400._wp
+ END_2D
END DO
CALL iom_put( "TDETSED", zw2d )
DEALLOCATE( zw2d )
diff --git a/src/TOP/PISCES/P4Z/p4zagg.F90 b/src/TOP/PISCES/P4Z/p4zagg.F90
index 6eb5208f391449efa894387b1e48091d33329cfc..9c16b164791712b8966b24c246bd03e943facb70 100644
--- a/src/TOP/PISCES/P4Z/p4zagg.F90
+++ b/src/TOP/PISCES/P4Z/p4zagg.F90
@@ -70,7 +70,7 @@ CONTAINS
! PISCES part
IF( ln_p4z ) THEN
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
!
zfact = xstep * xdiss(ji,jj,jk)
! Part I : Coagulation dependent on turbulence
@@ -117,7 +117,7 @@ CONTAINS
ELSE ! ln_p5z
! PISCES-QUOTA part
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
!
zfact = xstep * xdiss(ji,jj,jk)
! Part I : Coagulation dependent on turbulence
diff --git a/src/TOP/PISCES/P4Z/p4zbc.F90 b/src/TOP/PISCES/P4Z/p4zbc.F90
index f649f91f75e3215b1d348a08e704f4573de7a93a..e4b20adbd59b360dfc4616924ab1d37023c6332c 100644
--- a/src/TOP/PISCES/P4Z/p4zbc.F90
+++ b/src/TOP/PISCES/P4Z/p4zbc.F90
@@ -13,6 +13,7 @@ MODULE p4zbc
USE sms_pisces ! PISCES Source Minus Sink variables
USE iom ! I/O manager
USE fldread ! time interpolation
+ USE prtctl ! print control for debugging
USE trcbc
IMPLICIT NONE
@@ -36,7 +37,6 @@ MODULE p4zbc
LOGICAL , PUBLIC :: ll_river !: boolean for river input of nutrients
LOGICAL , PUBLIC :: ll_ndepo !: boolean for atmospheric deposition of N
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dust ! structure of input dust
- TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ironsed ! structure of input iron from sediment
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_hydrofe ! structure of input iron from sediment
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust !: dust fields
@@ -74,6 +74,8 @@ CONTAINS
REAL(wp) :: zcoef, zwdust, zrivdin, zdustdep, zndep
!
CHARACTER (len=25) :: charout
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
+ REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_bc')
@@ -84,7 +86,9 @@ CONTAINS
IF( ll_dust ) THEN
!
CALL fld_read( kt, 1, sf_dust )
- dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) )
+ DO_2D( 0, 0, 0, 0 )
+ dust(ji,jj) = MAX( rtrn, sf_dust(1)%fnow(ji,jj,1) )
+ END_2D
!
! Iron solubilization of particles in the water column
! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/d
@@ -99,7 +103,7 @@ CONTAINS
! Atmospheric input of Iron dissolves in the water column
IF ( ln_trc_sbc(jpfer) ) THEN
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
!
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zdustdep * mfrac / mMass_Fe
@@ -107,16 +111,18 @@ CONTAINS
IF( lk_iomput ) THEN
! surface downward dust depo of iron
+ ALLOCATE( zw2d(A2D(0)) )
jl = n_trc_indsbc(jpfer)
- CALL iom_put( "Irondep", ( rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / rn_sbc_time ) * 1.e+3 * tmask(:,:,1) )
-
+ zw2d(A2D(0)) = rf_trsfac(jl) * ( sf_trcsbc(jl)%fnow(A2D(0),1) / rn_sbc_time ) * 1.e+3 * tmask(A2D(0),1)
+ CALL iom_put( "Irondep", zw2d )
+ DEALLOCATE( zw2d )
ENDIF
ENDIF
! Atmospheric input of PO4 dissolves in the water column
IF ( ln_trc_sbc(jppo4) ) THEN
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
!
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zdustdep * 1.e-3 / mMass_P
@@ -125,7 +131,7 @@ CONTAINS
! Atmospheric input of Si dissolves in the water column
IF ( ln_trc_sbc(jpsil) ) THEN
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
!
tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zdustdep * 0.269 / mMass_Si
@@ -135,7 +141,10 @@ CONTAINS
!
IF( lk_iomput ) THEN
! dust concentration at surface
- CALL iom_put( "pdust" , dust(:,:) / ( wdust / rday ) * tmask(:,:,1) ) ! dust concentration at surface
+ ALLOCATE( zw2d(A2D(0)) )
+ zw2d(A2D(0)) = dust(A2D(0)) / ( wdust / rday ) * tmask(A2D(0),1)
+ CALL iom_put( "pdust", zw2d )
+ DEALLOCATE( zw2d )
ENDIF
ENDIF
@@ -144,7 +153,7 @@ CONTAINS
! ----------------------------------------------------------
IF( ll_river ) THEN
jl = n_trc_indcbc(jpno3)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
DO jk = 1, nk_rnf(ji,jj)
zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1)
zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef
@@ -158,14 +167,14 @@ CONTAINS
IF( ll_ndepo ) THEN
IF( ln_trc_sbc(jpno3) ) THEN
jl = n_trc_indsbc(jpno3)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zndep = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) / e3t(ji,jj,1,Kmm) / rn_sbc_time
tr(ji,jj,1,jptal,Krhs) = tr(ji,jj,1,jptal,Krhs) - rno3 * zndep * rfact
END_2D
ENDIF
IF( ln_trc_sbc(jpnh4) ) THEN
jl = n_trc_indsbc(jpnh4)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zndep = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) / e3t(ji,jj,1,Kmm) / rn_sbc_time
tr(ji,jj,1,jptal,Krhs) = tr(ji,jj,1,jptal,Krhs) + rno3 * zndep * rfact
END_2D
@@ -183,41 +192,71 @@ CONTAINS
! Simple parameterization assuming a fixed constant concentration in
! sea-ice (icefeinput)
! ------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zdep = rfact / e3t(ji,jj,1,Kmm)
zwflux = fmmflx(ji,jj) / 1000._wp
zironice = MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep )
tr(ji,jj,1,jpfer,Krhs) = tr(ji,jj,1,jpfer,Krhs) + zironice
END_2D
!
- ! iron flux from ice
- IF( lk_iomput ) &
- & CALL iom_put( "Ironice", MAX( -0.99 * tr(:,:,1,jpfer,Kbb), (-1.*fmmflx(:,:)/1000._wp )*icefeinput*1.e+3*tmask(:,:,1)) )
+ IF( lk_iomput ) THEN
+ ! iron flux from ice
+ ALLOCATE( zw2d(A2D(0)) )
+ zw2d(A2D(0)) = MAX( -0.99 * tr(A2D(0),1,jpfer,Kbb), (-1.*fmmflx(A2D(0))/1000._wp )*icefeinput*1.e+3*tmask(A2D(0),1))
+ CALL iom_put( "Ironice", zw2d )
+ DEALLOCATE( zw2d )
+ ENDIF
!
ENDIF
! Add the external input of iron from sediment mobilization
! ------------------------------------------------------
IF( ln_ironsed .AND. .NOT.lk_sed ) THEN
- tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + ironsed(:,:,:) * rfact
- !
- IF( lk_iomput ) CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + ironsed(ji,jj,jk) * rfact
+ END_3D
+ !
+ IF( lk_iomput ) THEN
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = ironsed(A2D(0),1:jpkm1) * 1.e+3 * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "Ironsed", zw3d )
+ DEALLOCATE( zw3d )
+ ENDIF
ENDIF
! Add the external input of iron from hydrothermal vents
! ------------------------------------------------------
IF( ln_hydrofe ) THEN
CALL fld_read( kt, 1, sf_hydrofe )
- DO jk = 1, jpk
- hydrofe(:,:,jk) = ( MAX( rtrn, sf_hydrofe(1)%fnow(:,:,jk) ) * hratio ) &
- & / ( e1e2t(:,:) * e3t(:,:,jk,Kmm) * ryyss + rtrn ) / 1000._wp &
- & * tmask(:,:,jk)
- ENDDO
- tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + hydrofe(:,:,:) * rfact
- IF( ln_ligand ) tr(:,:,:,jplgw,Krhs) = tr(:,:,:,jplgw,Krhs) + ( hydrofe(:,:,:) * lgw_rath ) * rfact
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ hydrofe(ji,jj,jk) = ( MAX( rtrn, sf_hydrofe(1)%fnow(ji,jj,jk) ) * hratio ) &
+ & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * ryyss + rtrn ) / 1000._wp &
+ & * tmask(ji,jj,jk)
+ END_3D
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + hydrofe(ji,jj,jk) * rfact
+ END_3D
+ IF( ln_ligand ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + ( hydrofe(ji,jj,jk) * lgw_rath ) * rfact
+ END_3D
+ ENDIF
!
- IF( lk_iomput ) CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
+ IF( lk_iomput ) THEN
+ ! hydrothermal iron input
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = hydrofe(A2D(0),1:jpkm1) * 1.e+3 * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "HYDR", zw3d )
+ DEALLOCATE( zw3d )
+ ENDIF
ENDIF
+ !
+ IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
+ WRITE(charout, FMT="('bc')")
+ CALL prt_ctl_info( charout, cdcomp = 'top' )
+ CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
+ ENDIF
+ !
IF( ln_timing ) CALL timing_stop('p4z_bc')
!
END SUBROUTINE p4z_bc
@@ -303,7 +342,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' initialize dust input from atmosphere '
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
!
- ALLOCATE( dust(jpi,jpj) )
+ ALLOCATE( dust(A2D(0)) )
!
ALLOCATE( sf_dust(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst
IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_bc_init: unable to allocate sf_dust structure' )
@@ -321,7 +360,7 @@ CONTAINS
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' ==>>> ln_ironsed=T , computation of an island mask to enhance coastal supply of iron'
!
- ALLOCATE( ironsed(jpi,jpj,jpk) ) ! allocation
+ ALLOCATE( ironsed(A2D(0),jpk) ) ! allocation
!
CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
ALLOCATE( zcmask(jpi,jpj,jpk) )
@@ -350,7 +389,7 @@ CONTAINS
!
CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1.0_wp ) ! lateral boundary conditions on cmask (sign unchanged)
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zexpide = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) )
zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
@@ -358,9 +397,9 @@ CONTAINS
! Coastal supply of iron
! -------------------------
ironsed(:,:,jpk) = 0._wp
- DO jk = 1, jpkm1
- ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday )
- END DO
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ ironsed(ji,jj,jk) = sedfeinput * zcmask(ji,jj,jk) / ( e3t_0(ji,jj,jk) * rday )
+ END_3D
DEALLOCATE( zcmask)
ENDIF
!
@@ -371,7 +410,7 @@ CONTAINS
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' ==>>> ln_hydrofe=T , Input of iron from hydrothermal vents'
!
- ALLOCATE( hydrofe(jpi,jpj,jpk) ) ! allocation
+ ALLOCATE( hydrofe(A2D(0),jpk) ) ! allocation
!
ALLOCATE( sf_hydrofe(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst
IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_bc_init: unable to allocate sf_hydro structure' )
diff --git a/src/TOP/PISCES/P4Z/p4zbio.F90 b/src/TOP/PISCES/P4Z/p4zbio.F90
index d2a21ea1cd049af3a7c8ae96ce5feadaf2e14ff0..65f61f4f90552a637b0f6c8f53b2058bc9b708fa 100644
--- a/src/TOP/PISCES/P4Z/p4zbio.F90
+++ b/src/TOP/PISCES/P4Z/p4zbio.F90
@@ -72,7 +72,7 @@ CONTAINS
! OF PHYTOPLANKTON AND DETRITUS. Shear rate is supposed to equal 1
! in the mixed layer and 0.1 below the mixed layer.
xdiss(:,:,:) = 1.
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01
END_3D
diff --git a/src/TOP/PISCES/P4Z/p4zche.F90 b/src/TOP/PISCES/P4Z/p4zche.F90
index a71f9350e553ee336f81d980f64d96bb9fcf2935..8d9f68fe00e0bced44695e0264ace39e8bebd288 100644
--- a/src/TOP/PISCES/P4Z/p4zche.F90
+++ b/src/TOP/PISCES/P4Z/p4zche.F90
@@ -168,9 +168,13 @@ CONTAINS
! practical salinity
! -------------------------------------------------------------
IF (neos == -1) THEN
- salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ salinprac(ji,jj,jk) = ts(ji,jj,jk,jp_sal,Kmm) * 35.0 / 35.16504
+ END_3D
ELSE
- salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm)
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ salinprac(ji,jj,jk) = ts(ji,jj,jk,jp_sal,Kmm)
+ END_3D
ENDIF
!
@@ -179,7 +183,7 @@ CONTAINS
! potential temperature to in situ temperature. The errors is less than
! 0.04°C relative to an exact computation
! ---------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
zpres = gdept(ji,jj,jk,Kmm) / 1000.
za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) )
za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 )
@@ -188,7 +192,7 @@ CONTAINS
!
! CHEMICAL CONSTANTS - SURFACE LAYER
! ----------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
! ! SET ABSOLUTE TEMPERATURE
ztkel = tempis(ji,jj,1) + 273.15
zt = ztkel * 0.01
@@ -216,7 +220,7 @@ CONTAINS
! OXYGEN SOLUBILITY - DEEP OCEAN
! -------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
ztkel = tempis(ji,jj,jk) + 273.15
zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35.
zsal2 = zsal * zsal
@@ -235,7 +239,7 @@ CONTAINS
! CHEMICAL CONSTANTS - DEEP OCEAN
! -------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
! SET PRESSION ACCORDING TO SAUNDER (1980)
zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) )
zc1 = 5.92E-3 + zplat**2 * 5.25E-3
@@ -452,7 +456,7 @@ CONTAINS
!! and the 2nd order approximation does not have
!! a solution
!!---------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_hini
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(OUT) :: p_hini
INTEGER, INTENT(in) :: Kbb ! time level indices
INTEGER :: ji, jj, jk
REAL(wp) :: zca1, zba1
@@ -463,7 +467,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('ahini_for_at')
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
p_alkcb = tr(ji,jj,jk,jptal,Kbb) * zrhd
p_dictot = tr(ji,jj,jk,jpdic,Kbb) * zrhd
@@ -512,13 +516,13 @@ CONTAINS
! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+])
! Argument variables
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(OUT) :: p_alknw_inf
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(OUT) :: p_alknw_sup
INTEGER, INTENT(in) :: Kbb ! time level indices
INTEGER :: ji, jj, jk
REAL(wp) :: zrhd
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
p_alknw_inf(ji,jj,jk) = -tr(ji,jj,jk,jppo4,Kbb) * zrhd - sulfat(ji,jj,jk) &
& - fluorid(ji,jj,jk)
@@ -536,8 +540,8 @@ CONTAINS
! Argument variables
!--------------------
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: p_hini
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: zhi
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(IN) :: p_hini
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(OUT) :: zhi
INTEGER, INTENT(in) :: Kbb ! time level indices
! Local variables
@@ -557,17 +561,17 @@ CONTAINS
REAL(wp) :: zrhd, p_alktot, zdic, zbot, zpt, zst, zft, zsit
LOGICAL :: l_exitnow
REAL(wp), PARAMETER :: pz_exp_threshold = 1.0
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin
IF( ln_timing ) CALL timing_start('solve_at_general')
CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb )
- rmask(:,:,:) = tmask(:,:,:)
+ rmask(A2D(0),1:jpk) = tmask(A2D(0),1:jpk)
zhi(:,:,:) = 0.
! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
IF (rmask(ji,jj,jk) == 1.) THEN
zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
p_alktot = tr(ji,jj,jk,jptal,Kbb) * zrhd
@@ -597,7 +601,7 @@ CONTAINS
zeqn_absmin(:,:,:) = HUGE(1._wp)
DO jn = 1, jp_maxniter_atgen
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
IF (rmask(ji,jj,jk) == 1.) THEN
zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
p_alktot = tr(ji,jj,jk,jptal,Kbb) * zrhd
@@ -797,17 +801,17 @@ CONTAINS
ierr(:) = 0
- ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) )
+ ALLOCATE( sio3eq(A2D(0),jpk), fekeq(A2D(0),jpk), chemc(A2D(0),3), chemo2(A2D(0),jpk), STAT=ierr(1) )
- ALLOCATE( akb3(jpi,jpj,jpk) , tempis(jpi, jpj, jpk), &
- & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , &
- & aks3(jpi,jpj,jpk) , akf3(jpi,jpj,jpk) , &
- & ak1p3(jpi,jpj,jpk) , ak2p3(jpi,jpj,jpk) , &
- & ak3p3(jpi,jpj,jpk) , aksi3(jpi,jpj,jpk) , &
- & fluorid(jpi,jpj,jpk) , sulfat(jpi,jpj,jpk) , &
- & salinprac(jpi,jpj,jpk), STAT=ierr(2) )
+ ALLOCATE( akb3(A2D(0),jpk) , tempis(A2D(0),jpk), &
+ & akw3(A2D(0),jpk) , borat (A2D(0),jpk) , &
+ & aks3(A2D(0),jpk) , akf3(A2D(0),jpk) , &
+ & ak1p3(A2D(0),jpk) , ak2p3(A2D(0),jpk) , &
+ & ak3p3(A2D(0),jpk) , aksi3(A2D(0),jpk) , &
+ & fluorid(A2D(0),jpk) , sulfat(A2D(0),jpk) , &
+ & salinprac(A2D(0),jpk), STAT=ierr(2) )
- ALLOCATE( fesol(jpi,jpj,jpk,5), STAT=ierr(3) )
+ ALLOCATE( fesol(A2D(0),jpk,5), STAT=ierr(3) )
!* Variable for chemistry of the CO2 cycle
p4z_che_alloc = MAXVAL( ierr )
diff --git a/src/TOP/PISCES/P4Z/p4zfechem.F90 b/src/TOP/PISCES/P4Z/p4zfechem.F90
index 2598766485bdad722d29f17aaab666676789cfb7..2e05446d88970f7fd86247538b54ac8a789340a6 100644
--- a/src/TOP/PISCES/P4Z/p4zfechem.F90
+++ b/src/TOP/PISCES/P4Z/p4zfechem.F90
@@ -31,6 +31,7 @@ MODULE p4zfechem
REAL(wp), PUBLIC :: kfep !: rate constant for nanoparticle formation
REAL(wp), PUBLIC :: scaveff !: Fraction of scavenged iron that is considered as being subject to solubilization
+ LOGICAL :: l_dia_fechem
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
@@ -58,36 +59,41 @@ CONTAINS
REAL(wp) :: zkeq, zfesatur, fe3sol, zligco
REAL(wp) :: zscave, zaggdfea, zaggdfeb, ztrc, zdust, zklight
REAL(wp) :: ztfe, zhplus, zxlam, zaggliga, zaggligb
- REAL(wp) :: zprecip, zprecipno3, zconsfe, za1
+ REAL(wp) :: zprecip, zprecipno3, zconsfe, za1, ztl1, zfel1
REAL(wp) :: zrfact2
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTL1, zFe3, ztotlig, zfeprecip, zFeL1, zfecoll
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcoll3d, zscav3d, zlcoll3d
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zFe3, ztotlig, zfecoll
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d, zcoll3d, zscav3d, zfeprecip
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_fechem')
!
- zFe3 (:,:,jpk) = 0.
- zFeL1 (:,:,jpk) = 0.
- zTL1 (:,:,jpk) = 0.
- zfeprecip(:,:,jpk) = 0.
- zcoll3d (:,:,jpk) = 0.
- zscav3d (:,:,jpk) = 0.
- zlcoll3d (:,:,jpk) = 0.
- zfecoll (:,:,jpk) = 0.
- xfecolagg(:,:,jpk) = 0.
- xcoagfe (:,:,jpk) = 0.
+ IF( kt == nittrc000 ) &
+ l_dia_fechem = iom_use( "Fe3" ) .OR. iom_use( "FeL1" ) .OR. iom_use( "TL1" ) .OR. &
+ & iom_use( "Totlig" ) .OR. iom_use( "Biron" ) .OR. iom_use( "FESCAV" ) .OR. &
+ & iom_use( "FECOLL" ) .OR. iom_use( "FEPREC" )
+
+ IF( l_dia_fechem ) ALLOCATE( zcoll3d(A2D(0),jpk), zscav3d(A2D(0),jpk), zfeprecip(A2D(0),jpk) )
!
! Total ligand concentration : Ligands can be chosen to be constant or variable
! Parameterization from Pham and Ito (2018)
! -------------------------------------------------
- xfecolagg(:,:,:) = ligand * 1E9 + MAX(0., chemo2(:,:,:) - tr(:,:,:,jpoxy,Kbb) ) / 400.E-6
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ xfecolagg(ji,jj,jk) = ligand * 1E9 + MAX(0., chemo2(ji,jj,jk) - tr(ji,jj,jk,jpoxy,Kbb) ) / 400.E-6
+ END_3D
+ !
IF( ln_ligvar ) THEN
- ztotlig(:,:,:) = 0.09 * 0.667 * tr(:,:,:,jpdoc,Kbb) * 1E6 + xfecolagg(:,:,:)
- ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ ztotlig(ji,jj,jk) = 0.09 * 0.667 * tr(ji,jj,jk,jpdoc,Kbb) * 1E6 + xfecolagg(ji,jj,jk)
+ ztotlig(ji,jj,jk) = MIN( ztotlig(ji,jj,jk), 10. )
+ END_3D
ELSE
- IF( ln_ligand ) THEN ; ztotlig(:,:,:) = tr(:,:,:,jplgw,Kbb) * 1E9
- ELSE ; ztotlig(:,:,:) = ligand * 1E9
+ IF( ln_ligand ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ ztotlig(ji,jj,jk) = tr(ji,jj,jk,jplgw,Kbb) * 1E9
+ END_3D
+ ELSE
+ ztotlig(:,:,:) = ligand * 1E9
ENDIF
ENDIF
@@ -96,20 +102,22 @@ CONTAINS
! This model is based on one ligand, Fe2+ and Fe3+
! Chemistry is supposed to be fast enough to be at equilibrium
! ------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
- zTL1(ji,jj,jk) = ztotlig(ji,jj,jk)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ ztl1 = ztotlig(ji,jj,jk)
zkeq = fekeq(ji,jj,jk)
zklight = 4.77E-7 * etot(ji,jj,jk) * 0.5 / ( 10**(-6.3) )
zconsfe = consfe3(ji,jj,jk) / ( 10**(-6.3) )
- zfesatur = zTL1(ji,jj,jk) * 1E-9
+ zfesatur = ztl1 * 1E-9
ztfe = (1.0 + zklight) * tr(ji,jj,jk,jpfer,Kbb)
! Fe' is the root of a 2nd order polynom
za1 = 1. + zfesatur * zkeq + zklight + zconsfe - zkeq * tr(ji,jj,jk,jpfer,Kbb)
zFe3 (ji,jj,jk) = ( -1 * za1 + SQRT( za1**2 + 4. * ztfe * zkeq) ) / ( 2. * zkeq + rtrn )
- zFeL1(ji,jj,jk) = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) - zFe3(ji,jj,jk) )
END_3D
!
- plig(:,:,:) = MAX( 0., ( zFeL1(:,:,:) / ( tr(:,:,:,jpfer,Kbb) + rtrn ) ) )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfel1 = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) - zFe3(ji,jj,jk) )
+ plig(ji,jj,jk) = MAX( 0., ( zfel1 / ( tr(ji,jj,jk,jpfer,Kbb) + rtrn ) ) )
+ END_3D
!
zdust = 0. ! if no dust available
@@ -125,16 +133,27 @@ CONTAINS
! to coagulate
! ----------------------------------------------------------------------
IF (ln_ligand) THEN
- zfecoll(:,:,:) = 0.5 * zFeL1(:,:,:) * MAX(0., tr(:,:,:,jplgw,Kbb) - xfecolagg(:,:,:) * 1.0E-9 ) / ( tr(:,:,:,jplgw,Kbb) + rtrn )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfel1 = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) - zFe3(ji,jj,jk) )
+ zfecoll(ji,jj,jk) = 0.5 * zfel1 * MAX(0., ztotlig(ji,jj,jk) - xfecolagg(ji,jj,jk) ) &
+ & / ( ztotlig(ji,jj,jk) + rtrn )
+ END_3D
ELSE
IF (ln_ligvar) THEN
- zfecoll(:,:,:) = 0.5 * zFeL1(:,:,:) * MAX(0., tr(:,:,:,jplgw,Kbb) - xfecolagg(:,:,:) * 1.0E-9 ) / ( tr(:,:,:,jplgw,Kbb) + rtrn )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfel1 = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) - zFe3(ji,jj,jk) )
+ zfecoll(ji,jj,jk) = 0.5 * zfel1 * MAX(0., ztotlig(ji,jj,jk) - xfecolagg(ji,jj,jk) ) &
+ & / ( ztotlig(ji,jj,jk) + rtrn )
+ END_3D
ELSE
- zfecoll(:,:,:) = 0.5 * zFeL1(:,:,:)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfel1 = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) - zFe3(ji,jj,jk) )
+ zfecoll(ji,jj,jk) = 0.5 * zfel1
+ END_3D
ENDIF
ENDIF
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.
! This parameterization assumes a simple second order kinetics (k[Particles][Fe]).
! Scavenging onto dust is also included as evidenced from the DUNE experiments.
@@ -150,8 +169,6 @@ CONTAINS
! This occurs in anoxic waters only
zprecipno3 = 2.0 * 130.0 * tr(ji,jj,jk,jpno3,Kbb) * nitrfac(ji,jj,jk) * xstep * zFe3(ji,jj,jk)
!
- zfeprecip(ji,jj,jk) = zprecip + zprecipno3
- !
ztrc = ( tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + tr(ji,jj,jk,jpcal,Kbb) + tr(ji,jj,jk,jpgsi,Kbb) ) * 1.e6
ztrc = MAX( rtrn, ztrc )
IF( ll_dust ) zdust = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk)
@@ -173,7 +190,7 @@ CONTAINS
xcoagfe(ji,jj,jk) = zlam1a + zlam1b
!
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb &
- & - zfeprecip(ji,jj,jk)
+ & - ( zprecip + zprecipno3 )
tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * scaveff * tr(ji,jj,jk,jppoc,Kbb) / ztrc
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zscave * scaveff * tr(ji,jj,jk,jppoc,Kbb) / ztrc
@@ -192,27 +209,56 @@ CONTAINS
tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zaggdfea
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggdfeb
!
- zscav3d(ji,jj,jk) = zscave
- zcoll3d(ji,jj,jk) = zaggdfea + zaggdfeb
+ IF( l_dia_fechem ) THEN
+ zscav3d(ji,jj,jk) = zscave
+ zcoll3d(ji,jj,jk) = zaggdfea + zaggdfeb
+ zfeprecip(ji,jj,jk) = zprecip + zprecipno3
+ ENDIF
!
END_3D
!
! Define the bioavailable fraction of iron
! ----------------------------------------
- biron(:,:,:) = tr(:,:,:,jpfer,Kbb)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ biron(ji,jj,jk) = tr(ji,jj,jk,jpfer,Kbb)
+ END_3D
!
! Output of some diagnostics variables
! ---------------------------------
- IF( lk_iomput .AND. knt == nrdttrc ) THEN
- zrfact2 = 1.e3 * rfact2r ! conversion from mol/L/timestep into mol/m3/s
- IF( iom_use("Fe3") ) CALL iom_put("Fe3" , zFe3 (:,:,:) * tmask(:,:,:) ) ! Fe3+
- IF( iom_use("FeL1") ) CALL iom_put("FeL1" , zFeL1 (:,:,:) * tmask(:,:,:) ) ! FeL1
- IF( iom_use("TL1") ) CALL iom_put("TL1" , zTL1 (:,:,:) * tmask(:,:,:) ) ! TL1
- IF( iom_use("Totlig") ) CALL iom_put("Totlig" , ztotlig(:,:,:) * tmask(:,:,:) ) ! TL
- IF( iom_use("Biron") ) CALL iom_put("Biron" , biron (:,:,:) * 1e9 * tmask(:,:,:) ) ! biron
- IF( iom_use("FESCAV") ) CALL iom_put("FESCAV" , zscav3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 )
- IF( iom_use("FECOLL") ) CALL iom_put("FECOLL" , zcoll3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 )
- IF( iom_use("FEPREC") ) CALL iom_put("FEPREC" , zfeprecip(:,:,:) *1e9*tmask(:,:,:)*zrfact2 )
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN
+ !
+ IF( l_dia_fechem ) THEN
+ zrfact2 = 1.e3 * rfact2r ! conversion from mol/L/timestep into mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! Fe3+
+ zw3d(A2D(0),1:jpkm1) = zFe3(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "Fe3", zw3d )
+ ! FeL1
+ zw3d(A2D(0),1:jpkm1) = MAX( 0., tr(A2D(0),1:jpkm1,jpfer,Kbb) - zFe3(A2D(0),1:jpkm1) ) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "FeL1", zw3d )
+ ! TL1 = Totlig
+ zw3d(A2D(0),1:jpkm1) = ztotlig(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "TL1", zw3d )
+ ! Totlig
+ zw3d(A2D(0),1:jpkm1) = ztotlig(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "Totlig", zw3d )
+ ! biron
+ zw3d(A2D(0),1:jpkm1) = biron(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "Biron", zw3d )
+ ! FESCAV
+ zw3d(A2D(0),1:jpkm1) = zscav3d(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1) * zrfact2
+ CALL iom_put( "FESCAV", zw3d )
+ ! FECOLL
+ zw3d(A2D(0),1:jpkm1) = zcoll3d(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1) * zrfact2
+ CALL iom_put( "FECOLL", zw3d )
+ ! FEPREC
+ zw3d(A2D(0),1:jpkm1) = zfeprecip(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1) * zrfact2
+ CALL iom_put( "FEPREC", zw3d )
+ !
+ DEALLOCATE( zcoll3d, zscav3d, zfeprecip, zw3d )
+ !
+ ENDIF
+ !
ENDIF
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
diff --git a/src/TOP/PISCES/P4Z/p4zflx.F90 b/src/TOP/PISCES/P4Z/p4zflx.F90
index 051985ba2037053eb13b4094b8a8aff532c7f2de..243abb8289785ce4e2cd483be0859fb83c940080 100644
--- a/src/TOP/PISCES/P4Z/p4zflx.F90
+++ b/src/TOP/PISCES/P4Z/p4zflx.F90
@@ -52,6 +52,9 @@ MODULE p4zflx
REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion
+ LOGICAL :: l_dia_cflx, l_dia_tcflx
+ LOGICAL :: l_dia_oflx, l_dia_kg
+
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
@@ -83,11 +86,20 @@ CONTAINS
REAL(wp) :: zph, zdic, zsch_o2, zsch_co2
REAL(wp) :: zyr_dec, zdco2dt
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3, zoflx, zpco2atm, zpco2oce
+ REAL(wp), DIMENSION(A2D(0)) :: zkgco2, zkgo2, zh2co3, zoflx, zpco2atm, zpco2oce
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_flx')
!
+ IF( kt == nittrc000 ) THEN
+ l_dia_cflx = iom_use( "Cflx" ) .OR. iom_use( "Dpco2" ) &
+ & .OR. iom_use( "pCO2sea" ) .OR. iom_use( "AtmCo2" )
+ l_dia_oflx = iom_use( "Oflx" ) .OR. iom_use( "Dpo2" )
+ l_dia_tcflx = iom_use( "tcflx" ) .OR. iom_use( "tcflxcum" )
+ l_dia_kg = iom_use( "Kg" )
+ ENDIF
+
! SURFACE CHEMISTRY (PCO2 AND [H+] IN
! SURFACE LAYER); THE RESULT OF THIS CALCULATION
! IS USED TO COMPUTE AIR-SEA FLUX OF CO2
@@ -108,9 +120,13 @@ CONTAINS
satmco2(:,:) = atcco2
ENDIF
- IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:)
+ IF( l_co2cpl ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ satmco2(ji,jj) = atm_co2(ji,jj)
+ END_2D
+ ENDIF
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
! DUMMY VARIABLES FOR DIC, H+, AND BORATE
zrhd = rhd(ji,jj,1) + 1._wp
zdic = tr(ji,jj,1,jpdic,Kbb)
@@ -126,7 +142,7 @@ CONTAINS
! FIRST COMPUTE GAS EXCHANGE COEFFICIENTS
! -------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ztc = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) )
ztc2 = ztc * ztc
ztc3 = ztc * ztc2
@@ -145,7 +161,7 @@ CONTAINS
END_2D
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ztkel = tempis(ji,jj,1) + 273.15
zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35.
zvapsw = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal)
@@ -170,12 +186,16 @@ CONTAINS
tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm)
END_2D
- IF( iom_use("tcflx") .OR. iom_use("tcflxcum") .OR. kt == nitrst &
- & .OR. (ln_check_mass .AND. kt == nitend) ) &
- t_oce_co2_flx = glob_sum( 'p4zflx', oce_co2(:,:) * e1e2t(:,:) * 1000. ) ! Total Flux of Carbon
- t_oce_co2_flx_cum = t_oce_co2_flx_cum + t_oce_co2_flx ! Cumulative Total Flux of Carbon
-! t_atm_co2_flx = glob_sum( 'p4zflx', satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2
- t_atm_co2_flx = atcco2 ! Total atmospheric pCO2
+ IF( l_dia_tcflx .OR. kt == nitrst &
+ & .OR. (ln_check_mass .AND. kt == nitend) ) THEN
+ ALLOCATE( zw2d(A2D(0)) )
+ zw2d(A2D(0)) = oce_co2(A2D(0)) * e1e2t(A2D(0)) * 1000._wp
+ t_oce_co2_flx = glob_sum( 'p4zflx', zw2d(:,:) ) ! Total Flux of Carbon
+ t_oce_co2_flx_cum = t_oce_co2_flx_cum + t_oce_co2_flx ! Cumulative Total Flux of Carbon
+! t_atm_co2_flx = glob_sum( 'p4zflx', satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2
+ t_atm_co2_flx = atcco2 ! Total atmospheric pCO2
+ DEALLOCATE( zw2d )
+ ENDIF
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
WRITE(charout, FMT="('flx ')")
@@ -184,15 +204,47 @@ CONTAINS
ENDIF
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- CALL iom_put( "AtmCo2" , satmco2(:,:) * tmask(:,:,1) ) ! Atmospheric CO2 concentration
- CALL iom_put( "Cflx" , oce_co2(:,:) * 1000. )
- CALL iom_put( "Oflx" , zoflx(:,:) * 1000. )
- CALL iom_put( "Kg" , zkgco2(:,:) * tmask(:,:,1) )
- CALL iom_put( "Dpco2" , ( zpco2atm(:,:) - zpco2oce(:,:) ) * tmask(:,:,1) )
- CALL iom_put( "pCO2sea" , zpco2oce(:,:) * tmask(:,:,1) )
- CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - atcox * tr(:,:,1,jpoxy,Kbb) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) )
- CALL iom_put( "tcflx" , t_oce_co2_flx ) ! molC/s
- CALL iom_put( "tcflxcum", t_oce_co2_flx_cum ) ! molC
+ !
+ IF( l_dia_cflx ) THEN
+ ALLOCATE( zw2d(A2D(0)) )
+ ! Atmospheric CO2 concentration
+ zw2d(A2D(0)) = satmco2(A2D(0)) * tmask(A2D(0),1)
+ CALL iom_put( "AtmCo2", zw2d )
+ ! Carbon flux
+ zw2d(A2D(0)) = oce_co2(A2D(0)) * 1000._wp
+ CALL iom_put( "Cflx", zw2d )
+ ! atmospheric Dpco2
+ zw2d(A2D(0)) = ( zpco2atm(A2D(0)) - zpco2oce(A2D(0)) ) * tmask(A2D(0),1)
+ CALL iom_put( "Dpco2", zw2d )
+ ! oceanic Dpco2
+ zw2d(A2D(0)) = zpco2oce(A2D(0)) * tmask(A2D(0),1)
+ CALL iom_put( "pCO2sea", zw2d )
+ !
+ DEALLOCATE( zw2d )
+ ENDIF
+ !
+ IF( l_dia_oflx ) THEN
+ ALLOCATE( zw2d(A2D(0)) )
+ ! oxygen flux
+ CALL iom_put( "Oflx", zoflx * 1000._wp )
+ ! Dpo2
+ zw2d(A2D(0)) = ( atcox * patm(A2D(0)) - atcox * tr(A2D(0),1,jpoxy,Kbb) &
+ / ( chemo2(A2D(0),1) + rtrn ) ) * tmask(A2D(0),1)
+ CALL iom_put( "Dpo2", zw2d )
+ DEALLOCATE( zw2d )
+ ENDIF
+ !
+ IF( l_dia_kg ) THEN
+ ALLOCATE( zw2d(A2D(0)) )
+ zw2d(A2D(0)) = zkgco2(A2D(0)) * tmask(A2D(0),1)
+ CALL iom_put( "Kg", zw2d )
+ DEALLOCATE( zw2d )
+ ENDIF
+ IF( l_dia_tcflx ) THEN
+ CALL iom_put( "tcflx" , t_oce_co2_flx ) ! global flux of carbon
+ CALL iom_put( "tcflxcum", t_oce_co2_flx_cum ) ! Cumulative flux of carbon
+ ENDIF
+ !
ENDIF
!
IF( ln_timing ) CALL timing_stop('p4z_flx')
@@ -267,7 +319,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' Spatialized Atmospheric pCO2 from an external file'
ENDIF
!
- oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon
+! oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon
t_oce_co2_flx = 0._wp
t_atm_co2_flx = 0._wp
!
@@ -288,6 +340,7 @@ CONTAINS
CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
TYPE(FLD_N) :: sn_patm ! informations about the fields to be read
TYPE(FLD_N) :: sn_atmco2 ! informations about the fields to be read
+ INTEGER :: ji, jj
!!
NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir
!!----------------------------------------------------------------------
@@ -337,12 +390,16 @@ CONTAINS
!
IF( ln_presatm ) THEN
CALL fld_read( kt, 1, sf_patm ) !* input Patm provided at kt + 1/2
- patm(:,:) = sf_patm(1)%fnow(:,:,1)/101325.0 ! atmospheric pressure
+ DO_2D( 0, 0, 0, 0 )
+ patm(ji,jj) = sf_patm(1)%fnow(ji,jj,1)/101325.0 ! atmospheric pressure
+ END_2D
ENDIF
!
IF( ln_presatmco2 ) THEN
CALL fld_read( kt, 1, sf_atmco2 ) !* input atmco2 provided at kt + 1/2
- satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1) ! atmospheric pressure
+ DO_2D( 0, 0, 0, 0 )
+ satmco2(ji,jj) = sf_atmco2(1)%fnow(ji,jj,1) ! atmospheric pressure
+ END_2D
ELSE
satmco2(:,:) = atcco2 ! Initialize atmco2 if no reading from a file
ENDIF
@@ -354,7 +411,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE p4z_flx_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc )
+ ALLOCATE( satmco2(A2D(0)), patm(A2D(0)), STAT=p4z_flx_alloc )
!
IF( p4z_flx_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_flx_alloc : failed to allocate arrays' )
!
diff --git a/src/TOP/PISCES/P4Z/p4zint.F90 b/src/TOP/PISCES/P4Z/p4zint.F90
index 9b95c2e495b9e7c38277d993010743d8e9e560b2..c0243fc4c3446046d6544f3fcf29de78d0f99c8a 100644
--- a/src/TOP/PISCES/P4Z/p4zint.F90
+++ b/src/TOP/PISCES/P4Z/p4zint.F90
@@ -44,16 +44,18 @@ CONTAINS
!
! Computation of phyto and zoo metabolic rate
! -------------------------------------------
- ! Generic temperature dependence (Eppley, 1972)
- tgfunc (:,:,:) = EXP( 0.0631 * ts(:,:,:,jp_tem,Kmm) )
- ! Temperature dependence of mesozooplankton (Buitenhuis et al. (2005))
- tgfunc2(:,:,:) = EXP( 0.0761 * ts(:,:,:,jp_tem,Kmm) )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ ! Generic temperature dependence (Eppley, 1972)
+ tgfunc (ji,jj,jk) = EXP( 0.0631 * ts(ji,jj,jk,jp_tem,Kmm) )
+ ! Temperature dependence of mesozooplankton (Buitenhuis et al. (2005))
+ tgfunc2(ji,jj,jk) = EXP( 0.0761 * ts(ji,jj,jk,jp_tem,Kmm) )
+ END_3D
! Computation of the silicon dependant half saturation constant for silica uptake
! This is based on an old study by Pondaven et al. (1998)
! --------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb)
xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 )
END_2D
@@ -73,14 +75,14 @@ CONTAINS
zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) )
! day length in hours
- strn(:,:) = 0.
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+! strn(:,:) = 0.
+ DO_2D( 0, 0, 0, 0 )
zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
zargu = MAX( -1., MIN( 1., zargu ) )
strn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
END_2D
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
! denitrification factor computed from O2 levels
! This factor diagnoses below which level of O2 denitrification
! is active
diff --git a/src/TOP/PISCES/P4Z/p4zligand.F90 b/src/TOP/PISCES/P4Z/p4zligand.F90
index 07ce54c431ee750ec0a6df0bd602d0c03871b924..40fe75fd45d336d96e198b89ba1969e5aaecb78f 100644
--- a/src/TOP/PISCES/P4Z/p4zligand.F90
+++ b/src/TOP/PISCES/P4Z/p4zligand.F90
@@ -26,6 +26,8 @@ MODULE p4zligand
REAL(wp), PUBLIC :: prlgw !: Photochemical of weak ligand
REAL(wp), PUBLIC :: xklig !: 1/2 saturation constant of photolysis
+ LOGICAL :: l_dia_ligand
+
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
@@ -44,62 +46,117 @@ CONTAINS
INTEGER, INTENT(in) :: kt, knt ! ocean time step
INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices
!
- INTEGER :: ji, jj, jk
- REAL(wp) :: zlgwp, zlgwpr, zlgwr, zlablgw
- REAL(wp) :: zlam1a, zlam1b, zaggliga, zligco
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zligrem, zligpr, zligprod, zlcoll3d
+ INTEGER :: ji, jj, jk
+ REAL(wp) :: zlgwp, zlgwpr, zlgwr, zlablgw
+ REAL(wp) :: zlam1a, zlam1b, zaggliga, zligco
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zligrem, zligpr, zligprod, zlcoll3d
CHARACTER (len=25) :: charout
!!---------------------------------------------------------------------
!
+ IF( kt == nittrc000 ) &
+ & l_dia_ligand = iom_use( "LIGREM" ) .OR. iom_use( "LIGPR" ) &
+ & .OR. iom_use( "LPRODR" ) .OR. iom_use( "LGWCOLL" )
+
IF( ln_timing ) CALL timing_start('p4z_ligand')
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
- !
- ! ------------------------------------------------------------------
- ! Remineralization of iron ligands
- ! ------------------------------------------------------------------
- ! production from remineralisation of organic matter
+ ! ------------------------------------------------------------------
+ ! Remineralization of iron ligands
+ ! ------------------------------------------------------------------
+
+ ! production from remineralisation of organic matter
+ IF( l_dia_ligand ) THEN
+ ALLOCATE( zligprod(A2D(0),jpk) ) ; zligprod(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zligprod(ji,jj,jk) = tr(ji,jj,jk,jplgw,Krhs)
+ END_3D
+ ENDIF
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zlgwp = orem(ji,jj,jk) * rlig
- ! decay of weak ligand
- ! This is based on the idea that as LGW is lower
- ! there is a larger fraction of refractory OM
+ tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zlgwp
+ !
+ END_3D
+ !
+ IF( l_dia_ligand .AND. ( lk_iomput .AND. knt == nrdttrc ) ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zligprod(ji,jj,jk) = ( tr(ji,jj,jk,jplgw,Krhs) - zligprod(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "LPRODR", zligprod )
+ DEALLOCATE( zligprod )
+ ENDIF
+
+ ! Decay of weak ligand
+ ! This is based on the idea that as LGW is lower
+ ! there is a larger fraction of refractory OM
+ IF( l_dia_ligand ) THEN
+ ALLOCATE( zligrem(A2D(0),jpk) ) ; zligrem(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zligrem(ji,jj,jk) = tr(ji,jj,jk,jplgw,Krhs)
+ END_3D
+ ENDIF
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zlgwr = ( 1.0 / rlgs * MAX(0., tr(ji,jj,jk,jplgw,Kbb) - xfecolagg(ji,jj,jk) * 1.0E-9 ) &
& + 1.0 / rlgw * xfecolagg(ji,jj,jk) * 1.0E-9 ) / ( rtrn + tr(ji,jj,jk,jplgw,Kbb) )
zlgwr = zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb)
- ! photochem loss of weak ligand
+ tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zlgwr
+ END_3D
+ !
+ IF( l_dia_ligand .AND. ( lk_iomput .AND. knt == nrdttrc ) ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zligrem(ji,jj,jk) = - ( tr(ji,jj,jk,jplgw,Krhs) - zligrem(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "LIGREM", zligrem )
+ DEALLOCATE( zligrem )
+ ENDIF
+
+ ! photochem loss of weak ligand
+ IF( l_dia_ligand ) THEN
+ ALLOCATE( zligpr(A2D(0),jpk) ) ; zligpr(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zligpr(ji,jj,jk) = tr(ji,jj,jk,jplgw,Krhs)
+ END_3D
+ ENDIF
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zlgwpr = prlgw * xstep * etot(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb)**3 * (1. - fr_i(ji,jj)) &
& / ( tr(ji,jj,jk,jplgw,Kbb)**2 + (xklig)**2)
- ! Coagulation of ligands due to various processes (Brownian, shear, diff. sedimentation
- ! xcoagfe is computed in p4zfechem
- ! -------------------------------------------------------------------------------------
- ! 50% of the ligands are supposed to be in the colloidal size fraction
- ! as for FeL
+
+ tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zlgwpr
+ END_3D
+ !
+ IF( l_dia_ligand .AND. ( lk_iomput .AND. knt == nrdttrc ) ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zligpr(ji,jj,jk) = - ( tr(ji,jj,jk,jplgw,Krhs) - zligpr(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "LIGPR", zligpr )
+ DEALLOCATE( zligpr )
+ ENDIF
+
+ ! Coagulation of ligands due to various processes (Brownian, shear, diff. sedimentation
+ ! xcoagfe is computed in p4zfechem
+ ! -------------------------------------------------------------------------------------
+ ! 50% of the ligands are supposed to be in the colloidal size fraction as for FeL
+ IF( l_dia_ligand ) THEN
+ ALLOCATE( zlcoll3d(A2D(0),jpk) ) ; zlcoll3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zlcoll3d(ji,jj,jk) = tr(ji,jj,jk,jplgw,Krhs)
+ END_3D
+ ENDIF
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zligco = 0.5 * MAX(0., tr(ji,jj,jk,jplgw,Kbb) - xfecolagg(ji,jj,jk) * 1.0E-9 )
zaggliga = xcoagfe(ji,jj,jk) * xstep * zligco
- tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zlgwp - zlgwr - zlgwpr - zaggliga
- !
- zligrem(ji,jj,jk) = zlgwr
- zligpr(ji,jj,jk) = zlgwpr
- zligprod(ji,jj,jk) = zlgwp
- zlcoll3d(ji,jj,jk) = zaggliga
+ tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga
END_3D
!
- ! Output of some diagnostics variables
- ! ---------------------------------
- IF( lk_iomput .AND. knt == nrdttrc ) THEN
- IF( iom_use( "LIGREM" ) ) THEN
- zligrem(:,:,jpk) = 0. ; CALL iom_put( "LIGREM", zligrem(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
- IF( iom_use( "LIGPR" ) ) THEN
- zligpr(:,:,jpk) = 0. ; CALL iom_put( "LIGPR" , zligpr(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
- IF( iom_use( "LPRODR" ) ) THEN
- zligprod(:,:,jpk) = 0. ; CALL iom_put( "LPRODR", zligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
- IF( iom_use( "LGWCOLL" ) ) THEN
- zlcoll3d(:,:,jpk) = 0. ; CALL iom_put( "LGWCOLL", zlcoll3d(:,:,:) * 1.e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
+ IF( l_dia_ligand .AND. ( lk_iomput .AND. knt == nrdttrc ) ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zlcoll3d(ji,jj,jk) = - ( tr(ji,jj,jk,jplgw,Krhs) - zlcoll3d(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "LGWCOLL", zlcoll3d )
+ DEALLOCATE( zlcoll3d )
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
diff --git a/src/TOP/PISCES/P4Z/p4zlim.F90 b/src/TOP/PISCES/P4Z/p4zlim.F90
index 4e227808aad4e067b9348d662bcf0637977d7b93..d388955fb93955e90ba22509528b639817db1222 100644
--- a/src/TOP/PISCES/P4Z/p4zlim.F90
+++ b/src/TOP/PISCES/P4Z/p4zlim.F90
@@ -68,6 +68,8 @@ MODULE p4zlim
REAL(wp) :: xcoef2 = 1.21E-5 * 14. / 55.85 / 7.3125 * 0.5 * 1.5
REAL(wp) :: xcoef3 = 1.15E-4 * 14. / 55.85 / 7.3125 * 0.5
+ LOGICAL :: l_dia_nut_lim, l_dia_iron_lim, l_dia_size_lim, l_dia_fracal
+
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
@@ -98,13 +100,21 @@ CONTAINS
REAL(wp) :: zconc1d, zconc1dnh4, zconc0n, zconc0nnh4
REAL(wp) :: fananof, fadiatf, znutlim, zfalim
REAL(wp) :: znutlimtot, zlimno3, zlimnh4, zbiron
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_lim')
!
+ IF( kt == nittrc000 ) THEN
+ l_dia_nut_lim = iom_use( "LNnut" ) .OR. iom_use( "LDnut" )
+ l_dia_iron_lim = iom_use( "LNFe" ) .OR. iom_use( "LDFe" )
+ l_dia_size_lim = iom_use( "SIZEN" ) .OR. iom_use( "SIZED" )
+ l_dia_fracal = iom_use( "xfracal" )
+ ENDIF
+ !
sizena(:,:,:) = 1.0 ; sizeda(:,:,:) = 1.0
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! Computation of a variable Ks for iron on diatoms taking into account
! that increasing biomass is made of generally bigger cells
@@ -219,7 +229,7 @@ CONTAINS
! Size estimation of phytoplankton based on total biomass
! Assumes that larger biomass implies addition of larger cells
! ------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcoef = tr(ji,jj,jk,jpphy,Kbb) - MIN(xsizephy, tr(ji,jj,jk,jpphy,Kbb) )
sizena(ji,jj,jk) = 1. + ( xsizern -1.0 ) * zcoef / ( xsizephy + zcoef )
zcoef = tr(ji,jj,jk,jpdia,Kbb) - MIN(xsizedia, tr(ji,jj,jk,jpdia,Kbb) )
@@ -231,7 +241,7 @@ CONTAINS
! This is a purely adhoc formulation described in Aumont et al. (2015)
! This fraction depends on nutrient limitation, light, temperature
! --------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zlim1 = xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk)
zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnnh4 )
zlim3 = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) + 6.E-11 )
@@ -250,7 +260,7 @@ CONTAINS
xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) )
END_3D
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! denitrification factor computed from O2 levels
nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) &
& / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) )
@@ -263,13 +273,41 @@ CONTAINS
END_3D
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics
- CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht
- CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
- CALL iom_put( "LDnut" , xlimdia(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
- CALL iom_put( "LNFe" , xlimnfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "LDFe" , xlimdfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "SIZEN" , sizen (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "SIZED" , sized (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
+ !
+ IF( l_dia_fracal ) THEN ! fraction of calcifiers
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = xfracal(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "xfracal", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_nut_lim ) THEN ! Nutrient limitation term
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = xlimphy(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LNnut", zw3d)
+ zw3d(A2D(0),1:jpkm1) = xlimdia(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LDnut", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_iron_lim ) THEN ! Iron limitation term
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = xlimnfe(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LNFe", zw3d)
+ zw3d(A2D(0),1:jpkm1) = xlimdfe(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LDFe", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_size_lim ) THEN ! Size limitation term
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = sizen(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "SIZEN", zw3d)
+ zw3d(A2D(0),1:jpkm1) = sized(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "SIZED", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
ENDIF
!
IF( ln_timing ) CALL timing_stop('p4z_lim')
@@ -355,16 +393,16 @@ CONTAINS
!!----------------------------------------------------------------------
!* Biological arrays for phytoplankton growth
- ALLOCATE( xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk), &
- & xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk), &
- & xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk), &
- & xnanofer(jpi,jpj,jpk), xdiatfer(jpi,jpj,jpk), &
- & xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk), &
- & xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk), &
- & xlimbac (jpi,jpj,jpk), xlimbacl(jpi,jpj,jpk), &
- & concnfe (jpi,jpj,jpk), concdfe (jpi,jpj,jpk), &
- & xqfuncfecn(jpi,jpj,jpk), xqfuncfecd(jpi,jpj,jpk), &
- & xlimsi (jpi,jpj,jpk), STAT=p4z_lim_alloc )
+ ALLOCATE( xnanono3(A2D(0),jpk), xdiatno3(A2D(0),jpk), &
+ & xnanonh4(A2D(0),jpk), xdiatnh4(A2D(0),jpk), &
+ & xnanopo4(A2D(0),jpk), xdiatpo4(A2D(0),jpk), &
+ & xnanofer(A2D(0),jpk), xdiatfer(A2D(0),jpk), &
+ & xlimphy (A2D(0),jpk), xlimdia (A2D(0),jpk), &
+ & xlimnfe (A2D(0),jpk), xlimdfe (A2D(0),jpk), &
+ & xlimbac (A2D(0),jpk), xlimbacl(A2D(0),jpk), &
+ & concnfe (A2D(0),jpk), concdfe (A2D(0),jpk), &
+ & xqfuncfecn(A2D(0),jpk), xqfuncfecd(A2D(0),jpk), &
+ & xlimsi (A2D(0),jpk), STAT=p4z_lim_alloc )
!
IF( p4z_lim_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_lim_alloc : failed to allocate arrays.' )
!
diff --git a/src/TOP/PISCES/P4Z/p4zlys.F90 b/src/TOP/PISCES/P4Z/p4zlys.F90
index 007835e179b9aed11fd54f31bedf6e3bc42d167e..61db35c30dcab30254202d2bd1b12ce82b438ed9 100644
--- a/src/TOP/PISCES/P4Z/p4zlys.F90
+++ b/src/TOP/PISCES/P4Z/p4zlys.F90
@@ -32,7 +32,8 @@ MODULE p4zlys
REAL(wp), PUBLIC :: kdca !: diss. rate constant calcite
REAL(wp), PUBLIC :: nca !: order of reaction for calcite dissolution
- INTEGER :: rmtss ! number of seconds per month
+ INTEGER :: rmtss ! number of seconds per month
+ LOGICAL :: l_dia
!! * Module variables
REAL(wp) :: calcon = 1.03E-2 !: mean calcite concentration [Ca2+] in sea water [mole/kg solution]
@@ -63,23 +64,36 @@ CONTAINS
INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices
!
INTEGER :: ji, jj, jk, jn
- REAL(wp) :: zdispot, zrhd, zcalcon
+ REAL(wp) :: zdispot, zrhd, zcalcon, ztra
REAL(wp) :: zomegaca, zexcess, zexcess0, zkd
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3, zcaldiss, zhinit, zhi, zco3sat
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zhinit, zhi, zco3
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_lys')
!
-
- zhinit (:,:,:) = hi(:,:,:) / ( rhd(:,:,:) + 1._wp )
+ IF( kt == nittrc000 ) &
+ & l_dia = iom_use( "PH" ) .OR. iom_use( "CO3" ) .OR. iom_use( "CO3sat" ) .OR. iom_use( "DCAL" )
+
+ IF( l_dia ) THEN !* Save ta and sa trends
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = tr(ji,jj,jk,jpdic,Krhs) ! we be used to compute DCAL if needed
+ END_3D
+ ENDIF
+ !
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zhinit(ji,jj,jk) = hi(ji,jj,jk) / ( rhd(ji,jj,jk) + 1._wp )
+ END_3D
!
! -------------------------------------------
! COMPUTE [CO3--] and [H+] CONCENTRATIONS
! -------------------------------------------
CALL solve_at_general( zhinit, zhi, Kbb )
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 &
& + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn )
hi (ji,jj,jk) = zhi(ji,jj,jk) * ( rhd(ji,jj,jk) + 1._wp )
@@ -91,14 +105,13 @@ CONTAINS
! MGCO3)
! ---------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! DEVIATION OF [CO3--] FROM SATURATION VALUE
! Salinity dependance in zomegaca and divide by rhd to have good units
zcalcon = calcon * ( salinprac(ji,jj,jk) / 35._wp )
zrhd = rhd(ji,jj,jk) + 1._wp
zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zrhd + rtrn )
- zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zrhd / ( zcalcon + rtrn )
! SET DEGREE OF UNDER-/SUPERSATURATION
excess(ji,jj,jk) = 1._wp - zomegaca
@@ -116,25 +129,42 @@ CONTAINS
! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
- zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution
+ ztra = zdispot * rfact2 / rmtss ! calcite dissolution
!
- tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * zcaldiss(ji,jj,jk)
- tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zcaldiss(ji,jj,jk)
- tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zcaldiss(ji,jj,jk)
+ tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * ztra
+ tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - ztra
+ tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + ztra
END_3D
!
- IF( lk_iomput .AND. knt == nrdttrc ) THEN
- CALL iom_put( "PH" , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) )
- IF( iom_use( "CO3" ) ) THEN
- zco3(:,:,jpk) = 0. ; CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3 * tmask(:,:,:) )
+ IF( l_dia .AND. knt == nrdttrc ) THEN
+ IF( iom_use( "DCAL" ) ) THEN ! calcite dissolution
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpdic,Krhs) - zw3d(ji,jj,jk) ) * 1.e+3 * rfact2r * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "DCAL", zw3d )
+ ENDIF
+ IF( iom_use( "PH" ) ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = -1. * LOG10( MAX( hi(ji,jj,jk), rtrn ) ) * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "PH" , zw3d )
ENDIF
- IF( iom_use( "CO3sat" ) ) THEN
- zco3sat(:,:,jpk) = 0. ; CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3 * tmask(:,:,:) )
+ IF( iom_use( "CO3" ) ) THEN ! bicarbonate
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = zco3(ji,jj,jk) * 1.e+3 * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "CO3", zw3d )
ENDIF
- IF( iom_use( "DCAL" ) ) THEN
- zcaldiss(:,:,jpk) = 0. ; CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
+ IF( iom_use( "CO3sat" ) ) THEN ! calcite saturation
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zrhd = rhd(ji,jj,jk) + 1._wp
+ zw3d(ji,jj,jk) = aksp(ji,jj,jk) * zrhd / ( calcon * ( salinprac(ji,jj,jk) / 35._wp ) + rtrn ) &
+ & * 1.e+3 * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "CO3sat", zw3d )
+ ENDIF
+ DEALLOCATE( zw3d )
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
@@ -185,6 +215,9 @@ CONTAINS
! Number of seconds per month
rmtss = nyear_len(1) * rday / raamo
!
+ ! CE not really needed ; tempory, shoub be removed when quotan( A2D(0),jpk )
+ excess(:,:,:) = 0._wp
+ !
END SUBROUTINE p4z_lys_init
!!======================================================================
diff --git a/src/TOP/PISCES/P4Z/p4zmeso.F90 b/src/TOP/PISCES/P4Z/p4zmeso.F90
index 0033e0b8939a11324152aeec6fe0a82eeb086f71..d13609af7b0a9933c43c3e72e6f838ad3149dc82 100644
--- a/src/TOP/PISCES/P4Z/p4zmeso.F90
+++ b/src/TOP/PISCES/P4Z/p4zmeso.F90
@@ -52,6 +52,7 @@ MODULE p4zmeso
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: depmig !: DVM of mesozooplankton : migration depth
INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: kmig !: Vertical indice of the the migration depth
+ LOGICAL :: l_dia_fezoo2, l_dia_graz2, l_dia_lprodz2
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
@@ -89,16 +90,30 @@ CONTAINS
REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg, zrum, zcodel, zargu, zval, zdep
REAL(wp) :: zsigma, zdiffdn, ztmp1, ztmp2, ztmp3, ztmp4, ztmptot, zmigthick
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarem, zgraref, zgrapoc, zgrapof, zgrabsi
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zgrarem, zgraref, zgrapoc, zgrapof, zgrabsi
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigrem, zgramigref, zgramigpoc, zgramigpof
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigbsi
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zgrazing2, zfezoo2, zzligprod2, zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_meso')
!
- zgrazing(:,:,:) = 0._wp ; zgrapoc(:,:,:) = 0._wp
- zfezoo2 (:,:,:) = 0._wp ; zgrarem(:,:,:) = 0._wp
+ IF( kt == nittrc000 ) THEN
+ l_dia_graz2 = iom_use( "GRAZ2" )
+ l_dia_fezoo2 = iom_use( "FEZOO2" )
+ l_dia_lprodz2 = ln_ligand .AND. iom_use( "LPRODZ2" )
+ ENDIF
+ IF( l_dia_lprodz2 ) THEN
+ ALLOCATE( zzligprod2(A2D(0),jpk) )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zzligprod2(ji,jj,jk) = tr(ji,jj,jk,jplgw,Krhs)
+ END_3D
+ ENDIF
+ IF( l_dia_graz2 ) THEN
+ ALLOCATE( zgrazing2(A2D(0),jpk) )
+ ENDIF
+ !
+ zgrapoc(:,:,:) = 0._wp ; zgrarem(:,:,:) = 0._wp
zgraref (:,:,:) = 0._wp ; zgrapof(:,:,:) = 0._wp
zgrabsi (:,:,:) = 0._wp
!
@@ -108,7 +123,7 @@ CONTAINS
! ---------------------------------------------
IF (ln_dvm_meso) CALL p4z_meso_depmig( Kbb, Kmm )
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 )
zfact = xstep * tgfunc2(ji,jj,jk) * zcompam
@@ -210,6 +225,7 @@ CONTAINS
zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn)
!
zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazpoc + zgrazffep + zgrazffeg
+
! Compute the proportion of filter feeders. It is assumed steady state.
! ---------------------------------------------------------------------
zproport = 0._wp
@@ -247,14 +263,13 @@ CONTAINS
! Total ingestion rates in C, N, Fe
- zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazpoc + zgrazffep + zgrazffeg
+ zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazpoc + zgrazffep + zgrazffeg ! grazing by mesozooplankton
+ IF( l_dia_graz2 ) zgrazing2(ji,jj,jk) = zgraztotc
+
zgraztotn = zgrazdc * quotad(ji,jj,jk) + zgrazz + zgraznc * quotan(ji,jj,jk) &
& + zgrazpoc + zgrazffep + zgrazffeg
zgraztotf = zgrazdf + zgraznf + zgrazz * feratz + zgrazpof + zgrazfffp + zgrazfffg
- ! Total grazing ( grazing by microzoo is already computed in p4zmicro )
- zgrazing(ji,jj,jk) = zgraztotc
-
! Mesozooplankton efficiency.
! We adopt a formulation proposed by Mitra et al. (2007)
! The gross growth efficiency is controled by the most limiting nutrient.
@@ -345,7 +360,7 @@ CONTAINS
! This fraction is sumed over the euphotic zone and is removed from
! the fluxes driven by mesozooplankton in the euphotic zone.
! --------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk)
+ DO_3D( 0, 0, 0, 0, 1, jpk)
zmigreltime = (1. - strn(ji,jj))
zmigthick = (1. - zmigreltime ) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
IF ( gdept(ji,jj,jk,Kmm) <= heup(ji,jj) ) THEN
@@ -366,7 +381,7 @@ CONTAINS
! The inorganic and organic fluxes induced by migrating organisms are added at the
! the migration depth (corresponding indice is set by kmig)
! --------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 1.) THEN
jkt = kmig(ji,jj)
zdep = 1. / e3t(ji,jj,jkt,Kmm)
@@ -387,7 +402,7 @@ CONTAINS
! Update the arrays TRA which contain the biological sources and sinks
! This only concerns the variables which are affected by DVM (inorganic
! nutrients, DOC agands, and particulate organic carbon).
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk)
+ DO_3D( 0, 0, 0, 0, 1, jpk)
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarem(ji,jj,jk) * sigma2
tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarem(ji,jj,jk) * sigma2
tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem(ji,jj,jk) * ( 1. - sigma2 )
@@ -397,7 +412,6 @@ CONTAINS
!
tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem(ji,jj,jk) * sigma2
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref(ji,jj,jk)
- zfezoo2(ji,jj,jk) = zgraref(ji,jj,jk)
tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem(ji,jj,jk) * sigma2
tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarem(ji,jj,jk) * sigma2
tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zgrapoc(ji,jj,jk)
@@ -408,11 +422,45 @@ CONTAINS
!
! Write the output
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- CALL iom_put( "PCAL" , prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Calcite production
- CALL iom_put( "GRAZ2" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Total grazing of phyto by zoo
- CALL iom_put( "FEZOO2", zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
- IF( ln_ligand ) &
- & CALL iom_put( "LPRODZ2", zgrarem(ji,jj,jk) * ( 1. - sigma2 ) * ldocz * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
+ !
+ IF( iom_use ( "PCAL" ) ) THEN ! Calcite production
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = prodcal(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "PCAL", zw3d )
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ !
+ IF( l_dia_graz2 ) THEN ! Total grazing of phyto by zooplankton
+ zgrazing2(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zgrazing2(ji,jj,jk) = zgrazing2(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in mol/m2/s
+ END_3D
+ CALL iom_put( "GRAZ2" , zgrazing2 )
+ DEALLOCATE( zgrazing2 )
+ ENDIF
+ !
+ IF( l_dia_fezoo2 ) THEN
+ ALLOCATE( zfezoo2(A2D(0),jpk) ) ; zfezoo2(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfezoo2(ji,jj,jk) = zgraref(ji,jj,jk) * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "FEZOO2", zfezoo2 )
+ DEALLOCATE( zfezoo2 )
+ ENDIF
+ !
+ IF( l_dia_lprodz2 ) THEN
+ zzligprod2(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zzligprod2(ji,jj,jk) = ( tr(ji,jj,jk,jplgw,Krhs) - zzligprod2(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "LPRODZ2", zzligprod2 )
+ DEALLOCATE( zzligprod2 )
+ ENDIF
+ !
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
@@ -502,7 +550,7 @@ CONTAINS
INTEGER :: ji, jj, jk
!
REAL(wp) :: ztotchl, z1dep
- REAL(wp), DIMENSION(jpi,jpj) :: oxymoy, tempmoy, zdepmoy
+ REAL(wp), DIMENSION(A2D(0)) :: oxymoy, tempmoy, zdepmoy
!!---------------------------------------------------------------------
!
@@ -517,7 +565,7 @@ CONTAINS
! Compute the averaged values of oxygen, temperature over the domain
! 150m to 500 m depth.
! ------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk)
+ DO_3D( 0, 0, 0, 0, 1, jpk)
IF( tmask(ji,jj,jk) == 1.) THEN
IF( gdept(ji,jj,jk,Kmm) >= 150. .AND. gdept(ji,jj,jk,kmm) <= 500.) THEN
oxymoy(ji,jj) = oxymoy(ji,jj) + tr(ji,jj,jk,jpoxy,Kbb) * 1E6 * e3t(ji,jj,jk,Kmm)
@@ -530,7 +578,7 @@ CONTAINS
! Compute the difference between surface values and the mean values in the mesopelagic
! domain
! ------------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
z1dep = 1. / ( zdepmoy(ji,jj) + rtrn )
oxymoy(ji,jj) = tr(ji,jj,1,jpoxy,Kbb) * 1E6 - oxymoy(ji,jj) * z1dep
tempmoy(ji,jj) = ts(ji,jj,1,jp_tem,Kmm) - tempmoy(ji,jj) * z1dep
@@ -539,7 +587,7 @@ CONTAINS
! Computation of the migration depth based on the parameterization of
! Bianchi et al. (2013)
! -------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 1. ) THEN
ztotchl = ( tr(ji,jj,1,jpnch,Kbb) + tr(ji,jj,1,jpdch,Kbb) ) * 1E6
depmig(ji,jj) = 398. - 0.56 * oxymoy(ji,jj) -115. * log10(ztotchl) + 0.36 * hmld(ji,jj) -2.4 * tempmoy(ji,jj)
@@ -548,7 +596,7 @@ CONTAINS
!
! Computation of the corresponding jk indice
! ------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( depmig(ji,jj) >= gdepw(ji,jj,jk,Kmm) .AND. depmig(ji,jj) < gdepw(ji,jj,jk+1,Kmm) ) THEN
kmig(ji,jj) = jk
ENDIF
@@ -560,7 +608,7 @@ CONTAINS
! to 0. Thus, to avoid that problem, the migration depth is adjusted so
! that it falls above the OMZ
! -----------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tr(ji,jj,kmig(ji,jj),jpoxy,Kbb) < 5E-6 ) THEN
DO jk = kmig(ji,jj),1,-1
IF( tr(ji,jj,jk,jpoxy,Kbb) >= 5E-6 .AND. tr(ji,jj,jk+1,jpoxy,Kbb) < 5E-6) THEN
@@ -580,7 +628,7 @@ CONTAINS
!! *** ROUTINE p4z_meso_alloc ***
!!----------------------------------------------------------------------
!
- ALLOCATE( depmig(jpi,jpj), kmig(jpi,jpj), STAT= p4z_meso_alloc )
+ ALLOCATE( depmig(A2D(0)), kmig(A2D(0)), STAT= p4z_meso_alloc )
!
IF( p4z_meso_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_meso_alloc : failed to allocate arrays.' )
!
diff --git a/src/TOP/PISCES/P4Z/p4zmicro.F90 b/src/TOP/PISCES/P4Z/p4zmicro.F90
index f91b04d7f185c17ab3e6145823c730a9b39a334e..a18a41e354263d91c56b7975815781a2d21240b9 100644
--- a/src/TOP/PISCES/P4Z/p4zmicro.F90
+++ b/src/TOP/PISCES/P4Z/p4zmicro.F90
@@ -44,6 +44,8 @@ MODULE p4zmicro
REAL(wp), PUBLIC :: xsigma !: Width of the grazing window
REAL(wp), PUBLIC :: xsigmadel !: Maximum additional width of the grazing window at low food density
+ LOGICAL :: l_dia_fezoo, l_dia_graz1, l_dia_lprodz
+
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
@@ -78,20 +80,35 @@ CONTAINS
REAL(wp) :: zrespz, ztortz, zgrasratf, zgrasratn
REAL(wp) :: zgraznc, zgrazpoc, zgrazdc, zgrazpof, zgrazdf, zgraznf
REAL(wp) :: zsigma, zdiffdn, ztmp1, ztmp2, ztmp3, ztmptot, zproport
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zzligprod
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zgrazing, zfezoo, zzligprod
CHARACTER (len=25) :: charout
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_micro')
!
- IF (ln_ligand) THEN
- ALLOCATE( zzligprod(jpi,jpj,jpk) )
- zzligprod(:,:,:) = 0._wp
+ IF( kt == nittrc000 ) THEN
+ l_dia_graz1 = iom_use( "GRAZ1" )
+ l_dia_fezoo = iom_use( "FEZOO" )
+ l_dia_lprodz = ln_ligand .AND. iom_use( "LPRODZ" )
+ ENDIF
+ IF( l_dia_lprodz ) THEN
+ ALLOCATE( zzligprod(A2D(0),jpk) )
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zzligprod(ji,jj,jk) = tr(ji,jj,jk,jplgw,Krhs)
+ END_3D
+ ENDIF
+ IF( l_dia_fezoo ) THEN
+ ALLOCATE( zfezoo(A2D(0),jpk) )
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zfezoo(ji,jj,jk) = tr(ji,jj,jk,jpfer,Krhs)
+ END_3D
+ ENDIF
+ IF( l_dia_graz1 ) THEN
+ ALLOCATE( zgrazing(A2D(0),jpk) )
ENDIF
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 )
zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz
@@ -170,14 +187,12 @@ CONTAINS
zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
!
! Total ingestion rate in C, Fe, N units
- zgraztotc = zgraznc + zgrazpoc + zgrazdc
+ zgraztotc = zgraznc + zgrazpoc + zgrazdc ! grazing by microzooplankton
+ IF( l_dia_graz1 ) zgrazing(ji,jj,jk) = zgraztotc
+
zgraztotf = zgraznf + zgrazdf + zgrazpof
zgraztotn = zgraznc * quotan(ji,jj,jk) + zgrazpoc + zgrazdc * quotad(ji,jj,jk)
- ! Grazing by microzooplankton
- zgrazing(ji,jj,jk) = zgraztotc
-
-
! Microzooplankton efficiency.
! We adopt a formulation proposed by Mitra et al. (2007)
! The gross growth efficiency is controled by the most limiting nutrient.
@@ -215,12 +230,10 @@ CONTAINS
!
IF( ln_ligand ) THEN
tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz
- zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz
ENDIF
!
tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer
- zfezoo(ji,jj,jk) = zgrafer
tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc
prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc
tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass
@@ -257,15 +270,36 @@ CONTAINS
END_3D
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- IF( iom_use("GRAZ1") ) THEN ! Total grazing of phyto by zooplankton
- zgrazing(:,:,jpk) = 0._wp ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
- IF( iom_use("FEZOO") ) THEN
- zfezoo (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO", zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
- IF( ln_ligand ) THEN
- zzligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:))
- ENDIF
+ !
+ IF( l_dia_graz1 ) THEN ! Total grazing of phyto by zooplankton
+ zgrazing(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zgrazing(ji,jj,jk) = zgrazing(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in mol/m2/s
+ END_3D
+ CALL iom_put( "GRAZ1" , zgrazing )
+ DEALLOCATE( zgrazing )
+ ENDIF
+ !
+ IF( l_dia_fezoo ) THEN
+ zfezoo(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfezoo(ji,jj,jk) = ( tr(ji,jj,jk,jpfer,Krhs) - zfezoo(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "FEZOO", zfezoo )
+ DEALLOCATE( zfezoo )
+ ENDIF
+ !
+ IF( l_dia_lprodz ) THEN
+ zzligprod(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zzligprod(ji,jj,jk) = ( tr(ji,jj,jk,jplgw,Krhs) - zzligprod(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "LPRODZ", zzligprod )
+ DEALLOCATE( zzligprod )
+ ENDIF
+ !
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
diff --git a/src/TOP/PISCES/P4Z/p4zmort.F90 b/src/TOP/PISCES/P4Z/p4zmort.F90
index 5a32dd99e4341c5d454219a9586fdec6bb3b7449..3c3903e748d7ef659c834daf32842ee664dceac2 100644
--- a/src/TOP/PISCES/P4Z/p4zmort.F90
+++ b/src/TOP/PISCES/P4Z/p4zmort.F90
@@ -74,7 +74,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('p4z_mort_nano')
!
prodcal(:,:,:) = 0._wp ! calcite production variable set to zero
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 )
! Quadratic mortality of nano due to aggregation during
@@ -152,7 +152,7 @@ CONTAINS
! This is due to the production of EPS by stressed cells
! -------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. )
diff --git a/src/TOP/PISCES/P4Z/p4zopt.F90 b/src/TOP/PISCES/P4Z/p4zopt.F90
index 8daf2edf7158c96c2bc66a17c5225e52ba819a7a..8ff01e2ce7be882b02c7d689b7c3e9a2d4156b68 100644
--- a/src/TOP/PISCES/P4Z/p4zopt.F90
+++ b/src/TOP/PISCES/P4Z/p4zopt.F90
@@ -36,7 +36,9 @@ MODULE p4zopt
INTEGER :: ntimes_par ! number of time steps in a file
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw ! PAR fraction of shortwave
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr ! wavelength (Red-Green-Blue)
-
+
+ LOGICAL :: l_dia_heup, l_dia_par
+
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
@@ -63,21 +65,28 @@ CONTAINS
INTEGER :: irgb
REAL(wp) :: zchl
REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep
- REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zetmp5
- REAL(wp), DIMENSION(jpi,jpj ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4
- REAL(wp), DIMENSION(jpi,jpj ) :: zqsr100, zqsr_corr
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpar, ze0, ze1, ze2, ze3
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zetmp5
+ REAL(wp), DIMENSION(A2D(0) ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4
+ REAL(wp), DIMENSION(A2D(0) ) :: zqsr100, zqsr_corr
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zpar, ze0, ze1, ze2, ze3
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
+ REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_opt')
+ IF( kt == nittrc000 ) THEN
+ l_dia_heup = iom_use( "Heup")
+ l_dia_par = iom_use( "PAR" )
+ ENDIF
+
IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
! Initialisation of variables used to compute PAR
! -----------------------------------------------
- ze1(:,:,:) = 0._wp
- ze2(:,:,:) = 0._wp
- ze3(:,:,:) = 0._wp
+! ze1(:,:,:) = 0._wp
+! ze2(:,:,:) = 0._wp
+! ze3(:,:,:) = 0._wp
!
! Attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
@@ -88,7 +97,7 @@ CONTAINS
!
! Computation of the light attenuation parameters based on a
! look-up table
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zchl = ( tr(ji,jj,jk,jpnch,Kbb) + tr(ji,jj,jk,jpdch,Kbb) + rtrn ) * 1.e6
IF( ln_p5z ) zchl = zchl + tr(ji,jj,jk,jppch,Kbb) * 1.e6
zchl = MIN( 10. , MAX( 0.05, zchl ) )
@@ -116,36 +125,40 @@ CONTAINS
! not fully correct with LIM3 and SI3 but no information is
! currently available to do a better job. SHould be improved in the
! (near) future.
- zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn )
+ DO_2D( 0, 0, 0, 0 )
+ zqsr_corr(ji,jj) = qsr_mean(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
+ END_2D
!
CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )
!
! Used PAR is computed for each phytoplankton species
! etot_ndcy is PAR at level jk averaged over 24h.
! Due to their size, they have different light absorption characteristics
- DO jk = 1, nksr
- etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
- END DO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ etot_ndcy(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
+ END_3D
!
! SW over the ice free zone of the grid cell. This assumes that
! SW is zero below sea ice which is a very crude assumption that is
! not fully correct with LIM3 and SI3 but no information is
! currently available to do a better job. SHould be improved in the
! (near) future.
- zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
+ DO_2D( 0, 0, 0, 0 )
+ zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
+ END_2D
!
CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )
!
! Total PAR computation at level jk that includes the diurnal cycle
- DO jk = 1, nksr
- etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
- enano(:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk)
- ediat(:,:,jk) = 1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk)
- END DO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ etot (ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
+ enano(ji,jj,jk) = 1.85 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.46 * ze3(ji,jj,jk)
+ ediat(ji,jj,jk) = 1.62 * ze1(ji,jj,jk) + 0.74 * ze2(ji,jj,jk) + 0.63 * ze3(ji,jj,jk)
+ END_3D
IF( ln_p5z ) THEN
- DO jk = 1, nksr
- epico (:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
- END DO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ epico(ji,jj,jk) = 1.94 * ze1(ji,jj,jk) + 0.66 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk)
+ END_3D
ENDIF
ELSE ! No diurnal cycle in PISCES
@@ -157,22 +170,24 @@ CONTAINS
! not fully correct with LIM3 and SI3 but no information is
! currently available to do a better job. SHould be improved in the
! (near) future.
- zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn )
+ DO_2D( 0, 0, 0, 0 )
+ zqsr_corr(ji,jj) = qsr_mean(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
+ END_2D
!
CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )
!
! Used PAR is computed for each phytoplankton species
! etot_ndcy is PAR at level jk averaged over 24h.
! Due to their size, they have different light absorption characteristics
- DO jk = 1, nksr
- etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
- enano (:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk)
- ediat (:,:,jk) = 1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk)
- END DO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ etot_ndcy(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
+ enano (ji,jj,jk) = 1.85 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.46 * ze3(ji,jj,jk)
+ ediat (ji,jj,jk) = 1.62 * ze1(ji,jj,jk) + 0.74 * ze2(ji,jj,jk) + 0.63 * ze3(ji,jj,jk)
+ END_3D
IF( ln_p5z ) THEN
- DO jk = 1, nksr
- epico (:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
- END DO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ epico(ji,jj,jk) = 1.94 * ze1(ji,jj,jk) + 0.66 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk)
+ END_3D
ENDIF
!
! SW over the ice free zone of the grid cell. This assumes that
@@ -180,14 +195,16 @@ CONTAINS
! not fully correct with LIM3 and SI3 but no information is
! currently available to do a better job. SHould be improved in the
! (near) future.
- zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
+ DO_2D( 0, 0, 0, 0 )
+ zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
+ END_2D
!
CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )
!
! Total PAR computation at level jk that includes the diurnal cycle
- DO jk = 1, nksr
- etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
- END DO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ etot(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
+ END_3D
ENDIF
!
ELSE ! no diurnal cycle
@@ -198,22 +215,24 @@ CONTAINS
! not fully correct with LIM3 and SI3 but no information is
! currently available to do a better job. SHould be improved in the
! (near) future.
- zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
+ DO_2D( 0, 0, 0, 0 )
+ zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
+ END_2D
!
CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )
!
! Used PAR is computed for each phytoplankton species
! Due to their size, they have different light absorption characteristics
- DO jk = 1, nksr
- etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ! Total PAR
- enano(:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) ! Nanophytoplankton
- ediat(:,:,jk) = 1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk) ! Diatoms
- END DO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ etot (ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
+ enano(ji,jj,jk) = 1.85 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.46 * ze3(ji,jj,jk)
+ ediat(ji,jj,jk) = 1.62 * ze1(ji,jj,jk) + 0.74 * ze2(ji,jj,jk) + 0.63 * ze3(ji,jj,jk)
+ END_3D
IF( ln_p5z ) THEN
- DO jk = 1, nksr
- epico(:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) ! Picophytoplankton (PISCES-QUOTA)
- END DO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ epico(ji,jj,jk) = 1.94 * ze1(ji,jj,jk) + 0.66 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) ! Picophytoplankton (PISCES-QUOTA)
+ END_3D
ENDIF
etot_ndcy(:,:,:) = etot(:,:,:)
ENDIF
@@ -224,10 +243,12 @@ CONTAINS
! ! ------------------------
CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 )
!
- etot3(:,:,1) = qsr(:,:) * tmask(:,:,1)
- DO jk = 2, nksr + 1
- etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
- END DO
+ DO_2D( 0, 0, 0, 0 )
+ etot3(ji,jj,1) = qsr(ji,jj) * tmask(ji,jj,1)
+ END_2D
+ DO_3D( 0, 0, 0, 0, 2, nksr+1 )
+ etot3(ji,jj,jk) = ( ze0(ji,jj,jk) + ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) ) * tmask(ji,jj,jk)
+ END_3D
! ! ------------------------
ENDIF
@@ -236,11 +257,13 @@ CONTAINS
! (1) The classical definition based on the relative threshold value
! (2) An alternative definition based on a absolute threshold value.
! -------------------------------------------------------------------
- neln(:,:) = 1
- heup (:,:) = gdepw(:,:,2,Kmm)
- heup_01(:,:) = gdepw(:,:,2,Kmm)
+ DO_2D( 0, 0, 0, 0 )
+ neln (ji,jj) = 1
+ heup (ji,jj) = gdepw(ji,jj,2,Kmm)
+ heup_01(ji,jj) = gdepw(ji,jj,2,Kmm)
+ END_2D
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr)
+ DO_3D( 0, 0, 0, 0, 2, nksr)
IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN
neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer
! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
@@ -261,7 +284,7 @@ CONTAINS
zetmp1 (:,:) = 0.e0
zetmp2 (:,:) = 0.e0
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr)
+ DO_3D( 0, 0, 0, 0, 1, nksr)
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! Actual PAR for remineralisation
zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! Par averaged over 24h for production
@@ -272,7 +295,7 @@ CONTAINS
emoy(:,:,:) = etot(:,:,:) ! remineralisation
zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr)
+ DO_3D( 0, 0, 0, 0, 1, nksr)
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
@@ -286,7 +309,7 @@ CONTAINS
zetmp3 (:,:) = 0.e0
zetmp4 (:,:) = 0.e0
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr)
+ DO_3D( 0, 0, 0, 0, 1, nksr)
IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! Nanophytoplankton
zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! Diatoms
@@ -296,7 +319,7 @@ CONTAINS
enanom(:,:,:) = enano(:,:,:)
ediatm(:,:,:) = ediat(:,:,:)
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr)
+ DO_3D( 0, 0, 0, 0, 1, nksr)
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
@@ -306,8 +329,8 @@ CONTAINS
!
IF( ln_p5z ) THEN
! Picophytoplankton when using PISCES-QUOTA
- ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr)
+ ALLOCATE( zetmp5(A2D(0)) ) ; zetmp5 (:,:) = 0.e0
+ DO_3D( 0, 0, 0, 0, 1, nksr)
IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm)
ENDIF
@@ -315,7 +338,7 @@ CONTAINS
!
epicom(:,:,:) = epico(:,:,:)
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr)
+ DO_3D( 0, 0, 0, 0, 1, nksr)
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
@@ -325,10 +348,24 @@ CONTAINS
ENDIF
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht
- IF( iom_use( "PAR" ) ) THEN
- zpar(:,:,1) = zpar(:,:,1) * ( 1._wp - fr_i(:,:) )
- CALL iom_put( "PAR", zpar(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation
+ IF( l_dia_heup ) THEN
+ ALLOCATE( zw2d(A2D(0)) )
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = heup(ji,jj) * tmask(ji,jj,1)
+ END_2D
+ CALL iom_put( "Heup", zw2d ) ! Euphotic layer depth
+ DEALLOCATE( zw2d )
+ ENDIF
+ IF( l_dia_par ) THEN
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_2D( 0, 0, 0, 0 )
+ zw3d(ji,jj,1) = zpar(ji,jj,1) * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,1)
+ END_2D
+ DO_3D( 0, 0, 0, 0, 2, jpkm1)
+ zw3d(ji,jj,jk) = zpar(ji,jj,jk) * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "PAR", zw3d ) ! Photosynthetically Available Radiation
+ DEALLOCATE( zw3d )
ENDIF
ENDIF
!
@@ -345,15 +382,15 @@ CONTAINS
!! for a given shortwave radiation
!!
!!----------------------------------------------------------------------
- INTEGER , INTENT(in) :: kt ! ocean time-step
- INTEGER , INTENT(in) :: Kmm ! ocean time-index
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pqsr ! shortwave
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B)
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 !
- REAL(wp), DIMENSION(jpi,jpj) , INTENT( out), OPTIONAL :: pqsr100 !
+ INTEGER , INTENT(in) :: kt ! ocean time-step
+ INTEGER , INTENT(in) :: Kmm ! ocean time-index
+ REAL(wp), DIMENSION(A2D(0)) , INTENT(in ) :: pqsr ! shortwave
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B)
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(inout), OPTIONAL :: pe0 !
+ REAL(wp), DIMENSION(A2D(0)) , INTENT( out), OPTIONAL :: pqsr100 !
!
INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp), DIMENSION(jpi,jpj) :: zqsr ! shortwave
+ REAL(wp), DIMENSION(A2D(0)) :: zqsr ! shortwave
!!----------------------------------------------------------------------
! Real shortwave
@@ -371,7 +408,7 @@ CONTAINS
pe2(:,:,1) = zqsr(:,:)
pe3(:,:,1) = zqsr(:,:)
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr + 1)
+ DO_3D( 0, 0, 0, 0, 2, nksr + 1)
pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r )
pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) )
pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) )
@@ -384,7 +421,7 @@ CONTAINS
pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr)
+ DO_3D( 0, 0, 0, 0, 2, nksr)
pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
@@ -419,7 +456,9 @@ CONTAINS
IF( ln_varpar ) THEN
IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN
CALL fld_read( kt, 1, sf_par )
- par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
+ DO_2D( 0, 0, 0, 0 )
+ par_varsw(ji,jj) = ( sf_par(1)%fnow(ji,jj,1) ) / 3.0
+ END_2D
ENDIF
ENDIF
!
@@ -479,7 +518,7 @@ CONTAINS
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' ==>>> initialize variable par fraction (ln_varpar=T)'
!
- ALLOCATE( par_varsw(jpi,jpj) )
+ ALLOCATE( par_varsw(A2D(0)) )
!
ALLOCATE( sf_par(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst
IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_opt_init: unable to allocate sf_par structure' )
@@ -510,8 +549,7 @@ CONTAINS
!! *** ROUTINE p4z_opt_alloc ***
!!----------------------------------------------------------------------
!
- ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), &
- ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc )
+ ALLOCATE( ekb(A2D(0),jpk), ekr(A2D(0),jpk), ekg(A2D(0),jpk), STAT= p4z_opt_alloc )
!
IF( p4z_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_opt_alloc : failed to allocate arrays.' )
!
diff --git a/src/TOP/PISCES/P4Z/p4zpoc.F90 b/src/TOP/PISCES/P4Z/p4zpoc.F90
index 54b8f202e626b8367f6da45d6a2181337bf2f339..37347fce0c8b851ffb541f9c2913b87fb4b2af96 100644
--- a/src/TOP/PISCES/P4Z/p4zpoc.F90
+++ b/src/TOP/PISCES/P4Z/p4zpoc.F90
@@ -38,6 +38,8 @@ MODULE p4zpoc
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: alphan, reminp !: variable lability of POC and initial distribution
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: alphap !: lability distribution of small particles
+ REAL(wp ) :: solgoc
+ LOGICAL :: l_dia_remin_part
!! * Substitutions
# include "do_loop_substitute.h90"
@@ -70,40 +72,32 @@ CONTAINS
INTEGER :: ji, jj, jk, jn
REAL(wp) :: zremip, zremig, zdep, zorem, zorem2, zofer
REAL(wp) :: zopon, zopop, zopoc, zopoc2, zopon2, zopop2
- REAL(wp) :: zsizek, zsizek1, alphat, remint, solgoc, zpoc
+ REAL(wp) :: zsizek, zsizek1, alphat, remint, zpoc, zremipart
REAL(wp) :: zofer2, zofer3
- REAL(wp) :: zrfact2
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj ) :: totprod, totthick, totcons
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zremipoc, zremigoc, zorem3, ztremint, zfolimi
- REAL(wp), DIMENSION(jpi,jpj,jpk,jcpoc) :: alphag
+ REAL(wp), DIMENSION(A2D(0) ) :: totprod, totthick, totcons
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zorem3, ztremint
+ REAL(wp), DIMENSION(A2D(0),jpk,jcpoc) :: alphag
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zremipoc, zremigoc, zfolimi
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_poc')
!
- ! Initialization of local variables
- ! ---------------------------------
-
- ! Here we compute the GOC -> POC rate due to the shrinking
- ! of the fecal pellets/aggregates as a result of bacterial
- ! solubilization
- ! This is based on a fractal dimension of 2.56 and a spectral
- ! slope of -3.6 (identical to what is used in p4zsink to compute
- ! aggregation
- solgoc = 0.04/ 2.56 * 1./ ( 1.-50**(-0.04) )
-
+ IF( kt == nittrc000 ) &
+ & l_dia_remin_part = iom_use( "REMINP" ) .OR. iom_use( "REMING" ) .OR. iom_use( "REMINF" )
+ !
+ IF( l_dia_remin_part ) THEN
+ ALLOCATE( zfolimi (A2D(0),jpk) ) ; zfolimi (A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfolimi (ji,jj,jk) = tr(ji,jj,jk,jpfer,Krhs)
+ END_3D
+ ENDIF
! Initialisation of temporary arrays
- IF( ln_p4z ) THEN
- zremipoc(:,:,:) = xremip
- zremigoc(:,:,:) = xremip
- ELSE ! ln_p5z
- zremipoc(:,:,:) = xremipc
- zremigoc(:,:,:) = xremipc
+ IF( ln_p4z ) THEN ; ztremint(:,:,:) = xremip
+ ELSE ; ztremint(:,:,:) = xremipc ! ln_p5z
ENDIF
zorem3(:,:,:) = 0.
orem (:,:,:) = 0.
- ztremint(:,:,:) = 0.
- zfolimi (:,:,:) = 0.
! Initialisation of the lability distributions that are set to
! the distribution of newly produced organic particles
@@ -117,8 +111,7 @@ CONTAINS
! lability class is specified in the namelist, this is equivalent to
! a standard parameterisation with a constant lability
! -----------------------------------------------------------------------
- ztremint(:,:,:) = zremigoc(:,:,:)
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF (tmask(ji,jj,jk) == 1.) THEN
zdep = hmld(ji,jj)
!
@@ -197,19 +190,23 @@ CONTAINS
ENDIF
ENDIF
END_3D
-
- IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
- ELSE ; zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )
- ENDIF
-
- IF( ln_p4z ) THEN
+ !
+ IF( l_dia_remin_part ) THEN
+ ALLOCATE( zremigoc(A2D(0),jpk) ) ; zremigoc(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zremigoc(ji,jj,jk) = tr(ji,jj,jk,jpdoc,Krhs)
+ END_3D
+ ENDIF
+ !
+ IF( ln_p4z ) THEN
! The standard PISCES part
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! POC degradation by bacterial activity. It is a function
! of the mean lability and of temperature. This also includes
! shrinking of particles due to the bacterial activity
! -----------------------------------------------------------
- zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+ zremipart = MIN( xremip, ztremint(ji,jj,jk) )
+ zremig = zremipart * xstep * tgfunc(ji,jj,jk)
zorem2 = zremig * tr(ji,jj,jk,jpgoc,Kbb)
orem(ji,jj,jk) = zorem2
zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb)
@@ -223,15 +220,15 @@ CONTAINS
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3
tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2
- zfolimi(ji,jj,jk) = zofer2
END_3D
ELSE
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! POC degradation by bacterial activity. It is a function
! of the mean lability and of temperature. This also includes
! shrinking of particles due to the bacterial activity
! --------------------------------------------------------
- zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+ zremipart = MIN( xremipc, ztremint(ji,jj,jk) )
+ zremig = zremipart * xstep * tgfunc(ji,jj,jk)
zopoc2 = zremig * tr(ji,jj,jk,jpgoc,Kbb)
orem(ji,jj,jk) = zopoc2
zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb)
@@ -252,7 +249,12 @@ CONTAINS
tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc)
tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc)
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc)
- zfolimi(ji,jj,jk) = zofer2
+ END_3D
+ ENDIF
+ IF( l_dia_remin_part ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zremigoc(ji,jj,jk) = ( tr(ji,jj,jk,jpdoc,Krhs) - zremigoc(ji,jj,jk) ) / &
+ ( xstep * tgfunc(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) * tmask(ji,jj,jk) ! =zremipart
END_3D
ENDIF
@@ -274,7 +276,7 @@ CONTAINS
! intregrated production and consumption of POC in the mixed layer
! ----------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zdep = hmld(ji,jj)
IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN
totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2
@@ -289,8 +291,7 @@ CONTAINS
! layer, this spectrum is supposed to be uniform as a result of intense
! mixing.
! ---------------------------------------------------------------------
- ztremint(:,:,:) = zremipoc(:,:,:)
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF (tmask(ji,jj,jk) == 1.) THEN
zdep = hmld(ji,jj)
alphat = 0.0
@@ -313,9 +314,6 @@ CONTAINS
ENDIF
END_3D
!
- IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
- ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )
- ENDIF
! The lability parameterization is used here. The code is here
! almost identical to what is done for big particles. The only difference
@@ -323,7 +321,7 @@ CONTAINS
! that since we need the lability spectrum of GOC, GOC spectrum
! should be determined before.
! -----------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1)
+ DO_3D( 0, 0, 0, 0, 2, jpkm1)
IF (tmask(ji,jj,jk) == 1.) THEN
zdep = hmld(ji,jj)
IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN
@@ -392,19 +390,22 @@ CONTAINS
ENDIF
END_3D
- IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
- ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )
+ IF( l_dia_remin_part ) THEN
+ ALLOCATE( zremipoc(A2D(0),jpk) ) ; zremipoc(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zremipoc(ji,jj,jk) = tr(ji,jj,jk,jpdoc,Krhs)
+ END_3D
ENDIF
-
IF( ln_p4z ) THEN
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF (tmask(ji,jj,jk) == 1.) THEN
! POC disaggregation by turbulence and bacterial activity.It is a function
! of the mean lability and of temperature
! --------------------------------------------------------
- zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
- zorem = zremip * tr(ji,jj,jk,jppoc,Kbb)
- zofer = zremip * tr(ji,jj,jk,jpsfe,Kbb)
+ zremipart = MIN( xremip, ztremint(ji,jj,jk) )
+ zremip = zremipart * xstep * tgfunc(ji,jj,jk)
+ zorem = zremip * tr(ji,jj,jk,jppoc,Kbb)
+ zofer = zremip * tr(ji,jj,jk,jpsfe,Kbb)
! Update of the TRA arrays
tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem
@@ -412,15 +413,15 @@ CONTAINS
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer
tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem
tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer
- zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer
ENDIF
END_3D
ELSE
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! POC disaggregation by turbulence and bacterial activity.It is a function
! of the mean lability and of temperature
!--------------------------------------------------------
- zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+ zremipart = MIN( xremipc, ztremint(ji,jj,jk) )
+ zremip = zremipart * xstep * tgfunc(ji,jj,jk)
zopoc = zremip * tr(ji,jj,jk,jppoc,Kbb)
orem(ji,jj,jk) = orem(ji,jj,jk) + zopoc
zopon = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb)
@@ -436,16 +437,22 @@ CONTAINS
tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon
tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer
- zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer
END_3D
ENDIF
+ IF( l_dia_remin_part ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zremipoc(ji,jj,jk) = ( tr(ji,jj,jk,jpdoc,Krhs) - zremipoc(ji,jj,jk) ) / &
+ ( xstep * tgfunc(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) + rtrn ) * tmask(ji,jj,jk)
+ zfolimi (ji,jj,jk) = ( tr(ji,jj,jk,jpfer,Krhs) - zfolimi (ji,jj,jk) ) * tmask(ji,jj,jk)
+ END_3D
+ ENDIF
- IF( lk_iomput ) THEN
- IF( knt == nrdttrc ) THEN
- zrfact2 = 1.e3 * rfact2r
- CALL iom_put( "REMINP" , zremipoc(:,:,:) * tmask(:,:,:) ) ! Remineralisation rate of small particles
- CALL iom_put( "REMING" , zremigoc(:,:,:) * tmask(:,:,:) ) ! Remineralisation rate of large particles
- CALL iom_put( "REMINF" , zfolimi(:,:,:) * tmask(:,:,:) * 1.e+9 * zrfact2 ) ! Remineralisation of biogenic particulate iron
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN
+ IF( l_dia_remin_part ) THEN
+ CALL iom_put( "REMINP", zremipoc ) ! Remineralisation rate of small particles
+ CALL iom_put( "REMING", zremigoc ) ! Remineralisation rate of large particles
+ CALL iom_put( "REMINF", zfolimi * 1.e+9 * 1.e3 * rfact2r ) ! Remineralisation of biogenic particulate iron
+ DEALLOCATE ( zremipoc, zremigoc, zfolimi )
ENDIF
ENDIF
@@ -508,7 +515,7 @@ CONTAINS
! Discretization along the lability space
! ---------------------------------------
!
- ALLOCATE( alphan(jcpoc) , reminp(jcpoc) , alphap(jpi,jpj,jpk,jcpoc) )
+ ALLOCATE( alphan(jcpoc) , reminp(jcpoc) , alphap(A2D(0),jpk,jcpoc) )
!
IF (jcpoc > 1) THEN ! Case when more than one lability class is used
!
@@ -543,6 +550,14 @@ CONTAINS
alphap(:,:,:,jn) = alphan(jn)
END DO
+ ! Here we compute the GOC -> POC rate due to the shrinking
+ ! of the fecal pellets/aggregates as a result of bacterial
+ ! solubilization
+ ! This is based on a fractal dimension of 2.56 and a spectral
+ ! slope of -3.6 (identical to what is used in p4zsink to compute
+ ! aggregation
+ solgoc = 0.04/ 2.56 * 1./ ( 1.-50**(-0.04) )
+
END SUBROUTINE p4z_poc_init
diff --git a/src/TOP/PISCES/P4Z/p4zprod.F90 b/src/TOP/PISCES/P4Z/p4zprod.F90
index 59ca90ccc62b5933ddad31ffff1460965cfc528d..6a89fb6a0cc7f4acee4169a3db544176e4db8168 100644
--- a/src/TOP/PISCES/P4Z/p4zprod.F90
+++ b/src/TOP/PISCES/P4Z/p4zprod.F90
@@ -45,6 +45,8 @@ MODULE p4zprod
REAL(wp) :: texcretn ! 1 - excretn
REAL(wp) :: texcretd ! 1 - excretd
+ LOGICAL :: l_dia_ppphy, l_dia_ppnew, l_dia_ppbfe, l_dia_ppbsi
+ LOGICAL :: l_dia_mu, l_dia_light, l_dia_lprod
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
@@ -75,32 +77,38 @@ CONTAINS
REAL(wp) :: zproddoc, zprodsil, zprodfer, zprodlig
REAL(wp) :: zpislopen, zpisloped, zfact
REAL(wp) :: zratiosi, zmaxsi, zlimfac, zsizetmp, zfecnm, zfecdm
- REAL(wp) :: zprod, zval
+ REAL(wp) :: zprod, zval, zmxl_fac, zmxl_chl, zpronewn, zpronewd
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprmaxn,zprmaxd
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadd, zysopt
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprdia, zprbio, zprchld, zprchln
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcad, zprofed, zprofen
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewd
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zpligprod
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprmax, zmxl
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zpislopeadn, zpislopeadd, zysopt
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprdia, zprbio, zprchld, zprchln
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprorcan, zprorcad
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprofed, zprofen
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_prod')
!
- ! Allocate temporary workspace
- !
- zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed(:,:,:) = 0._wp
- zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp
- zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia(:,:,:) = 0._wp
- zprbio (:,:,:) = 0._wp ; zprchld (:,:,:) = 0._wp ; zprchln(:,:,:) = 0._wp
- zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp
+ IF( kt == nittrc000 ) THEN
+ l_dia_ppphy = iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) .OR. iom_use( "TPP" )
+ l_dia_ppnew = iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) .OR. iom_use( "TPNEW")
+ l_dia_ppbfe = iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) .OR. iom_use( "TPBFE")
+ l_dia_ppbsi = iom_use( "PBSi" )
+ l_dia_mu = iom_use( "Mumax" ) .OR. iom_use( "MuN" ) .OR. iom_use( "MuD")
+ l_dia_light = iom_use( "LNlight") .OR. iom_use( "LDlight")
+ l_dia_lprod = ln_ligand .AND. ( iom_use( "LPRODP") .OR. iom_use( "LDETP") )
+ ENDIF
+
+ ! Initialize the local arrays
+ zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp
+ zprofen (:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp
+ zprchld (:,:,:) = 0._wp ; zprchln (:,:,:) = 0._wp
+ zprbio (:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp
+ zmxl (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp
! Computation of the maximimum production. Based on a Q10 description
- ! of the thermal dependency
- ! Parameters are taken from Bissinger et al. (2008)
- zprmaxn(:,:,:) = 0.65_wp * r1_rday * tgfunc(:,:,:)
- zprmaxd(:,:,:) = zprmaxn(:,:,:)
+ ! of the thermal dependency. Parameters are taken from Bissinger et al. (2008)
+ zprmax(:,:,:) = 0.65_wp * r1_rday * tgfunc(:,:,:)
! Intermittency is supposed to have a similar effect on production as
! day length (Shatwell et al., 2012). The correcting factor is zmxl_fac.
@@ -109,39 +117,39 @@ CONTAINS
! absolute light level definition of the euphotic zone
! -------------------------------------------------------------------------
IF ( ln_p4z_dcyc ) THEN ! Diurnal cycle in PISCES
-
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
zval = MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
ENDIF
- zmxl_chl(ji,jj,jk) = zval / 24.
- zmxl_fac(ji,jj,jk) = 1.0 - exp( -0.26 * zval )
+ zmxl(ji,jj,jk) = zval
ENDIF
END_3D
-
ELSE ! No diurnal cycle in PISCES
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
zval = MAX( 1., strn(ji,jj) )
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
ENDIF
- zmxl_chl(ji,jj,jk) = zval / 24.
- zmxl_fac(ji,jj,jk) = 1.0 - exp( -0.26 * zval )
+ zmxl(ji,jj,jk) = zval
ENDIF
END_3D
-
ENDIF
- zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:)
- zprdia(:,:,:) = zprmaxd(:,:,:) * zmxl_fac(:,:,:)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ zmxl_fac = 1.0 - EXP( -0.26 * zmxl(ji,jj,jk) )
+ zprbio(ji,jj,jk) = zprmax(ji,jj,jk) * zmxl_fac
+ zprdia(ji,jj,jk) = zprmax(ji,jj,jk) * zmxl_fac
+ ENDIF
+ END_3D
! The formulation proposed by Geider et al. (1997) has been modified
! to exclude the effect of nutrient limitation and temperature in the PI
! curve following Vichi et al. (2007)
! -----------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. )
zadap = xadap * ztn / ( 2.+ ztn )
@@ -160,18 +168,17 @@ CONTAINS
! Diatoms
zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) &
& * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn)
- ENDIF
- END_3D
-
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
- IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ !
! Computation of production function for Carbon
! Actual light levels are used here
! ----------------------------------------------
+ zmxl_fac = 1.0 - EXP( -0.26 * zmxl(ji,jj,jk) )
+ zmxl_chl = zmxl(ji,jj,jk) / 24.
+ !
zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
- & * zmxl_fac(ji,jj,jk) * rday + rtrn)
+ & * zmxl_fac * rday + rtrn)
zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
- & * zmxl_fac(ji,jj,jk) * rday + rtrn)
+ & * zmxl_fac * rday + rtrn)
zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
@@ -180,28 +187,27 @@ CONTAINS
! is used here (acclimation is in general slower than
! the characteristic time scales of vertical mixing)
! ------------------------------------------------------
- zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
- zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
- zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) )
- zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) )
+ zpislopen = zpislopeadn(ji,jj,jk) / ( zprmax(ji,jj,jk) * zmxl_chl * rday + rtrn )
+ zpisloped = zpislopeadd(ji,jj,jk) / ( zprmax(ji,jj,jk) * zmxl_chl * rday + rtrn )
+ zprchln(ji,jj,jk) = zprmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) )
+ zprchld(ji,jj,jk) = zprmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) )
ENDIF
END_3D
! Computation of a proxy of the N/C quota from nutrient limitation
! and light limitation. Steady state is assumed to allow the computation
! ----------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) &
- & * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
+ & * zprmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
quotan(ji,jj,jk) = MIN( 1., 0.3 + 0.7 * zval )
zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) ) &
- & * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
+ & * zprmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
quotad(ji,jj,jk) = MIN( 1., 0.3 + 0.7 * zval )
END_3D
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
-
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! Si/C of diatoms
! ------------------------
@@ -213,7 +219,7 @@ CONTAINS
! proposed by Gurney and Davidson (1999).
! -----------------------------------------------------------------------
zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 )
- zsilim = xlimdia(ji,jj,jk) * zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn )
+ zsilim = xlimdia(ji,jj,jk) * zprdia(ji,jj,jk) / ( zprmax(ji,jj,jk) + rtrn )
zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb)
IF (gphit(ji,jj) < -30 ) THEN
zsilfac = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
@@ -234,20 +240,18 @@ CONTAINS
! Sea-ice effect on production
! No production is assumed below sea ice
! --------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
END_3D
! Computation of the various production and nutrient uptake terms
! ---------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for nanophyto. (C)
zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2
- ! New production (uptake of NO3)
- zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
!
! Size computation
! Size is made a function of the limitation of of phytoplankton growth
@@ -255,7 +259,7 @@ CONTAINS
! size at time step t+1 and is thus updated at the end of the
! current time step
! --------------------------------------------------------------------
- zlimfac = xlimphy(ji,jj,jk) * zprchln(ji,jj,jk) / ( zprmaxn(ji,jj,jk) + rtrn )
+ zlimfac = xlimphy(ji,jj,jk) * zprchln(ji,jj,jk) / ( zprmax(ji,jj,jk) + rtrn )
zsizetmp = 1.0 + 1.3 * ( xsizern - 1.0 ) * zlimfac**3/(0.3 + zlimfac**3)
sizena(ji,jj,jk) = min(xsizern, max( sizena(ji,jj,jk), zsizetmp ) )
@@ -266,15 +270,13 @@ CONTAINS
zfecnm = xqfuncfecn(ji,jj,jk) + ( fecnm - xqfuncfecn(ji,jj,jk) ) * ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) )
zratio = 1.0 - MIN(1.0,tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * zfecnm + rtrn ) )
zmax = MAX( 0., MIN( 1.0, zratio**2/ (0.05**2+zratio**2) ) )
- zprofen(ji,jj,jk) = zfecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) &
+ zprofen(ji,jj,jk) = zfecnm * zprmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) &
& * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn + xnanono3(ji,jj,jk) &
& + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) &
& * xnanofer(ji,jj,jk) * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2
! production terms of diatoms (C)
zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2
- ! New production (uptake of NO3)
- zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
! Size computation
! Size is made a function of the limitation of of phytoplankton growth
@@ -282,7 +284,7 @@ CONTAINS
! size at time step t+1 and is thus updated at the end of the
! current time step.
! --------------------------------------------------------------------
- zlimfac = zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn )
+ zlimfac = zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) / ( zprmax(ji,jj,jk) + rtrn )
zsizetmp = 1.0 + 1.3 * ( xsizerd - 1.0 ) * zlimfac**3/(0.3 + zlimfac**3)
sizeda(ji,jj,jk) = min(xsizerd, max( sizeda(ji,jj,jk), zsizetmp ) )
@@ -293,7 +295,7 @@ CONTAINS
zfecdm = xqfuncfecd(ji,jj,jk) + ( fecdm - xqfuncfecd(ji,jj,jk) ) * ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) )
zratio = 1.0 - MIN(1.0, tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * zfecdm + rtrn ) )
zmax = MAX( 0., MIN( 1.0, zratio**2/ (0.05**2+zratio**2) ) )
- zprofed(ji,jj,jk) = zfecdm * zprmaxd(ji,jj,jk) * (1.0 - fr_i(ji,jj) ) &
+ zprofed(ji,jj,jk) = zfecdm * zprmax(ji,jj,jk) * (1.0 - fr_i(ji,jj) ) &
& * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn + xdiatno3(ji,jj,jk) &
& + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) &
& * xdiatfer(ji,jj,jk) * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2
@@ -303,17 +305,18 @@ CONTAINS
! Computation of the chlorophyll production terms
! The parameterization is taken from Geider et al. (1997)
! -------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ zmxl_chl = zmxl(ji,jj,jk) / 24.
! production terms for nanophyto. ( chlorophyll )
- znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+ znanotot = enanom(ji,jj,jk) / ( zmxl_chl + rtrn )
zprod = rday * zprorcan(ji,jj,jk) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk)
zprochln = chlcmin * 12. * zprorcan (ji,jj,jk)
zprochln = zprochln + (chlcnm - chlcmin) * 12. * zprod / &
& ( zpislopeadn(ji,jj,jk) * znanotot +rtrn)
! production terms for diatoms ( chlorophyll )
- zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+ zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl + rtrn )
zprod = rday * zprorcad(ji,jj,jk) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk)
zprochld = chlcmin * 12. * zprorcad(ji,jj,jk)
zprochld = zprochld + (chlcdm - chlcmin) * 12. * zprod / &
@@ -326,12 +329,16 @@ CONTAINS
END_3D
! Update the arrays TRA which contain the biological sources and sinks
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ ! New production (uptake of NO3)
+ zpronewn = zprorcan(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
+ zpronewd = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
+ !
zpptot = zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk)
- zpnewtot = zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)
+ zpnewtot = zpronewn + zpronewd
zpregtot = zpptot - zpnewtot
- zprodsil = zprmaxd(ji,jj,jk) * zysopt(ji,jj,jk) * rfact2 * tr(ji,jj,jk,jpdia,Kbb)
+ zprodsil = zprmax(ji,jj,jk) * zysopt(ji,jj,jk) * rfact2 * tr(ji,jj,jk,jpdia,Kbb)
zproddoc = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
zprodfer = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
!
@@ -362,7 +369,7 @@ CONTAINS
! Shaked et al. (2020)
! -------------------------------------------------------------------------
IF( ln_ligand ) THEN
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
zproddoc = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
zprodfer = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
@@ -373,41 +380,121 @@ CONTAINS
END_3D
ENDIF
-
- ! Output of the diagnostics
! Total primary production per year
- IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) &
- & tpp = glob_sum( 'p4zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
-
+ IF( l_dia_ppphy .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) THEN
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = ( zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk) ) * cvol(ji,jj,jk)
+ END_3D
+ tpp = glob_sum( 'p4zprod', zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
!
- CALL iom_put( "PPPHYN" , zprorcan(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by nanophyto
- CALL iom_put( "PPPHYD" , zprorcad(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by diatomes
- CALL iom_put( "PPNEWN" , zpronewn(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by nanophyto
- CALL iom_put( "PPNEWD" , zpronewd(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by diatomes
- CALL iom_put( "PBSi" , zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production
- CALL iom_put( "PFeN" , zprofen(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by nanophyto
- CALL iom_put( "PFeD" , zprofed(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by diatomes
- IF( ln_ligand .AND. ( iom_use( "LPRODP" ) .OR. iom_use( "LDETP" ) ) ) THEN
- ALLOCATE( zpligprod(jpi,jpj,jpk) )
- zpligprod(:,:,:) = excretd * zprorcad(:,:,:) + excretn * zprorcan(:,:,:)
- CALL iom_put( "LPRODP" , zpligprod(:,:,:) * ldocp * 1e9 * zfact * tmask(:,:,:) )
- !
- zpligprod(:,:,:) = ( texcretn * zprofen(:,:,:) + texcretd * zprofed(:,:,:) ) &
- & * plig(:,:,:) / ( rtrn + plig(:,:,:) + 75.0 * (1.0 - plig(:,:,:) ) )
- CALL iom_put( "LDETP" , zpligprod(:,:,:) * lthet * 1e9 * zfact * tmask(:,:,:) )
- DEALLOCATE( zpligprod )
+ IF( l_dia_ppphy ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! primary production by nanophyto
+ zw3d(A2D(0),1:jpkm1) = zprorcan(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPPHYN", zw3d )
+ ! primary production by diatomes
+ zw3d(A2D(0),1:jpkm1) = zprorcad(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPPHYD", zw3d )
+ ! total primary production
+ zw3d(A2D(0),1:jpkm1) = ( zprorcan(A2D(0),1:jpkm1) + zprorcad(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "TPP", zw3d )
+ CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ IF( l_dia_ppnew ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! new primary production by nano
+ zw3d(A2D(0),1:jpkm1) = ( zprorcan(A2D(0),1:jpkm1) * xnanono3(A2D(0),1:jpkm1) &
+ & / ( xnanono3(A2D(0),1:jpkm1) + xnanonh4(A2D(0),1:jpkm1) + rtrn ) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPNEWN", zw3d )
+ ! new primary production by diatomes
+ zw3d(A2D(0),1:jpkm1) = ( zprorcad(A2D(0),1:jpkm1) * xdiatno3(A2D(0),1:jpkm1) &
+ & / ( xdiatno3(A2D(0),1:jpkm1) + xdiatnh4(A2D(0),1:jpkm1) + rtrn ) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPNEWD", zw3d )
+ ! total new production
+ zw3d(A2D(0),1:jpkm1) = ( ( zprorcan(A2D(0),1:jpkm1) * xnanono3(A2D(0),1:jpkm1) &
+ & / ( xnanono3(A2D(0),1:jpkm1) + xnanonh4(A2D(0),1:jpkm1) + rtrn ) ) &
+ & + ( zprorcad(A2D(0),1:jpkm1) * xdiatno3(A2D(0),1:jpkm1) &
+ & / ( xdiatno3(A2D(0),1:jpkm1) + xdiatnh4(A2D(0),1:jpkm1) + rtrn ) ) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "TPNEW", zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ IF( l_dia_ppbsi ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! biogenic silica production
+ zw3d(A2D(0),1:jpkm1) = zprorcad(A2D(0),1:jpkm1) * zysopt(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PBSi", zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ IF( l_dia_ppbfe ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! biogenic iron production by nanophyto
+ zw3d(A2D(0),1:jpkm1) = zprofen(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PFeN", zw3d )
+ ! biogenic iron production by diatomes
+ zw3d(A2D(0),1:jpkm1) = zprofed(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PFeD", zw3d )
+ ! total biogenic iron production
+ zw3d(A2D(0),1:jpkm1) = ( zprofen(A2D(0),1:jpkm1) + zprofed(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "TPBFE", zw3d )
+ DEALLOCATE ( zw3d )
ENDIF
- CALL iom_put( "Mumax" , zprmaxn(:,:,:) * tmask(:,:,:) ) ! Maximum growth rate
- CALL iom_put( "MuN" , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
- CALL iom_put( "MuD" , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
- CALL iom_put( "LNlight" , zprbio (:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term
- CALL iom_put( "LDlight" , zprdia (:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:) )
- CALL iom_put( "TPP" , ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ) ! total primary production
- CALL iom_put( "TPNEW" , ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ) ! total new production
- CALL iom_put( "TPBFE" , ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:) ) ! total biogenic iron production
- CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s
+ !
+ IF( l_dia_mu ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = zprmax(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "Mumax", zw3d )
+ ! Realized growth rate for nanophyto
+ zw3d(A2D(0),1:jpkm1) = zprbio(A2D(0),1:jpkm1) * xlimphy(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "MuN", zw3d )
+ ! Realized growth rate for diatoms
+ zw3d(A2D(0),1:jpkm1) = zprdia(A2D(0),1:jpkm1) * xlimdia(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "MuD", zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ IF( l_dia_light ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! light limitation term for nano
+ zw3d(A2D(0),1:jpkm1) = zprbio(A2D(0),1:jpkm1) / ( zprmax(A2D(0),1:jpkm1) + rtrn ) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LNlight", zw3d )
+ ! light limitation term for diatomes
+ zw3d(A2D(0),1:jpkm1) = zprdia(A2D(0),1:jpkm1) / ( zprmax(A2D(0),1:jpkm1) + rtrn ) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LDlight", zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ IF( l_dia_lprod ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = ( excretd * zprorcad(A2D(0),1:jpkm1) + excretn * zprorcan(A2D(0),1:jpkm1) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LPRODP" , zw3d * ldocp * 1e9 )
+ !
+ zw3d(A2D(0),1:jpkm1) = ( texcretn * zprofen(A2D(0),1:jpkm1) + texcretd * zprofed(A2D(0),1:jpkm1) ) &
+ & * plig(A2D(0),1:jpkm1) / ( rtrn + plig(A2D(0),1:jpkm1) + 75.0 * (1.0 - plig(A2D(0),1:jpkm1) ) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LDETP" , zw3d * lthet * 1e9 )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
ENDIF
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
@@ -475,12 +562,11 @@ CONTAINS
!
END SUBROUTINE p4z_prod_init
-
INTEGER FUNCTION p4z_prod_alloc()
!!----------------------------------------------------------------------
!! *** ROUTINE p4z_prod_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc )
+ ALLOCATE( quotan(A2D(0),jpk), quotad(A2D(0),jpk), STAT = p4z_prod_alloc )
!
IF( p4z_prod_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_prod_alloc : failed to allocate arrays.' )
!
diff --git a/src/TOP/PISCES/P4Z/p4zrem.F90 b/src/TOP/PISCES/P4Z/p4zrem.F90
index c63a6e63f59e3fd8d803181902ac7a046a6950e1..e63e5eec167f6d872b86ead61ae7568eaa21e87c 100644
--- a/src/TOP/PISCES/P4Z/p4zrem.F90
+++ b/src/TOP/PISCES/P4Z/p4zrem.F90
@@ -43,6 +43,7 @@ MODULE p4zrem
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array
+ LOGICAL :: l_dia_remin, l_dia_febact, l_dia_bact, l_dia_denit
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
@@ -73,28 +74,45 @@ CONTAINS
INTEGER :: ji, jj, jk
REAL(wp) :: zremik, zremikc, zremikn, zremikp, zsiremin, zfact
REAL(wp) :: zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep
- REAL(wp) :: zbactfer, zonitr, zrfact2
+ REAL(wp) :: zbactfer, zonitr
REAL(wp) :: zammonic, zoxyremc, zosil, ztem, zdenitnh4, zolimic
+ REAL(wp) :: zfacsi, zdepeff
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zolimi, zfacsi, zfacsib, zdepeff, zfebact
- REAL(wp), DIMENSION(jpi,jpj ) :: ztempbac
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zdepbac, zfacsib
+ REAL(wp), DIMENSION(A2D(0) ) :: ztempbac
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d, zolimi, zfebact
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_rem')
!
+ IF( kt == nittrc000 ) THEN
+ l_dia_remin = iom_use( "REMIN" )
+ l_dia_febact = iom_use( "FEBACT" )
+ l_dia_denit = iom_use( "DENIT" )
+ l_dia_bact = iom_use( "BACT" )
+ ENDIF
+ IF( l_dia_remin ) THEN
+ ALLOCATE( zolimi(A2D(0),jpk) ) ; zolimi(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zolimi(ji,jj,jk) = tr(ji,jj,jk,jpoxy,Krhs)
+ END_3D
+ ENDIF
+ IF( l_dia_febact ) THEN
+ ALLOCATE( zfebact(A2D(0),jpk) ) ; zfebact(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zfebact(ji,jj,jk) = tr(ji,jj,jk,jpfer,Krhs)
+ END_3D
+ ENDIF
! Initialisation of arrays
- zdepeff (:,:,:) = 0.3_wp
zfacsib(:,:,:) = xsilab / ( 1.0 - xsilab )
- zfebact(:,:,:) = 0._wp
- zfacsi(:,:,:) = xsilab
! Computation of the mean bacterial concentration
! this parameterization has been deduced from a model version
- ! that was modeling explicitely bacteria. This is a very old param
+ ! that was modeling explicitely bacteria. This is a very old parame
! that will be very soon updated based on results from a much more
! recent version of PISCES with bacteria.
! ----------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zdep = MAX( hmld(ji,jj), heup_01(ji,jj) )
IF ( gdept(ji,jj,jk,Kmm) < zdep ) THEN
zdepbac(ji,jj,jk) = 0.6 * ( MAX(0.0, tr(ji,jj,jk,jpzoo,Kbb) + tr(ji,jj,jk,jpmes,Kbb) ) * 1.0E6 )**0.6 * 1.E-6
@@ -102,13 +120,11 @@ CONTAINS
! IF( gdept(ji,jj,jk,Kmm) >= zdep ) THEN
ELSE
zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) )
- zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj)
-! zdepeff(ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3
- zdepeff(ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.6
+ zdepbac(ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj)
ENDIF
END_3D
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! DOC ammonification. Depends on depth, phytoplankton biomass
! and a limitation term which is supposed to be a parameterization of the bacterial activity.
! --------------------------------------------------------------------------
@@ -119,7 +135,6 @@ CONTAINS
! -----------------------------------------------------
zolimic = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)
zolimic = MAX(0., MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimic ) )
- zolimi(ji,jj,jk) = zolimic
! Ammonification in suboxic waters with denitrification
! -----------------------------------------------------
@@ -152,7 +167,7 @@ CONTAINS
ENDIF
END_3D
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! NH4 nitrification to NO3. Ceased for oxygen concentrations
! below 2 umol/L. Inhibited at strong light
! ----------------------------------------------------------
@@ -174,14 +189,22 @@ CONTAINS
CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
ENDIF
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zdep = MAX( hmld(ji,jj), heup_01(ji,jj) )
+ IF( gdept(ji,jj,jk,Kmm) >= zdep ) THEN
+ zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) )
+ zdepeff = 0.3_wp * zdepmin**0.6
+! zdepeff = 0.3_wp * zdepmin**0.3
+ ELSE
+ zdepeff = 0.3_wp
+ ENDIF
! Bacterial uptake of iron. No iron is available in DOC. So
! Bacteries are obliged to take up iron from the water. Some
! studies (especially at Papa) have shown this uptake to be significant
! ----------------------------------------------------------
zbactfer = feratb * 0.6_wp * xstep * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk) * tr(ji,jj,jk,jpfer,Kbb) &
- & / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) ) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk)
+ & / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) ) * zdepeff * zdepbac(ji,jj,jk)
! Only the transfer of iron from its dissolved form to particles
! is treated here. The GGE of bacteria supposed to be equal to
@@ -189,8 +212,7 @@ CONTAINS
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.1
tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.08
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.02
- zfebact(ji,jj,jk) = zbactfer * 0.1
- blim(ji,jj,jk) = xlimbacl(ji,jj,jk) * zdepbac(ji,jj,jk) / 1.e-6
+ blim(ji,jj,jk) = xlimbacl(ji,jj,jk) * zdepbac(ji,jj,jk) / 1.e-6
END_3D
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
@@ -202,7 +224,7 @@ CONTAINS
! Initialization of the array which contains the labile fraction
! of bSi. Set to a constant in the upper ocean
! ---------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! Remineralization rate of BSi dependent on T and saturation
! The parameterization is taken from Ridgwell et al. (2002)
! ---------------------------------------------------------
@@ -219,13 +241,14 @@ CONTAINS
! of bSi. This is computed assuming steady state.
! --------------------------------------------------------------
IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN
- zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem ) &
- & * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) )
- zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) )
- zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem ) &
- & * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) )
+ zfactdep = EXP( -0.5 * ( xsiremlab - xsirem ) * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) )
+ zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * zfactdep
+ zfacsi = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) )
+ zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * zfactdep
+ ELSE
+ zfacsi = xsilab
ENDIF
- zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil
+ zsiremin = ( xsiremlab * zfacsi + xsirem * ( 1. - zfacsi ) ) * xstep * znusil
zosil = zsiremin * tr(ji,jj,jk,jpgsi,Kbb)
!
tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil
@@ -236,20 +259,46 @@ CONTAINS
WRITE(charout, FMT="('rem3')")
CALL prt_ctl_info( charout, cdcomp = 'top' )
CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
- ENDIF
+ ENDIF
- IF( knt == nrdttrc ) THEN
- zrfact2 = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN
!
- IF( iom_use( "REMIN" ) ) THEN ! Remineralisation rate
- zolimi(:,:,jpk) = 0. ; CALL iom_put( "REMIN" , zolimi(:,:,:) * tmask(:,:,:) * zrfact2 )
+ IF( l_dia_febact ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfebact(ji,jj,jk) = ( zfebact(ji,jj,jk) - tr(ji,jj,jk,jpfer,Krhs) ) &
+ & * 1e9 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "FEBACT", zfebact )
+ DEALLOCATE( zfebact )
ENDIF
- CALL iom_put( "DENIT" , denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zrfact2 ) ! Denitrification
- IF( iom_use( "BACT" ) ) THEN ! Bacterial biomass
- zdepbac(:,:,jpk) = 0. ; CALL iom_put( "BACT", zdepbac(:,:,:) * 1.E6 * tmask(:,:,:) )
+ IF( l_dia_remin ) THEN ! Remineralisation rate
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zolimi(ji,jj,jk) = ( zolimi(ji,jj,jk) - tr(ji,jj,jk,jpoxy,Krhs) ) / o2ut &
+ & * rfact2r * tmask(ji,jj,jk) !
+ END_3D
+ CALL iom_put( "REMIN", zolimi )
+ DEALLOCATE( zolimi )
ENDIF
- CALL iom_put( "FEBACT" , zfebact(:,:,:) * 1E9 * tmask(:,:,:) * zrfact2 )
- ENDIF
+ !
+ IF( l_dia_bact ) THEN ! Bacterial biomass
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = zdepbac(ji,jj,jk) * 1.E6 * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "BACT", zw3d )
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_denit ) THEN ! Denitrification
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = denitr(ji,jj,jk) * 1E+3 * rfact2r * rno3 * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "DENIT", zw3d )
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ ENDIF
!
IF( ln_timing ) CALL timing_stop('p4z_rem')
!
diff --git a/src/TOP/PISCES/P4Z/p4zsed.F90 b/src/TOP/PISCES/P4Z/p4zsed.F90
index ca6bdb281c10b0e6c24143440ce85618e10042f0..d978d72acf03f1181752c4959300329cef04f4dc 100644
--- a/src/TOP/PISCES/P4Z/p4zsed.F90
+++ b/src/TOP/PISCES/P4Z/p4zsed.F90
@@ -36,6 +36,8 @@ MODULE p4zsed
REAL(wp), SAVE :: r1_rday
REAL(wp), SAVE :: sedsilfrac, sedcalfrac
+ LOGICAL :: l_dia_sdenit, l_dia_nfix, l_dia_sed
+
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
@@ -66,44 +68,41 @@ CONTAINS
REAL(wp) :: zsiloss, zcaloss, zws3, zws4, zwsc, zdep
REAL(wp) :: zwstpoc, zwstpon, zwstpop
REAL(wp) :: ztrfer, ztrpo4s, ztrdp, zwdust, zmudia, ztemp
+ REAL(wp) :: zsoufer, zlight, ztrpo4, ztrdop
REAL(wp) :: xdiano3, xdianh4
!
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj ) :: zdenit2d, zbureff, zwork
- REAL(wp), DIMENSION(jpi,jpj ) :: zwsbio3, zwsbio4
- REAL(wp), DIMENSION(jpi,jpj ) :: zsedcal, zsedsi, zsedc
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsoufer, zlight
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zpdep
+ REAL(wp), DIMENSION(A2D(0)) :: zdenit2d, zbureff
+ REAL(wp), DIMENSION(A2D(0)) :: zwsbio3, zwsbio4
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsedcal, zsedsi, zsedc
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_sed')
!
-
- ! Allocate temporary workspace
- ALLOCATE( ztrpo4(jpi,jpj,jpk) )
- IF( ln_p5z ) ALLOCATE( ztrdop(jpi,jpj,jpk) )
-
- zdenit2d(:,:) = 0.e0
- zbureff (:,:) = 0.e0
- zwork (:,:) = 0.e0
- zsedsi (:,:) = 0.e0
- zsedcal (:,:) = 0.e0
- zsedc (:,:) = 0.e0
+ IF( kt == nittrc000 ) THEN
+ l_dia_nfix = iom_use( "Nfix" )
+ l_dia_sdenit = iom_use( "Sdenit" )
+ l_dia_sed = .NOT.lk_sed .AND. ( iom_use( "SedC" ) .OR. iom_use( "SedCal" ) .OR. iom_use( "SedSi" ) )
+ ENDIF
! OA: Warning, the following part is necessary to avoid CFL problems above the sediments
! --------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = e3t(ji,jj,ikt,Kmm) / xstep
zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) )
END_2D
-
+ !
+ zdenit2d(:,:) = 0.e0
+ zbureff (:,:) = 0.e0
+ !
IF( .NOT.lk_sed ) THEN
! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
! Computation of the fraction of organic matter that is permanently buried from Dunne's model
! -------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 1 ) THEN
ikt = mbkt(ji,jj)
zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) &
@@ -129,7 +128,7 @@ CONTAINS
! ------------------------------------------------------
IF( .NOT.lk_sed ) zrivsil = 1._wp - sedsilfrac
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zwsc = zwsbio4(ji,jj) * zdep
@@ -141,7 +140,7 @@ CONTAINS
END_2D
!
IF( .NOT.lk_sed ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zwsc = zwsbio4(ji,jj) * zdep
@@ -154,12 +153,11 @@ CONTAINS
zrivalk = sedcalfrac * zfactcal
tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0
tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk
- zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm)
- zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm)
END_2D
ENDIF
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ !
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zws4 = zwsbio4(ji,jj) * zdep
@@ -171,7 +169,7 @@ CONTAINS
END_2D
!
IF( ln_p5z ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zws4 = zwsbio4(ji,jj) * zdep
@@ -183,10 +181,10 @@ CONTAINS
END_2D
ENDIF
+ ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after
+ ! denitrification in the sediments. Not very clever, but simpliest option.
IF( .NOT.lk_sed ) THEN
- ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after
- ! denitrification in the sediments. Not very clever, but simpliest option.
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zws4 = zwsbio4(ji,jj) * zdep
@@ -204,27 +202,37 @@ CONTAINS
tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit )
tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit
sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm)
- zsedc(ji,jj) = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm)
- IF( ln_p5z ) THEN
- zwstpop = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3
- zwstpon = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3
+ END_2D
+ IF( ln_p5z ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ ikt = mbkt(ji,jj)
+ zdep = xstep / e3t(ji,jj,ikt,Kmm)
+ zws4 = zwsbio4(ji,jj) * zdep
+ zws3 = zwsbio3(ji,jj) * zdep
+ zrivno3 = 1. - zbureff(ji,jj)
+ zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3
+ zpdenit = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
+ z1pdenit = zwstpoc * zrivno3 - zpdenit
+ zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
+ zwstpop = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3
+ zwstpon = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3
tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn)
tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn)
- ENDIF
- END_2D
+ END_2D
+ ENDIF
ENDIF
! Nitrogen fixation process
! Small source iron from particulate inorganic iron
!-----------------------------------
- DO jk = 1, jpkm1
- zlight (:,:,jk) = ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) )
- zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) )
- ENDDO
+ !
IF( ln_p4z ) THEN
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! ! Potential nitrogen fixation dependant on temperature and iron
+ zlight = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) * ( 1. - fr_i(ji,jj) )
+ zsoufer = zlight * 2E-11 / ( 2E-11 + biron(ji,jj,jk) )
+ !
ztemp = ts(ji,jj,jk,jp_tem,Kmm)
zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) / rno3
! Potential nitrogen fixation dependant on temperature and iron
@@ -234,33 +242,11 @@ CONTAINS
IF( zlim <= 0.1 ) zlim = 0.01
zfact = zlim * rfact2
ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
- ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) )
- ztrdp = ztrpo4(ji,jj,jk)
- nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
- END_3D
- ELSE ! p5z
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
- ! ! Potential nitrogen fixation dependant on temperature and iron
- ztemp = ts(ji,jj,jk,jp_tem,Kmm)
- zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
- ! Potential nitrogen fixation dependant on temperature and iron
- xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) )
- xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4)
- zlim = ( 1.- xdiano3 - xdianh4 )
- IF( zlim <= 0.1 ) zlim = 0.01
- zfact = zlim * rfact2
- ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
- ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) )
- ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk))
- ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk)
- nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
- END_3D
- ENDIF
-
- ! Nitrogen change due to nitrogen fixation
- ! ----------------------------------------
- IF( ln_p4z ) THEN
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ ztrpo4 = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) )
+ nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrpo4 ) * zlight
+ !
+ ! Nitrogen change due to nitrogen fixation
+ ! ----------------------------------------
zfact = nitrpot(ji,jj,jk) * nitrfix
tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0
tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0
@@ -273,23 +259,41 @@ CONTAINS
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0
tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0
- tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+ tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer * rfact2 / rday
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) &
& * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep
END_3D
- ELSE ! p5z
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ ELSE ! p5z
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zlight = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) * ( 1. - fr_i(ji,jj) )
+ zsoufer = zlight * 2E-11 / ( 2E-11 + biron(ji,jj,jk) )
+ !
+ ! ! Potential nitrogen fixation dependant on temperature and iron
+ ztemp = ts(ji,jj,jk,jp_tem,Kmm)
+ zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
+ ! Potential nitrogen fixation dependant on temperature and iron
+ xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) )
+ xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4)
+ zlim = ( 1.- xdiano3 - xdianh4 )
+ IF( zlim <= 0.1 ) zlim = 0.01
+ zfact = zlim * rfact2
+ ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
+ ztrpo4 = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) )
+ ztrdop = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4)
+ nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrpo4 + ztrdop ) * zlight
+
+ ! Nitrogen change due to nitrogen fixation
+ ! ----------------------------------------
zfact = nitrpot(ji,jj,jk) * nitrfix
tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0
tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0
tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zfact * 2.0 / 3.0
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) &
- & * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
+ & * ztrpo4 / (ztrpo4 + ztrdop + rtrn)
tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0
tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0
tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0 &
- & - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk) &
- & / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
+ & - 16.0 / 46.0 * zfact * ztrdop / ( ztrpo4 + ztrdop + rtrn)
tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0
tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0
tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0
@@ -300,18 +304,46 @@ CONTAINS
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0
tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0
- tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+ tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer * rfact2 / rday
END_3D
- !
ENDIF
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molN/m3/s
- CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation
- CALL iom_put( "SedCal", zsedcal(:,:) * zfact )
- CALL iom_put( "SedSi" , zsedsi (:,:) * zfact )
- CALL iom_put( "SedC" , zsedc (:,:) * zfact )
- CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 )
+ !
+ IF( l_dia_nfix ) THEN ! nitrogen fixation
+ zfact = rno3 * 1.e+3 * rfact2r ! conversion from molC/l/kt to molN/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = nitrpot(A2D(0),1:jpkm1) * nitrfix * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "Nfix", zw3d )
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_sed ) THEN
+ ALLOCATE( zsedcal(A2D(0)), zsedsi(A2D(0) ), zsedc(A2D(0) ) )
+ zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molC/m3/s
+ DO_2D( 0, 0, 0, 0 )
+ ikt = mbkt(ji,jj)
+ zsedsi(ji,jj) = (1.0 - zrivsil) * tr(ji,jj,ikt,jpgsi,Kbb) * zwsbio4(ji,jj) * xstep
+ !
+ zfactcal = MAX(-0.1, MIN( excess(ji,jj,ikt), 0.2 ) )
+ zfactcal = 0.3 + 0.7 * MIN( 1., (0.1 + zfactcal) / ( 0.5 - zfactcal ) )
+ zrivalk = sedcalfrac * zfactcal
+ zsedcal(ji,jj) = (1.0 - zrivalk) * tr(ji,jj,ikt,jpcal,Kbb) * zwsbio4(ji,jj) * xstep
+ !
+ zrivno3 = 1. - zbureff(ji,jj)
+ zsedc(ji,jj) = (1. - zrivno3) * &
+ & ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * xstep
+ END_2D
+ CALL iom_put( "SedCal", zsedcal(:,:) * zfact )
+ CALL iom_put( "SedSi" , zsedsi (:,:) * zfact )
+ CALL iom_put( "SedC" , zsedc (:,:) * zfact )
+ DEALLOCATE( zsedcal, zsedsi, zsedc )
+ ENDIF
+ IF( l_dia_sdenit ) THEN
+ zfact = rno3 * 1.e+3 * rfact2r ! conversion from molC/l/kt to molN/m3/s
+ CALL iom_put( "Sdenit", sdenit(:,:) * zfact )
+ ENDIF
+ !
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trneds (USEd for debugging)
@@ -320,8 +352,6 @@ CONTAINS
CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
ENDIF
!
- IF( ln_p5z ) DEALLOCATE( ztrpo4, ztrdop )
- !
IF( ln_timing ) CALL timing_stop('p4z_sed')
!
END SUBROUTINE p4z_sed
@@ -367,7 +397,7 @@ CONTAINS
!
lk_sed = ln_sediment .AND. ln_sed_2way
!
- nitrpot(:,:,jpk) = 0._wp ! define last level for iom_put
+! nitrpot(:,:,jpk) = 0._wp ! define last level for iom_put
!
END SUBROUTINE p4z_sed_init
@@ -375,7 +405,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE p4z_sed_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
+ ALLOCATE( nitrpot(A2D(0),jpk), sdenit(A2D(0)), STAT=p4z_sed_alloc )
!
IF( p4z_sed_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_alloc: failed to allocate arrays' )
!
diff --git a/src/TOP/PISCES/P4Z/p4zsink.F90 b/src/TOP/PISCES/P4Z/p4zsink.F90
index 53db2671e02ac76bedea89eb4c7cfd259172fad5..7b6346706bdb329ac6f8a1dd2d09de063f9a729f 100644
--- a/src/TOP/PISCES/P4Z/p4zsink.F90
+++ b/src/TOP/PISCES/P4Z/p4zsink.F90
@@ -40,6 +40,7 @@ MODULE p4zsink
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer2 !: Big iron sinking fluxes
INTEGER :: ik100
+ LOGICAL :: l_dia_sink2d, l_dia_sink3d, l_dia_tcexp
!! * Substitutions
# include "do_loop_substitute.h90"
@@ -68,10 +69,20 @@ CONTAINS
INTEGER :: ji, jj, jk
CHARACTER (len=25) :: charout
REAL(wp) :: zmax, zfact
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
+ REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_sink')
+ IF( kt == nittrc000 ) THEN
+ l_dia_sink2d = iom_use( "EPC100" ) .OR. iom_use( "EPFE100" ) &
+ & .OR. iom_use( "EPCAL100" ) .OR. iom_use( "EPSI100" )
+ l_dia_sink3d = iom_use( "EXPC" ) .OR. iom_use( "EXPFE" ) &
+ & .OR. iom_use( "EXPCAL" ) .OR. iom_use( "EXPSI" )
+ l_dia_tcexp = iom_use( "tcexp" )
+ ENDIF
+
! Initialization of some global variables
! ---------------------------------------
prodpoc(:,:,:) = 0.
@@ -86,7 +97,7 @@ CONTAINS
! CaCO3 and bSi are supposed to sink at the big particles speed
! due to their high density
! ---------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zmax = MAX( heup_01(ji,jj), hmld(ji,jj) )
zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale
wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact
@@ -129,28 +140,61 @@ CONTAINS
ENDIF
! Total carbon export per year
- IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) &
- & t_oce_co2_exp = glob_sum( 'p4zsink', ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) )
+ IF( l_dia_tcexp .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) THEN
+ ALLOCATE( zw2d(A2D(0)) )
+ zw2d(A2D(0)) = ( sinking(A2D(0),ik100) + sinking2(A2D(0),ik100) ) * e1e2t(A2D(0)) * tmask(A2D(0),1)
+ t_oce_co2_exp = glob_sum( 'p4zsink', zw2d(:,:) )
+ DEALLOCATE( zw2d )
+ ENDIF
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
!
- CALL iom_put( "EPC100" , ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ) ! Export of carbon at 100m
- CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ) ! Export of iron at 100m
- CALL iom_put( "EPCAL100", sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ) ! Export of calcite at 100m
- CALL iom_put( "EPSI100" , sinksil(:,:,ik100) * zfact * tmask(:,:,1) ) ! Export of bigenic silica at 100m
- CALL iom_put( "EXPC" , ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ) ! Export of carbon in the water column
- CALL iom_put( "EXPFE" , ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ) ! Export of iron
- CALL iom_put( "EXPCAL" , sinkcal(:,:,:) * zfact * tmask(:,:,:) ) ! Export of calcite
- CALL iom_put( "EXPSI" , sinksil(:,:,:) * zfact * tmask(:,:,:) ) ! Export of bigenic silica
- CALL iom_put( "tcexp" , t_oce_co2_exp * zfact ) ! molC/s
+ IF( l_dia_sink2d ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw2d(A2D(0)) )
+ ! Export of carbon at 100m
+ zw2d(A2D(0)) = ( sinking(A2D(0),ik100) + sinking2(A2D(0),ik100) ) * zfact * tmask(A2D(0),1)
+ CALL iom_put( "EPC100", zw2d )
+ ! Export of iron at 100m
+ zw2d(A2D(0)) = ( sinkfer(A2D(0),ik100) + sinkfer2(A2D(0),ik100) ) * zfact * tmask(A2D(0),1)
+ CALL iom_put( "EPFE100", zw2d )
+ ! Export of calcite at 100m
+ zw2d(A2D(0)) = sinkcal(A2D(0),ik100) * zfact * tmask(A2D(0),1)
+ CALL iom_put( "EPCAL100", zw2d )
+ ! Export of bigenic silica at 100m
+ zw2d(A2D(0)) = sinksil(A2D(0),ik100) * zfact * tmask(A2D(0),1)
+ CALL iom_put( "EPSI100", zw2d )
+ !
+ DEALLOCATE( zw2d )
+ ENDIF
+ !
+ IF( l_dia_sink3d ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! Export of carbon in the water column
+ zw3d(A2D(0),1:jpkm1) = ( sinking(A2D(0),1:jpkm1) + sinking2(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "EXPC", zw3d )
+ ! Export of iron
+ zw3d(A2D(0),1:jpkm1) = ( sinkfer(A2D(0),1:jpkm1) + sinkfer2(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "EXPFE", zw3d )
+ ! Export of calcite
+ zw3d(A2D(0),1:jpkm1) = sinkcal(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "EXPCAL", zw3d )
+ ! Export of bigenic silica
+ zw3d(A2D(0),1:jpkm1) = sinksil(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "EXPSI", zw3d )
+ !
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_tcexp ) CALL iom_put( "tcexp", t_oce_co2_exp * 1.e+3 * rfact2r )
!
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
WRITE(charout, FMT="('sink')")
CALL prt_ctl_info( charout, cdcomp = 'top' )
- CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
+ CALL prt_ctl(tab4d_1=tr(:,:,:,:,Kbb), mask1=tmask, clinfo=ctrcnm)
ENDIF
!
IF( ln_timing ) CALL timing_stop('p4z_sink')
@@ -192,13 +236,13 @@ CONTAINS
!
ierr(:) = 0
!
- ALLOCATE( sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk) , &
- & sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk) , &
- & sinkfer2(jpi,jpj,jpk) , &
- & sinkfer(jpi,jpj,jpk) , STAT=ierr(1) )
+ ALLOCATE( sinking(A2D(0),jpk) , sinking2(A2D(0),jpk) , &
+ & sinkcal(A2D(0),jpk) , sinksil (A2D(0),jpk) , &
+ & sinkfer2(A2D(0),jpk) , &
+ & sinkfer(A2D(0),jpk) , STAT=ierr(1) )
!
- IF( ln_p5z ) ALLOCATE( sinkingn(jpi,jpj,jpk), sinking2n(jpi,jpj,jpk) , &
- & sinkingp(jpi,jpj,jpk), sinking2p(jpi,jpj,jpk) , STAT=ierr(2) )
+ IF( ln_p5z ) ALLOCATE( sinkingn(A2D(0),jpk), sinking2n(A2D(0),jpk) , &
+ & sinkingp(A2D(0),jpk), sinking2p(A2D(0),jpk) , STAT=ierr(2) )
!
p4z_sink_alloc = MAXVAL( ierr )
IF( p4z_sink_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_sink_alloc : failed to allocate arrays.' )
diff --git a/src/TOP/PISCES/P4Z/p4zsms.F90 b/src/TOP/PISCES/P4Z/p4zsms.F90
index 664d1206425e423a46c6d4909bea415b14e8ffdd..dc2b32ecc8cd00d35d886b576f45df4a39d9c051 100644
--- a/src/TOP/PISCES/P4Z/p4zsms.F90
+++ b/src/TOP/PISCES/P4Z/p4zsms.F90
@@ -140,7 +140,7 @@ CONTAINS
! ------------------------------------------------------------------
xnegtr(:,:,:) = 1.e0
DO jn = jp_pcs0, jp_pcs1
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk)
+ DO_3D( 0, 0, 0, 0, 1, jpk)
IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN
ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn )
xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
@@ -157,45 +157,56 @@ CONTAINS
IF( iom_use( 'INTdtAlk' ) .OR. iom_use( 'INTdtDIC' ) .OR. iom_use( 'INTdtFer' ) .OR. &
& iom_use( 'INTdtDIN' ) .OR. iom_use( 'INTdtDIP' ) .OR. iom_use( 'INTdtSil' ) ) THEN
!
- ALLOCATE( zw3d(jpi,jpj,jpk), zw2d(jpi,jpj) )
- zw3d(:,:,jpk) = 0.
- DO jk = 1, jpkm1
- zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
- ENDDO
+ ALLOCATE( zw3d(A2D(0),jpk), zw2d(A2D(0)) )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = xnegtr(ji,jj,jk) * xfact * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+ END_3D
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
- zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs)
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * tr(ji,jj,jk,jptal,Krhs)
+ END_2D
ENDDO
CALL iom_put( 'INTdtAlk', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
- zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs)
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * tr(ji,jj,jk,jpdic,Krhs)
+ END_2D
ENDDO
CALL iom_put( 'INTdtDIC', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
- zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) )
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * rno3 * ( tr(ji,jj,jk,jpno3,Krhs) + tr(ji,jj,jk,jpnh4,Krhs) )
+ END_2D
ENDDO
CALL iom_put( 'INTdtDIN', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
- zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs)
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * po4r * tr(ji,jj,jk,jppo4,Krhs)
+ END_2D
ENDDO
CALL iom_put( 'INTdtDIP', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
- zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs)
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * tr(ji,jj,jk,jpfer,Krhs)
+ END_2D
ENDDO
CALL iom_put( 'INTdtFer', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
- zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs)
+ DO_2D( 0, 0, 0, 0 )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * tr(ji,jj,jk,jpsil,Krhs)
+ END_2D
ENDDO
CALL iom_put( 'INTdtSil', zw2d )
!
@@ -522,8 +533,9 @@ CONTAINS
INTEGER, INTENT( in ) :: Kmm ! time level indices
REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
CHARACTER(LEN=100) :: cltxt
- INTEGER :: jk
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork
+ INTEGER :: ji, jj, jk
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
+ REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
!!----------------------------------------------------------------------
!
IF( kt == nittrc000 ) THEN
@@ -542,82 +554,113 @@ CONTAINS
! Compute the budget of NO3
IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
IF( ln_p4z ) THEN
- zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) &
- & + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) &
- & + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) &
- & + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpno3,Kmm) + tr(ji,jj,jk,jpnh4,Kmm) &
+ & + tr(ji,jj,jk,jpphy,Kmm) + tr(ji,jj,jk,jpdia,Kmm) &
+ & + tr(ji,jj,jk,jppoc,Kmm) + tr(ji,jj,jk,jpgoc,Kmm) + tr(ji,jj,jk,jpdoc,Kmm) &
+ & + tr(ji,jj,jk,jpzoo,Kmm) + tr(ji,jj,jk,jpmes,Kmm) ) * cvol(ji,jj,jk)
+ END_3D
ELSE
- zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm) &
- & + tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm) &
- & + tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm) &
- & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpno3,Kmm) + tr(ji,jj,jk,jpnh4,Kmm) + tr(ji,jj,jk,jpnph,Kmm) &
+ & + tr(ji,jj,jk,jpndi,Kmm) + tr(ji,jj,jk,jpnpi,Kmm) &
+ & + tr(ji,jj,jk,jppon,Kmm) + tr(ji,jj,jk,jpgon,Kmm) + tr(ji,jj,jk,jpdon,Kmm) &
+ & + ( tr(ji,jj,jk,jpzoo,Kmm) + tr(ji,jj,jk,jpmes,Kmm) ) * no3rat3 ) * cvol(ji,jj,jk)
+ END_3D
ENDIF
!
- no3budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
+ no3budget = glob_sum( 'p4zsms', zw3d(:,:,:) )
no3budget = no3budget / areatot
CALL iom_put( "pno3tot", no3budget )
+ DEALLOCATE( zw3d )
ENDIF
!
! Compute the budget of PO4
IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
IF( ln_p4z ) THEN
- zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) &
- & + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) &
- & + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) &
- & + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)
- ELSE
- zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm) &
- & + tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm) &
- & + tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm) &
- & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jppo4,Kmm) &
+ & + tr(ji,jj,jk,jpphy,Kmm) + tr(ji,jj,jk,jpdia,Kmm) &
+ & + tr(ji,jj,jk,jppoc,Kmm) + tr(ji,jj,jk,jpgoc,Kmm) + tr(ji,jj,jk,jpdoc,Kmm) &
+ & + tr(ji,jj,jk,jpzoo,Kmm) + tr(ji,jj,jk,jpmes,Kmm) ) * cvol(ji,jj,jk)
+ END_3D
+ ELSE
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jppo4,Kmm) + tr(ji,jj,jk,jppph,Kmm) &
+ & + tr(ji,jj,jk,jppdi,Kmm) + tr(ji,jj,jk,jpppi,Kmm) &
+ & + tr(ji,jj,jk,jppop,Kmm) + tr(ji,jj,jk,jpgop,Kmm) + tr(ji,jj,jk,jpdop,Kmm) &
+ & + ( tr(ji,jj,jk,jpzoo,Kmm) + tr(ji,jj,jk,jpmes,Kmm) ) * po4rat3 ) * cvol(ji,jj,jk)
+ END_3D
ENDIF
!
- po4budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
+ po4budget = glob_sum( 'p4zsms', zw3d(:,:,:) )
po4budget = po4budget / areatot
CALL iom_put( "ppo4tot", po4budget )
+ DEALLOCATE( zw3d )
ENDIF
!
! Compute the budget of SiO3
IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
- zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm)
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpsil,Kmm) + tr(ji,jj,jk,jpgsi,Kmm) + tr(ji,jj,jk,jpdsi,Kmm) ) * cvol(ji,jj,jk)
+ END_3D
!
- silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
+ silbudget = glob_sum( 'p4zsms', zw3d(:,:,:) )
silbudget = silbudget / areatot
CALL iom_put( "psiltot", silbudget )
+ DEALLOCATE( zw3d )
ENDIF
!
IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
- zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpno3,Kmm) * rno3 + tr(ji,jj,jk,jptal,Kmm) + tr(ji,jj,jk,jpcal,Kmm) * 2. ) * cvol(ji,jj,jk)
+ END_3D
!
- alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) !
+ alkbudget = glob_sum( 'p4zsms', zw3d(:,:,:) ) !
alkbudget = alkbudget / areatot
CALL iom_put( "palktot", alkbudget )
+ DEALLOCATE( zw3d )
ENDIF
!
! Compute the budget of Iron
IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
- zwork(:,:,:) = tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm) &
- & + tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm) &
- & + ( tr(:,:,:,jpzoo,Kmm) * feratz + tr(:,:,:,jpmes,Kmm) ) * feratm
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpfer,Kmm) + tr(ji,jj,jk,jpnfe,Kmm) + tr(ji,jj,jk,jpdfe,Kmm) &
+ & + tr(ji,jj,jk,jpbfe,Kmm) + tr(ji,jj,jk,jpsfe,Kmm) &
+ & + tr(ji,jj,jk,jpzoo,Kmm) * feratz + tr(ji,jj,jk,jpmes,Kmm) * feratm ) * cvol(ji,jj,jk)
+ END_3D
!
- ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
+ ferbudget = glob_sum( 'p4zsms', zw3d(:,:,:) )
ferbudget = ferbudget / areatot
CALL iom_put( "pfertot", ferbudget )
+ DEALLOCATE( zw3d )
ENDIF
!
! Global budget of N SMS : denitrification in the water column and in the sediment
! nitrogen fixation by the diazotrophs
! --------------------------------------------------------------------------------
IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
- znitrpottot = glob_sum ( 'p4zsms', nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = nitrpot(A2D(0),1:jpkm1) * nitrfix * cvol(A2D(0),1:jpkm1)
+ znitrpottot = glob_sum ( 'p4zsms', zw3d)
CALL iom_put( "tnfix" , znitrpottot * xfact3 ) ! Global nitrogen fixation molC/l to molN/m3
+ DEALLOCATE( zw3d )
ENDIF
!
IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
- zrdenittot = glob_sum ( 'p4zsms', denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
- zsdenittot = glob_sum ( 'p4zsms', sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+ ALLOCATE( zw3d(A2D(0),jpk), zw2d(A2D(0)) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = denitr(A2D(0),1:jpkm1) * rdenit * xnegtr(A2D(0),1:jpkm1) * cvol(A2D(0),1:jpkm1)
+ zw2d(A2D(0)) = sdenit(A2D(0)) * e1e2t(A2D(0)) * tmask(A2D(0),1)
+ zrdenittot = glob_sum ( 'p4zsms', zw3d )
+ zsdenittot = glob_sum ( 'p4zsms', Zw2d )
CALL iom_put( "tdenit" , ( zrdenittot + zsdenittot ) * xfact3 ) ! Total denitrification molC/l to molN/m3
+ DEALLOCATE( zw3d, zw2d )
ENDIF
!
IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer
diff --git a/src/TOP/PISCES/P4Z/p5zlim.F90 b/src/TOP/PISCES/P4Z/p5zlim.F90
index 91e94183a3e6f79b83a9db8ac4c3129fc5be99be..dfaa8c68402e642de8d293c07391ecc60b4f3f41 100644
--- a/src/TOP/PISCES/P4Z/p5zlim.F90
+++ b/src/TOP/PISCES/P4Z/p5zlim.F90
@@ -94,6 +94,9 @@ MODULE p5zlim
REAL(wp) :: xcoef1 = 0.00167 / 55.85
REAL(wp) :: xcoef2 = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5
REAL(wp) :: xcoef3 = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5
+
+ LOGICAL :: l_dia_nut_lim, l_dia_iron_lim, l_dia_fracal
+ LOGICAL :: l_dia_size_lim, l_dia_size_pro
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
@@ -136,15 +139,23 @@ CONTAINS
REAL(wp) :: zfvn, zfvp, zfvf, zsizen, zsizep, zsized, znanochl, zpicochl, zdiatchl
REAL(wp) :: zqfemn, zqfemp, zqfemd, zbactno3, zbactnh4, zbiron
REAL(wp) :: znutlimtot, zlimno3, zlimnh4, zlim1f, zsizetmp
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrassn, zrassp, zrassd
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p5z_lim')
+
+ IF( kt == nittrc000 ) THEN
+ l_dia_nut_lim = iom_use( "LNnut" ) .OR. iom_use( "LDnut" ) .OR. iom_use( "LPnut" )
+ l_dia_iron_lim = iom_use( "LNFe" ) .OR. iom_use( "LDFe" ) .OR. iom_use( "LPFe" )
+ l_dia_size_lim = iom_use( "SIZEN" ) .OR. iom_use( "SIZED" ) .OR. iom_use( "SIZEP" )
+ l_dia_size_pro = iom_use( "RASSN" ) .OR. iom_use( "RASSP" ) .OR. iom_use( "RASSP" )
+ l_dia_fracal = iom_use( "xfracal" )
+ ENDIF
!
zratchl = 6.0
sizena(:,:,:) = 0.0 ; sizepa(:,:,:) = 0.0 ; sizeda(:,:,:) = 0.0
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! Computation of the Chl/C ratio of each phytoplankton group
! -------------------------------------------------------
z1_trnphy = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
@@ -407,7 +418,7 @@ CONTAINS
! nutrient uptake pool and assembly machinery. DNA is assumed to represent 1% of the dry mass of
! phytoplankton (see Daines et al., 2013).
! --------------------------------------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! Size estimation of nanophytoplankton based on total biomass
! Assumes that larger biomass implies addition of larger cells
! ------------------------------------------------------------
@@ -419,7 +430,6 @@ CONTAINS
! Computed from Inomura et al. (2020) using Pavlova Lutheri
zrpho = 11.55 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn )
zrass = MAX(0.62/4., ( 1. - zrpho - zfuptk ) * xlimnpn(ji,jj,jk) )
- zrassn(ji,jj,jk) = zrass
xqpnmin(ji,jj,jk) = ( 0.0 + 0.0078 + 0.62/4. * 0.0783 ) * 16.
xqpnmax(ji,jj,jk) = ( zrpho * 0.0089 + zrass * 0.0783 ) * 16.
xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) + (0.033 + 0.0078 ) * 16.
@@ -437,7 +447,6 @@ CONTAINS
! Computed from Inomura et al. (2020) using a synechococcus
zrpho = 13.4 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn )
zrass = MAX(0.4/4., ( 1. - zrpho - zfuptk ) * xlimnpp(ji,jj,jk) )
- zrassp(ji,jj,jk) = zrass
xqppmin(ji,jj,jk) = ( (0.0 + 0.0078 ) + 0.4/4. * 0.0517 ) * 16.
xqppmax(ji,jj,jk) = ( zrpho * 0.0076 + zrass * 0.0517 ) * 16.
xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) + (0.033 + 0.0078 ) * 16
@@ -454,7 +463,6 @@ CONTAINS
! Computed from Inomura et al. (2020) using a synechococcus
zrpho = 8.08 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * 12. + rtrn )
zrass = MAX(0.66/4., ( 1. - zrpho - zfuptk ) * xlimnpd(ji,jj,jk) )
- zrassd(ji,jj,jk)=zrass
xqpdmin(ji,jj,jk) = ( ( 0.0 + 0.0078 ) + 0.66/4. * 0.0783 ) * 16.
xqpdmax(ji,jj,jk) = ( zrpho * 0.0135 + zrass * 0.0783 ) * 16.
xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) + ( 0.0078 + 0.033 ) * 16.
@@ -465,7 +473,7 @@ CONTAINS
! This is a purely adhoc formulation described in Aumont et al. (2015)
! This fraction depends on nutrient limitation, light, temperature
! --------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zlim1 = tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb) &
& / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb) &
& / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) )
@@ -482,7 +490,7 @@ CONTAINS
xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) )
END_3D
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
! denitrification factor computed from O2 levels
nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) &
& / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) )
@@ -490,19 +498,70 @@ CONTAINS
END_3D
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics
- CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht
- CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
- CALL iom_put( "LPnut" , xlimpic(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
- CALL iom_put( "LDnut" , xlimdia(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
- CALL iom_put( "LNFe" , xlimnfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "LPFe" , xlimpfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "LDFe" , xlimdfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "SIZEN" , sizen (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "SIZEP" , sizep (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "SIZED" , sized (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "RASSN" , zrassn (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "RASSP" , zrassp (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
- CALL iom_put( "RASSD" , zrassd (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
+ !
+ IF( l_dia_fracal ) THEN ! fraction of calcifiers
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = xfracal(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "xfracal", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_nut_lim ) THEN ! Nutrient limitation term
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = xlimphy(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LNnut", zw3d)
+ zw3d(A2D(0),1:jpkm1) = xlimdia(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LDnut", zw3d)
+ zw3d(A2D(0),1:jpkm1) = xlimpic(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LPnut", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_iron_lim ) THEN ! Iron limitation term
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = xlimnfe(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LNFe", zw3d)
+ zw3d(A2D(0),1:jpkm1) = xlimdfe(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LDFe", zw3d)
+ zw3d(A2D(0),1:jpkm1) = xlimpfe(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LPFe", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_size_lim ) THEN ! Size limitation term
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = sizen(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "SIZEN", zw3d)
+ zw3d(A2D(0),1:jpkm1) = sized(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "SIZED", zw3d)
+ zw3d(A2D(0),1:jpkm1) = sizep(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "SIZEP", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_size_pro ) THEN ! Size of the protein machinery
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfuptk = 0.2 + 0.12 / ( 3.0 * sizen(ji,jj,jk) + rtrn )
+ zrpho = 11.55 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn )
+ zw3d(ji,jj,jk) = MAX(0.62/4., ( 1. - zrpho - zfuptk ) * xlimnpn(ji,jj,jk) ) * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "RASSN", zw3d)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfuptk = 0.2 + 0.12 / ( 3.0 * sizep(ji,jj,jk) + rtrn )
+ zrpho = 11.55 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn )
+ zw3d(ji,jj,jk) = MAX(0.62/4., ( 1. - zrpho - zfuptk ) * xlimnpp(ji,jj,jk) ) * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "RASSP", zw3d)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfuptk = 0.2 + 0.12 / ( 3.0 * sized(ji,jj,jk) + rtrn )
+ zrpho = 11.55 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * 12. + rtrn )
+ zw3d(ji,jj,jk) = MAX(0.62/4., ( 1. - zrpho - zfuptk ) * xlimnpd(ji,jj,jk) ) * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "RASSD", zw3d)
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
ENDIF
!
IF( ln_timing ) CALL timing_stop('p5z_lim')
@@ -635,24 +694,24 @@ CONTAINS
ierr(:) = 0
!
!* Biological arrays for phytoplankton growth
- ALLOCATE( xpicono3(jpi,jpj,jpk), xpiconh4(jpi,jpj,jpk), &
- & xpicopo4(jpi,jpj,jpk), xpicodop(jpi,jpj,jpk), &
- & xnanodop(jpi,jpj,jpk), xdiatdop(jpi,jpj,jpk), &
- & xpicofer(jpi,jpj,jpk), xlimpfe (jpi,jpj,jpk), &
- & fvnuptk (jpi,jpj,jpk), fvduptk (jpi,jpj,jpk), &
- & xlimphys(jpi,jpj,jpk), xlimdias(jpi,jpj,jpk), &
- & xlimnpp (jpi,jpj,jpk), xlimnpn (jpi,jpj,jpk), &
- & xlimnpd (jpi,jpj,jpk), &
- & xlimpics(jpi,jpj,jpk), xqfuncfecp(jpi,jpj,jpk), &
- & fvpuptk (jpi,jpj,jpk), xlimpic (jpi,jpj,jpk), STAT=ierr(1) )
+ ALLOCATE( xpicono3(A2D(0),jpk), xpiconh4(A2D(0),jpk), &
+ & xpicopo4(A2D(0),jpk), xpicodop(A2D(0),jpk), &
+ & xnanodop(A2D(0),jpk), xdiatdop(A2D(0),jpk), &
+ & xpicofer(A2D(0),jpk), xlimpfe (A2D(0),jpk), &
+ & fvnuptk (A2D(0),jpk), fvduptk (A2D(0),jpk), &
+ & xlimphys(A2D(0),jpk), xlimdias(A2D(0),jpk), &
+ & xlimnpp (A2D(0),jpk), xlimnpn (A2D(0),jpk), &
+ & xlimnpd (A2D(0),jpk), &
+ & xlimpics(A2D(0),jpk), xqfuncfecp(A2D(0),jpk), &
+ & fvpuptk (A2D(0),jpk), xlimpic (A2D(0),jpk), STAT=ierr(1) )
!
!* Minimum/maximum quotas of phytoplankton
- ALLOCATE( xqnnmin (jpi,jpj,jpk), xqnnmax(jpi,jpj,jpk), &
- & xqpnmin (jpi,jpj,jpk), xqpnmax(jpi,jpj,jpk), &
- & xqnpmin (jpi,jpj,jpk), xqnpmax(jpi,jpj,jpk), &
- & xqppmin (jpi,jpj,jpk), xqppmax(jpi,jpj,jpk), &
- & xqndmin (jpi,jpj,jpk), xqndmax(jpi,jpj,jpk), &
- & xqpdmin (jpi,jpj,jpk), xqpdmax(jpi,jpj,jpk), STAT=ierr(2) )
+ ALLOCATE( xqnnmin (A2D(0),jpk), xqnnmax(A2D(0),jpk), &
+ & xqpnmin (A2D(0),jpk), xqpnmax(A2D(0),jpk), &
+ & xqnpmin (A2D(0),jpk), xqnpmax(A2D(0),jpk), &
+ & xqppmin (A2D(0),jpk), xqppmax(A2D(0),jpk), &
+ & xqndmin (A2D(0),jpk), xqndmax(A2D(0),jpk), &
+ & xqpdmin (A2D(0),jpk), xqpdmax(A2D(0),jpk), STAT=ierr(2) )
!
p5z_lim_alloc = MAXVAL( ierr )
!
diff --git a/src/TOP/PISCES/P4Z/p5zmeso.F90 b/src/TOP/PISCES/P4Z/p5zmeso.F90
index 24ca0260d8b5f0d17aebf1da57293231fb8eebf1..9e0bf8a6c21da3646a50fb312762cbc1a427db25 100644
--- a/src/TOP/PISCES/P4Z/p5zmeso.F90
+++ b/src/TOP/PISCES/P4Z/p5zmeso.F90
@@ -58,6 +58,7 @@ MODULE p5zmeso
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: depmig !: DVM of mesozooplankton : migration depth
INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: kmig !: Vertical indice of the the migration depth
+ LOGICAL :: l_dia_fezoo2, l_dia_graz2, l_dia_lprodz2
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
@@ -103,21 +104,40 @@ CONTAINS
REAL(wp) :: zmigreltime, zrum, zcodel, zargu, zval, zmigthick
CHARACTER (len=25) :: charout
REAL(wp) :: zrfact2, zmetexcess, zsigma, zdiffdn
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarem, zgraref, zgrapoc, zgrapof
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarep, zgraren, zgrapon, zgrapop
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgradoc, zgradon, zgradop
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zgrarem, zgraref, zgrapoc, zgrapof
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zgrarep, zgraren, zgrapon, zgrapop
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zgradoc, zgradon, zgradop
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigrem, zgramigref, zgramigpoc, zgramigpof
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigrep, zgramigren, zgramigpop, zgramigpon
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigdoc, zgramigdop, zgramigdon
-
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zgrazing2, zfezoo2, zzligprod2, zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p5z_meso')
!
+ IF( kt == nittrc000 ) THEN
+ l_dia_graz2 = iom_use( "GRAZ2" )
+ l_dia_fezoo2 = iom_use( "FEZOO2" )
+ l_dia_lprodz2 = ln_ligand .AND. iom_use( "LPRODZ2" )
+ ENDIF
+ IF( l_dia_lprodz2 ) THEN
+ ALLOCATE( zzligprod2(A2D(0),jpk) )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zzligprod2(ji,jj,jk) = tr(ji,jj,jk,jplgw,Krhs)
+ END_3D
+ ENDIF
+ IF( l_dia_fezoo2 ) THEN
+ ALLOCATE( zfezoo2(A2D(0),jpk) )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfezoo2(ji,jj,jk) = tr(ji,jj,jk,jpfer,Krhs)
+ END_3D
+ ENDIF
+ IF( l_dia_graz2 ) THEN
+ ALLOCATE( zgrazing2(A2D(0),jpk) )
+ ENDIF
+
! Initialization of local arrays
- zgrazing(:,:,:) = 0._wp ; zfezoo2(:,:,:) = 0._wp
zgrarem (:,:,:) = 0._wp ; zgraren(:,:,:) = 0._wp
zgrarep (:,:,:) = 0._wp ; zgraref(:,:,:) = 0._wp
zgrapoc (:,:,:) = 0._wp ; zgrapon(:,:,:) = 0._wp
@@ -136,7 +156,7 @@ CONTAINS
zmetexcess = 0.0
IF ( bmetexc2 ) zmetexcess = 1.0
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 )
zfact = xstep * tgfunc2(ji,jj,jk) * zcompam
@@ -284,7 +304,7 @@ CONTAINS
& + zgrazffpp + zgrazffpg
! Total grazing ( grazing by microzoo is already computed in p5zmicro )
- zgrazing(ji,jj,jk) = zgraztotc
+ IF( l_dia_graz2 ) zgrazing2(ji,jj,jk) = zgraztotc
! Stoichiometruc ratios of the food ingested by zooplanton
! --------------------------------------------------------
@@ -427,7 +447,7 @@ CONTAINS
! This fraction is sumed over the euphotic zone and is removed from
! the fluxes driven by mesozooplankton in the euphotic zone.
! --------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zmigreltime = (1. - strn(ji,jj))
IF( gdept(ji,jj,jk,Kmm) <= heup(ji,jj) ) THEN
zmigthick = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * ( 1. - zmigreltime )
@@ -460,7 +480,7 @@ CONTAINS
! The inorganic and organic fluxes induced by migrating organisms are added at the
! the migration depth (corresponding indice is set by kmig)
! --------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 1. ) THEN
jkt = kmig(ji,jj)
zdep = 1. / e3t(ji,jj,jkt,Kmm)
@@ -490,7 +510,7 @@ CONTAINS
! This only concerns the variables which are affected by DVM (inorganic
! nutrients, DOC agands, and particulate organic carbon).
! ---------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep(ji,jj,jk)
tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren(ji,jj,jk)
tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc(ji,jj,jk)
@@ -512,12 +532,47 @@ CONTAINS
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zgrapof(ji,jj,jk)
END_3D
!
+ ! Write the output
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- CALL iom_put( "PCAL" , prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Calcite production
- CALL iom_put( "GRAZ2" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Total grazing of phyto by zoo
- CALL iom_put( "FEZOO2", zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
- IF( ln_ligand ) &
- & CALL iom_put( "LPRODZ2", zgradoc(:,:,:) * ldocz * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
+ !
+ IF( iom_use ( "PCAL" ) ) THEN ! Calcite production
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = prodcal(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( "PCAL", zw3d )
+ DEALLOCATE( zw3d )
+ ENDIF
+ !
+ IF( l_dia_graz2 ) THEN ! Total grazing of phyto by zooplankton
+ zgrazing2(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zgrazing2(ji,jj,jk) = zgrazing2(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in mol/m2/s
+ END_3D
+ CALL iom_put( "GRAZ2" , zgrazing2 )
+ DEALLOCATE( zgrazing2 )
+ ENDIF
+ !
+ IF( l_dia_fezoo2 ) THEN
+ zfezoo2(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfezoo2(ji,jj,jk) = ( tr(ji,jj,jk,jpfer,Krhs) - zfezoo2(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "FEZOO2", zfezoo2 )
+ DEALLOCATE( zfezoo2 )
+ ENDIF
+ !
+ IF( l_dia_lprodz2 ) THEN
+ zzligprod2(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zzligprod2(ji,jj,jk) = ( tr(ji,jj,jk,jplgw,Krhs) - zzligprod2(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "LPRODZ2", zzligprod2 )
+ DEALLOCATE( zzligprod2 )
+ ENDIF
+ !
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
@@ -626,7 +681,7 @@ CONTAINS
! Compute the averaged values of oxygen, temperature over the domain
! 150m to 500 m depth.
! ------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
IF( tmask(ji,jj,jk) == 1.) THEN
IF( gdept(ji,jj,jk,Kmm) >= 150. .AND. gdept(ji,jj,jk,kmm) <= 500.) THEN
oxymoy(ji,jj) = oxymoy(ji,jj) + tr(ji,jj,jk,jpoxy,Kbb) * 1E6 * e3t(ji,jj,jk,Kmm)
@@ -639,7 +694,7 @@ CONTAINS
! Compute the difference between surface values and the mean values in the mesopelagic
! domain
! ------------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
z1dep = 1. / ( zdepmoy(ji,jj) + rtrn )
oxymoy(ji,jj) = tr(ji,jj,1,jpoxy,Kbb) * 1E6 - oxymoy(ji,jj) * z1dep
tempmoy(ji,jj) = ts(ji,jj,1,jp_tem,Kmm) - tempmoy(ji,jj) * z1dep
@@ -648,7 +703,7 @@ CONTAINS
! Computation of the migration depth based on the parameterization of
! Bianchi et al. (2013)
! -------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 1. ) THEN
ztotchl = ( tr(ji,jj,1,jppch,Kbb) + tr(ji,jj,1,jpnch,Kbb) + tr(ji,jj,1,jpdch,Kbb) ) * 1E6
depmig(ji,jj) = 398. - 0.56 * oxymoy(ji,jj) -115. * log10(ztotchl) + 0.36 * hmld(ji,jj) -2.4 * tempmoy(ji,jj)
@@ -657,7 +712,7 @@ CONTAINS
! Computation of the corresponding jk indice
! ------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
IF( depmig(ji,jj) >= gdepw(ji,jj,jk,Kmm) .AND. depmig(ji,jj) < gdepw(ji,jj,jk+1,Kmm) ) THEN
kmig(ji,jj) = jk
ENDIF
@@ -669,7 +724,7 @@ CONTAINS
! to 0. Thus, to avoid that problem, the migration depth is adjusted so
! that it falls above the OMZ
! -----------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( tr(ji,jj,kmig(ji,jj),jpoxy,Kbb) < 5E-6 ) THEN
DO jk = kmig(ji,jj),1,-1
IF( tr(ji,jj,jk,jpoxy,Kbb) >= 5E-6 .AND. tr(ji,jj,jk+1,jpoxy,Kbb) < 5E-6) THEN
@@ -689,7 +744,7 @@ CONTAINS
!! *** ROUTINE p5z_meso_alloc ***
!!----------------------------------------------------------------------
!
- ALLOCATE( depmig(jpi,jpj), kmig(jpi,jpj), STAT= p5z_meso_alloc )
+ ALLOCATE( depmig(A2D(0)), kmig(A2D(0)), STAT= p5z_meso_alloc )
!
IF( p5z_meso_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_meso_alloc : failed to allocate arrays.' )
!
diff --git a/src/TOP/PISCES/P4Z/p5zmicro.F90 b/src/TOP/PISCES/P4Z/p5zmicro.F90
index 6edfde55e504a8916bb3098a293078c1da86c3c0..d70b3ff467e7968481b132ff606cb50cee82daa0 100644
--- a/src/TOP/PISCES/P4Z/p5zmicro.F90
+++ b/src/TOP/PISCES/P4Z/p5zmicro.F90
@@ -53,6 +53,8 @@ MODULE p5zmicro
REAL(wp), PUBLIC :: xsigmadel !: Maximum additional width of the grazing window at low food density
LOGICAL, PUBLIC :: bmetexc !: Use of excess carbon for respiration
+ LOGICAL :: l_dia_fezoo, l_dia_graz1, l_dia_lprodz
+
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
@@ -88,18 +90,39 @@ CONTAINS
REAL(wp) :: zgraznc, zgraznn, zgraznp, zgrazpoc, zgrazpon, zgrazpop, zgrazpof
REAL(wp) :: zgrazdc, zgrazdn, zgrazdp, zgrazdf, zgraznf, zgrazz
REAL(wp) :: zgrazpc, zgrazpn, zgrazpp, zgrazpf, zbeta, zrfact2, zmetexcess
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo, zzligprod
REAL(wp) :: zsigma, zdiffdn, zdiffpn, zdiffdp, zproport, zproport2
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zgrazing, zfezoo, zzligprod, zw3d
CHARACTER (len=25) :: charout
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p5z_micro')
!
+ IF( kt == nittrc000 ) THEN
+ l_dia_graz1 = iom_use( "GRAZ1" )
+ l_dia_fezoo = iom_use( "FEZOO" )
+ l_dia_lprodz = ln_ligand .AND. iom_use( "LPRODZ" )
+ ENDIF
+ IF( l_dia_lprodz ) THEN
+ ALLOCATE( zzligprod(A2D(0),jpk) )
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zzligprod(ji,jj,jk) = tr(ji,jj,jk,jplgw,Krhs)
+ END_3D
+ ENDIF
+ IF( l_dia_fezoo ) THEN
+ ALLOCATE( zfezoo(A2D(0),jpk) )
+ DO_3D( 0, 0, 0, 0, 1, jpk)
+ zfezoo(ji,jj,jk) = tr(ji,jj,jk,jpfer,Krhs)
+ END_3D
+ ENDIF
+ IF( l_dia_graz1 ) THEN
+ ALLOCATE( zgrazing(A2D(0),jpk) )
+ ENDIF
+
! Use of excess carbon for metabolism
zmetexcess = 0.0
IF ( bmetexc ) zmetexcess = 1.0
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 )
zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz
! Proportion of nano and diatoms that are within the size range
@@ -207,14 +230,13 @@ CONTAINS
zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
!
! Total ingestion rates in C, P, Fe, N
- zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc
+ zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc ! Grazing by microzooplankton
+ IF( l_dia_graz1 ) zgrazing(ji,jj,jk) = zgraztotc
+
zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3
zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3
zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * feratz
!
- ! Grazing by microzooplankton
- zgrazing(ji,jj,jk) = zgraztotc
-
! Stoichiometruc ratios of the food ingested by zooplanton
! --------------------------------------------------------
zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn )
@@ -298,14 +320,12 @@ CONTAINS
!
IF( ln_ligand ) THEN
tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz
- zzligprod(ji,jj,jk) = zgradoc * ldocz
ENDIF
!
tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon
tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop
tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref
- zfezoo(ji,jj,jk) = zgraref
tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz
tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc
tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn
@@ -342,15 +362,36 @@ CONTAINS
END_3D
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- IF( iom_use("GRAZ1") ) THEN ! Total grazing of phyto by zooplankton
- zgrazing(:,:,jpk) = 0._wp ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
- IF( iom_use("FEZOO") ) THEN
- zfezoo (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO" , zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
- ENDIF
- IF( ln_ligand ) THEN
- zzligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:))
- ENDIF
+ !
+ IF( l_dia_graz1 ) THEN ! Total grazing of phyto by zooplankton
+ zgrazing(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zgrazing(ji,jj,jk) = zgrazing(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in mol/m2/s
+ END_3D
+ CALL iom_put( "GRAZ1" , zgrazing )
+ DEALLOCATE( zgrazing )
+ ENDIF
+ !
+ IF( l_dia_fezoo ) THEN
+ zfezoo(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zfezoo(ji,jj,jk) = ( tr(ji,jj,jk,jpfer,Krhs) - zfezoo(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "FEZOO", zfezoo )
+ DEALLOCATE( zfezoo )
+ ENDIF
+ !
+ IF( l_dia_lprodz ) THEN
+ zzligprod(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zzligprod(ji,jj,jk) = ( tr(ji,jj,jk,jplgw,Krhs) - zzligprod(ji,jj,jk) ) &
+ & * 1e9 * 1.e+3 * rfact2r * tmask(ji,jj,jk) ! conversion in nmol/m2/s
+ END_3D
+ CALL iom_put( "LPRODZ", zzligprod )
+ DEALLOCATE( zzligprod )
+ ENDIF
+ !
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
diff --git a/src/TOP/PISCES/P4Z/p5zmort.F90 b/src/TOP/PISCES/P4Z/p5zmort.F90
index 396be16f7db0f854fd3b3e4ba46fe6bf2fab4c45..4fb33dac3f590cf33e27a9ab99ab84683dcc35a5 100644
--- a/src/TOP/PISCES/P4Z/p5zmort.F90
+++ b/src/TOP/PISCES/P4Z/p5zmort.F90
@@ -80,7 +80,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('p5z_mort_nano')
!
prodcal(:,:,:) = 0. !: calcite production variable set to zero
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 )
! Quadratic mortality of nano due to aggregation during
@@ -151,7 +151,7 @@ CONTAINS
!
IF( ln_timing ) CALL timing_start('p5z_mort_pico')
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 )
! Quadratic mortality of pico due to aggregation during
@@ -215,7 +215,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('p5z_mort_diat')
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. )
diff --git a/src/TOP/PISCES/P4Z/p5zprod.F90 b/src/TOP/PISCES/P4Z/p5zprod.F90
index 848f8550539968bc10d6efcfcfc6ae007fc215d2..0888dfc072dcef329d69404c2cdd60ac5909f09a 100644
--- a/src/TOP/PISCES/P4Z/p5zprod.F90
+++ b/src/TOP/PISCES/P4Z/p5zprod.F90
@@ -26,7 +26,6 @@ MODULE p5zprod
PUBLIC p5z_prod ! called in p5zbio.F90
PUBLIC p5z_prod_init ! called in trcsms_pisces.F90
- PUBLIC p5z_prod_alloc
!! * Shared module variables
REAL(wp), PUBLIC :: pislopen !: P-I slope of nanophytoplankton
@@ -43,12 +42,16 @@ MODULE p5zprod
REAL(wp), PUBLIC :: chlcmin !: Minimum Chl/C ratio of phytoplankton
REAL(wp), PUBLIC :: grosip !: Mean Si/C ratio of diatoms
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdaylen ! day length
-
- REAL(wp) :: r1_rday !: 1 / rday
- REAL(wp) :: texcretn !: 1 - excretn
- REAL(wp) :: texcretp !: 1 - excretp
- REAL(wp) :: texcretd !: 1 - excretd
+ REAL(wp) :: r1_rday !: 1 / rday
+ REAL(wp) :: texcretn !: 1 - excretn
+ REAL(wp) :: texcretp !: 1 - excretp
+ REAL(wp) :: texcretd !: 1 - excretd
+ REAL(wp) :: xq10_n !: q10 coef for nano = 1. + xpsino3 * qnnmax
+ REAL(wp) :: xq10_p !: q10 coef for pico = 1. + xpsino3 * qnpmax
+ REAL(wp) :: xq10_d !: q10 coef for diat = 1. + xpsino3 * qndmax
+
+ LOGICAL :: l_dia_ppphy, l_dia_ppnew, l_dia_ppbfe, l_dia_ppbsi
+ LOGICAL :: l_dia_mu, l_dia_light, l_dia_lprod
!! * Substitutions
# include "do_loop_substitute.h90"
@@ -76,51 +79,60 @@ CONTAINS
INTEGER :: ji, jj, jk
REAL(wp) :: zsilfac, znanotot, zpicotot, zdiattot, zconctemp, zconctemp2
REAL(wp) :: zration, zratiop, zratiof, zmax, ztn, zadap
- REAL(wp) :: zpronmax, zpropmax, zprofmax, zratio
+ REAL(wp) :: zprofmax, zratio
+ REAL(wp) :: zpronewn, zpronewp, zpronewd
+ REAL(wp) :: zproregn, zproregp, zproregd
+ REAL(wp) :: zpropo4n, zpropo4p, zpropo4d
+ REAL(wp) :: zprodopn, zprodopp, zprodopd
REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zprontot, zproptot, zprodtot
REAL(wp) :: zproddoc, zproddon, zproddop, zprodsil, zprodfer, zprodlig, zresptot
REAL(wp) :: zprnutmax, zprochln, zprochld, zprochlp
REAL(wp) :: zpislopen, zpislopep, zpisloped
REAL(wp) :: zval, zpptot, zpnewtot, zpregtot
+ REAL(wp) :: zmxl_chl, zmxl_fac
REAL(wp) :: zqfpmax, zqfnmax, zqfdmax
REAL(wp) :: zfact, zrfact2, zmaxsi, zratiosi, zsizetmp, zlimfac, zsilim
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj ) :: zmixnano, zmixpico, zmixdiat
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadp, zpislopeadd
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprnut, zprmaxp, zprmaxn, zprmaxd
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprbio, zprpic, zprdia, zysopt
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprchln, zprchlp, zprchld
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcap, zprorcad
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofed, zprofep, zprofen
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewp, zpronewd
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zproregn, zproregp, zproregd
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpropo4n, zpropo4p, zpropo4d
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprodopn, zprodopp, zprodopd
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespn, zrespp, zrespd
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zpligprod
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprorcan, zprorcap, zprorcad
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zpislopeadn, zpislopeadp, zpislopeadd
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprnut, zprbio, zprpic, zprdia, zysopt
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprchln, zprchlp, zprchld
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprofed, zprofep, zprofen
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zpronmaxn, zpronmaxp,zpronmaxd
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zpropmaxn, zpropmaxp,zpropmaxd
+! REAL(wp), DIMENSION(A2D(0),jpk) :: zrespn, zrespp, zrespd
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zprmaxn, zprmaxd, zprmaxp, zmxl
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p5z_prod')
+ !
+ IF( kt == nittrc000 ) THEN
+ l_dia_ppphy = iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) .OR. iom_use( "PPPHYP" ) .OR. iom_use( "TPP" )
+ l_dia_ppnew = iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) .OR. iom_use( "PPNEWP" ) .OR. iom_use( "TPNEW")
+ l_dia_ppbfe = iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) .OR. iom_use( "PFeP" ) .OR. iom_use( "TPBFE")
+ l_dia_ppbsi = iom_use( "PBSi" )
+ l_dia_mu = iom_use( "Mumax" ) .OR. iom_use( "MuN" ) .OR. iom_use( "MuD") .OR. iom_use( "MuP")
+ l_dia_light = iom_use( "LNlight") .OR. iom_use( "LDlight") .OR. iom_use( "LPlight")
+ l_dia_lprod = ln_ligand .AND. ( iom_use( "LPRODP") .OR. iom_use( "LDETP") )
+ ENDIF
! Initialize the local arrays
- zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp
- zprofed (:,:,:) = 0._wp ; zprofep (:,:,:) = 0._wp ; zprofen (:,:,:) = 0._wp
- zpronewn(:,:,:) = 0._wp ; zpronewp(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp
- zproregn(:,:,:) = 0._wp ; zproregp(:,:,:) = 0._wp ; zproregd(:,:,:) = 0._wp
- zpropo4n(:,:,:) = 0._wp ; zpropo4p(:,:,:) = 0._wp ; zpropo4d(:,:,:) = 0._wp
- zprdia (:,:,:) = 0._wp ; zprpic (:,:,:) = 0._wp ; zprbio (:,:,:) = 0._wp
- zprodopn(:,:,:) = 0._wp ; zprodopp(:,:,:) = 0._wp ; zprodopd(:,:,:) = 0._wp
- zysopt (:,:,:) = 0._wp
- zrespn (:,:,:) = 0._wp ; zrespp (:,:,:) = 0._wp ; zrespd (:,:,:) = 0._wp
- zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp
+ zprorcan (:,:,:) = 0._wp ; zprorcap (:,:,:) = 0._wp ; zprorcad (:,:,:) = 0._wp
+ zprofen (:,:,:) = 0._wp ; zprofep (:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp
+ zprbio (:,:,:) = 0._wp ; zprpic (:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp
+ zpronmaxn(:,:,:) = 0._wp ; zpronmaxp(:,:,:) = 0._wp ; zpronmaxd(:,:,:) = 0._wp
+ zpropmaxn(:,:,:) = 0._wp ; zpropmaxp(:,:,:) = 0._wp ; zpropmaxd(:,:,:) = 0._wp
+ zmxl (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp
+
+! zrespn (:,:,:) = 0._wp ; zrespp (:,:,:) = 0._wp ; zrespd (:,:,:) = 0._wp
! Computation of the optimal production rates and nutrient uptake
! rates. Based on a Q10 description of the thermal dependency.
- zprnut (:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:)
- zprmaxn(:,:,:) = 0.8_wp * (1. + xpsino3 * qnnmax ) * r1_rday * tgfunc(:,:,:)
- zprmaxd(:,:,:) = 0.8_wp * (1. + xpsino3 * qndmax ) * r1_rday * tgfunc(:,:,:)
- zprmaxp(:,:,:) = 0.6_wp * (1. + xpsino3 * qnpmax ) * r1_rday * tgfunc(:,:,:)
+ zprnut (:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:)
+ zprmaxn(:,:,:) = 0.8_wp * xq10_n * r1_rday * tgfunc(:,:,:)
+ zprmaxd(:,:,:) = 0.8_wp * xq10_d * r1_rday * tgfunc(:,:,:)
+ zprmaxp(:,:,:) = 0.6_wp * xq10_p * r1_rday * tgfunc(:,:,:)
! Impact of the day duration and light intermittency on phytoplankton growth
! Intermittency is supposed to have a similar effect on production as
@@ -131,42 +143,39 @@ CONTAINS
! -------------------------------------------------------------------------
IF ( ln_p4z_dcyc ) THEN ! Diurnal cycle in PISCES
-
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
zval = MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
ENDIF
- zmxl_chl(ji,jj,jk) = zval / 24.
- zmxl_fac(ji,jj,jk) = 1.0 - exp( -0.26 * zval )
+ zmxl(ji,jj,jk) = zval
ENDIF
END_3D
-
ELSE ! No diurnal cycle in PISCES
-
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
zval = MAX( 1., strn(ji,jj) )
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
ENDIF
- zmxl_chl(ji,jj,jk) = zval / 24.
- zmxl_fac(ji,jj,jk) = 1.0 - exp( -0.26 * zval )
+ zmxl(ji,jj,jk) = zval
ENDIF
END_3D
ENDIF
- zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:)
- zprdia(:,:,:) = zprmaxd(:,:,:) * zmxl_fac(:,:,:)
- zprpic(:,:,:) = zprmaxp(:,:,:) * zmxl_fac(:,:,:)
-
- ! Maximum light intensity
- zdaylen(:,:) = MAX(1., strn(:,:)) / 24.
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ zmxl_fac = 1.0 - EXP( -0.26 * zmxl(ji,jj,jk) )
+ zprbio(ji,jj,jk) = zprmaxn(ji,jj,jk) * zmxl_fac
+ zprdia(ji,jj,jk) = zprmaxd(ji,jj,jk) * zmxl_fac
+ zprpic(ji,jj,jk) = zprmaxp(ji,jj,jk) * zmxl_fac
+ ENDIF
+ END_3D
! Computation of the P-I slope for nanos, picos and diatoms
! The formulation proposed by Geider et al. (1997) has been used.
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! Computation of the P-I slope for nanos and diatoms
ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. )
@@ -191,26 +200,31 @@ CONTAINS
! Computation of production function for Carbon
! Actual light levels are used here
! ---------------------------------------------
- zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) / zmxl_fac(ji,jj,jk) ) )
- zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) / zmxl_fac(ji,jj,jk) ) )
- zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) / zmxl_fac(ji,jj,jk) ) )
+ zmxl_fac = 1.0 - EXP( -0.26 * zmxl(ji,jj,jk) )
+ zmxl_chl = zmxl(ji,jj,jk) / 24.
+ !
+ zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) / zmxl_fac ) )
+ zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) / zmxl_fac ) )
+ zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) / zmxl_fac ) )
! Computation of production function for Chlorophyll
! Mean light level in the mixed layer (when appropriate)
! is used here (acclimation is in general slower than
! the characteristic time scales of vertical mixing)
! ------------------------------------------------------
- zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
- zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
- zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+ zpislopen = zpislopen * zmxl_fac / ( zmxl_chl + rtrn )
+ zpisloped = zpisloped * zmxl_fac / ( zmxl_chl + rtrn )
+ zpislopep = zpislopep * zmxl_fac / ( zmxl_chl + rtrn )
+ !
zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) )
zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) ) )
zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) )
ENDIF
END_3D
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ !
! Si/C of diatoms
! ------------------------
! Si/C increases with iron stress and silicate availability (zsilfac)
@@ -242,7 +256,7 @@ CONTAINS
! Sea-ice effect on production
! No production is assumed below sea ice
! --------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
@@ -256,7 +270,7 @@ CONTAINS
! quota, uptake is downregulated according to a sigmoidal function
! (power 2), as proposed by Flynn (2003)
! ---------------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for nanophyto.
zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2
@@ -278,17 +292,13 @@ CONTAINS
! Uptake of nitrogen
zratio = 1.0 - MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) )
zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) )
- zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) ) &
+ zpronmaxn(ji,jj,jk) = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) ) &
& / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) )
- zpronmax = zpronmax * xqnnmin(ji,jj,jk) / qnnmin
- zpronewn(ji,jj,jk) = zpronmax * xnanono3(ji,jj,jk)
- zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk)
+ zpronmaxn(ji,jj,jk) = zpronmaxn(ji,jj,jk) * xqnnmin(ji,jj,jk) / qnnmin
! Uptake of phosphorus and DOP
zratio = 1.0 - MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) )
zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) )
- zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk)
- zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk)
- zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk)
+ zpropmaxn(ji,jj,jk) = zprnutmax * zmax * xlimnfe(ji,jj,jk)
! Uptake of iron
zqfnmax = xqfuncfecn(ji,jj,jk) + ( qfnmax - xqfuncfecn(ji,jj,jk) ) * xlimnpn(ji,jj,jk)
zratio = 1.0 - MIN( 1., zratiof / zqfnmax )
@@ -307,8 +317,9 @@ CONTAINS
! quota, uptake is downregulated according to a sigmoidal function
! (power 2), as proposed by Flynn (2003)
! ---------------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ !
! production terms for picophyto.
zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2
! Size computation
@@ -328,17 +339,13 @@ CONTAINS
! Uptake of nitrogen
zratio = 1.0 - MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) )
zmax = MAX(0., MIN(1., zratio**2/ (0.05**2 + zratio**2) ) )
- zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) ) &
+ zpronmaxp(ji,jj,jk) = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) ) &
& / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) )
- zpronmax = zpronmax * xqnpmin(ji,jj,jk) / qnnmin
- zpronewp(ji,jj,jk) = zpronmax * xpicono3(ji,jj,jk)
- zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk)
+ zpronmaxp(ji,jj,jk) = zpronmaxp(ji,jj,jk) * xqnpmin(ji,jj,jk) / qnnmin
! Uptake of phosphorus
zratio = 1.0 - MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) )
zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) )
- zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk)
- zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk)
- zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk)
+ zpropmaxp(ji,jj,jk) = zprnutmax * zmax * xlimpfe(ji,jj,jk)
! Uptake of iron
zqfpmax = xqfuncfecp(ji,jj,jk) + ( qfpmax - xqfuncfecp(ji,jj,jk) ) * xlimnpp(ji,jj,jk)
zratio = 1.0 - MIN( 1., zratiof / zqfpmax )
@@ -357,8 +364,9 @@ CONTAINS
! quota, uptake is downregulated according to a sigmoidal function
! (power 2), as proposed by Flynn (2003)
! ---------------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ !
! production terms for diatomees
zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2
! Size computation
@@ -378,17 +386,13 @@ CONTAINS
! Uptake of nitrogen
zratio = 1.0 - MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) )
zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) )
- zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) ) &
+ zpronmaxd(ji,jj,jk) = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) ) &
& / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) )
- zpronmax = zpronmax * xqndmin(ji,jj,jk) / qnnmin
- zpronewd(ji,jj,jk) = zpronmax * xdiatno3(ji,jj,jk)
- zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk)
+ zpronmaxd(ji,jj,jk) = zpronmaxd(ji,jj,jk) * xqndmin(ji,jj,jk) / qnnmin
! Uptake of phosphorus
zratio = 1.0 - MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) )
zmax = MAX(0., MIN(1., zratio**2/ (0.05**2 + zratio**2) ) )
- zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk)
- zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk)
- zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk)
+ zpropmaxd(ji,jj,jk) = zprnutmax * zmax * xlimdfe(ji,jj,jk)
! Uptake of iron
zqfdmax = xqfuncfecd(ji,jj,jk) + ( qfdmax - xqfuncfecd(ji,jj,jk) ) * xlimnpd(ji,jj,jk)
zratio = 1.0 - MIN( 1., zratiof / zqfdmax )
@@ -403,21 +407,28 @@ CONTAINS
! Production of Chlorophyll. The formulation proposed by Geider et al.
! is adopted here.
! --------------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
- ! production terms for nanophyto. ( chlorophyll )
- znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
- zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk)
+ zmxl_chl = zmxl(ji,jj,jk) / 24.
+ ! production terms for nanophyto. ( chlorophyll )
+ zpronewn = zpronmaxn(ji,jj,jk) * xnanono3(ji,jj,jk)
+ zproregn = zpronmaxn(ji,jj,jk) * xnanonh4(ji,jj,jk)
+ znanotot = enanom(ji,jj,jk) / ( zmxl_chl + rtrn )
+ zprod = rday * (zpronewn + zproregn) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk)
zprochln = thetannm * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn )
zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) )
- ! production terms for picophyto. ( chlorophyll )
- zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
- zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk)
+ ! production terms for picophyto. ( chlorophyll )
+ zpronewp = zpronmaxp(ji,jj,jk) * xpicono3(ji,jj,jk)
+ zproregp = zpronmaxp(ji,jj,jk) * xpiconh4(ji,jj,jk)
+ zpicotot = epicom(ji,jj,jk) / ( zmxl_chl + rtrn )
+ zprod = rday * (zpronewp + zproregp) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk)
zprochlp = thetanpm * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn )
zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) )
! production terms for diatoms ( chlorophyll )
- zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
- zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk)
+ zpronewd = zpronmaxd(ji,jj,jk) * xdiatno3(ji,jj,jk)
+ zproregd = zpronmaxd(ji,jj,jk) * xdiatnh4(ji,jj,jk)
+ zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl + rtrn )
+ zprod = rday * (zpronewd + zproregd) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk)
zprochld = thetandm * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn )
zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) )
! Update the arrays TRA which contain the Chla sources and sinks
@@ -428,83 +439,104 @@ CONTAINS
END_3D
! Update the arrays TRA which contain the biological sources and sinks
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
- zpptot = zpropo4n(ji,jj,jk) + zpropo4d(ji,jj,jk) + zpropo4p(ji,jj,jk)
- zpnewtot = zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk)
- zpregtot = zproregn(ji,jj,jk) + zproregd(ji,jj,jk) + zproregp(ji,jj,jk)
-
- zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)
- zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)
- zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)
- !
- zproddoc = excretd * zprorcad(ji,jj,jk) &
- & + excretn * zprorcan(ji,jj,jk) &
- & + excretp * zprorcap(ji,jj,jk)
- !
- zproddop = excretd * zpropo4d(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) &
- & + excretn * zpropo4n(ji,jj,jk) - texcretn * zprodopn(ji,jj,jk) &
- & + excretp * zpropo4p(ji,jj,jk) - texcretp * zprodopp(ji,jj,jk)
-
- zproddon = excretd * zprodtot + excretn * zprontot + excretp * zproptot
-
- zprodfer = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
- zresptot = zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk)
- !
- tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpptot
- tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpnewtot
- tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zpregtot
- !
- tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) &
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zpronewn = zpronmaxn(ji,jj,jk) * xnanono3(ji,jj,jk)
+ zpronewp = zpronmaxp(ji,jj,jk) * xpicono3(ji,jj,jk)
+ zpronewd = zpronmaxd(ji,jj,jk) * xdiatno3(ji,jj,jk)
+ !
+ zproregn = zpronmaxn(ji,jj,jk) * xnanonh4(ji,jj,jk)
+ zproregp = zpronmaxp(ji,jj,jk) * xpiconh4(ji,jj,jk)
+ zproregd = zpronmaxd(ji,jj,jk) * xdiatnh4(ji,jj,jk)
+ !
+ zpropo4n = zpropmaxn(ji,jj,jk) * xnanopo4(ji,jj,jk)
+ zpropo4p = zpropmaxp(ji,jj,jk) * xpicopo4(ji,jj,jk)
+ zpropo4d = zpropmaxd(ji,jj,jk) * xdiatpo4(ji,jj,jk)
+ !
+ zprodopn = zpropmaxn(ji,jj,jk) * xnanodop(ji,jj,jk)
+ zprodopp = zpropmaxp(ji,jj,jk) * xpicodop(ji,jj,jk)
+ zprodopd = zpropmaxd(ji,jj,jk) * xdiatdop(ji,jj,jk)
+ !
+ zpptot = zpropo4n + zpropo4d + zpropo4p
+ zpnewtot = zpronewn + zpronewd + zpronewp
+ zpregtot = zproregn + zproregd + zproregp
+
+ zprontot = zpronewn + zproregn
+ zproptot = zpronewp + zproregp
+ zprodtot = zpronewd + zproregd
+ !
+ zproddoc = excretd * zprorcad(ji,jj,jk) &
+ & + excretn * zprorcan(ji,jj,jk) &
+ & + excretp * zprorcap(ji,jj,jk)
+ !
+ zproddop = excretd * zpropo4d - texcretd * zprodopd &
+ & + excretn * zpropo4n - texcretn * zprodopn &
+ & + excretp * zpropo4p - texcretp * zprodopp
+
+ zproddon = excretd * zprodtot + excretn * zprontot + excretp * zproptot
+
+ zprodfer = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
+! CE : zrespn/d/p ????
+! zresptot = zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk)
+ zresptot = 0._wp
+ !
+ tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpptot
+ tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpnewtot
+ tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zpregtot
+ !
+ tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) &
& + zprorcan(ji,jj,jk) * texcretn &
- & - xpsino3 * zpronewn(ji,jj,jk) &
- & - xpsinh4 * zproregn(ji,jj,jk) &
- & - zrespn(ji,jj,jk)
-
- tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn
- tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + ( zpropo4n(ji,jj,jk) + zprodopn(ji,jj,jk) ) * texcretn
- tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn
-
- !
- tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) &
- & + zprorcap(ji,jj,jk) * texcretp &
- & - xpsino3 * zpronewp(ji,jj,jk) &
- & - xpsinh4 * zproregp(ji,jj,jk) &
- & - zrespp(ji,jj,jk)
-
- tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp
- tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + ( zpropo4p(ji,jj,jk) + zprodopp(ji,jj,jk) ) * texcretp
- tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp
-
- !
- tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) &
- & + zprorcad(ji,jj,jk) * texcretd &
- & - xpsino3 * zpronewd(ji,jj,jk) &
- & - xpsinh4 * zproregd(ji,jj,jk) &
- & - zrespd(ji,jj,jk)
-
- tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd
- tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + ( zpropo4d(ji,jj,jk) + zprodopd(ji,jj,jk) ) * texcretd
- tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd
- tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprmaxd(ji,jj,jk) * zysopt(ji,jj,jk) * rfact2 * tr(ji,jj,jk,jpdia,Kbb)
- tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zproddoc
- tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zproddon
- tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zproddop
+ & - xpsino3 * zpronewn &
+ & - xpsinh4 * zproregn
+! & - zrespn(ji,jj,jk)
+
+ tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn
+ tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + ( zpropo4n + zprodopn ) * texcretn
+ tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn
+
+ !
+ tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) &
+ & + zprorcap(ji,jj,jk) * texcretp &
+ & - xpsino3 * zpronewp &
+ & - xpsinh4 * zproregp
+! & - zrespp(ji,jj,jk)
+
+ tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp
+ tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + ( zpropo4p + zprodopp ) * texcretp
+ tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp
+
+ !
+ tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) &
+ & + zprorcad(ji,jj,jk) * texcretd &
+ & - xpsino3 * zpronewd &
+ & - xpsinh4 * zproregd
+! & - zrespd(ji,jj,jk)
+
+ !
+ zprodsil = zprmaxd(ji,jj,jk) * zysopt(ji,jj,jk) * rfact2 * tr(ji,jj,jk,jpdia,Kbb)
+ !
+ tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd
+ tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + ( zpropo4d + zprodopd ) * texcretd
+ tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd
+ tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprodsil
+ tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zproddoc
+ tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zproddon
+ tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zproddop
- tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) &
+ tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) &
& + o2ut * zpregtot + ( o2ut + o2nit ) * zpnewtot - o2ut * zresptot
- tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zprodfer
- consfe3(ji,jj,jk) = zprodfer * 75.0 / ( rtrn + ( plig(ji,jj,jk) + 75.0 * (1.0 - plig(ji,jj,jk) ) ) &
- & * tr(ji,jj,jk,jpfer,Kbb) ) / rfact2
- tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - zprmaxd(ji,jj,jk) * zysopt(ji,jj,jk) * rfact2 * tr(ji,jj,jk,jpdia,Kbb)
+ tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zprodfer
+ consfe3(ji,jj,jk) = zprodfer * 75.0 / ( rtrn + ( plig(ji,jj,jk) + 75.0 * (1.0 - plig(ji,jj,jk) ) ) &
+ & * tr(ji,jj,jk,jpfer,Kbb) ) / rfact2
+ tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - zprodsil
- tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zpptot &
- & + xpsino3 * zpronewn(ji,jj,jk) + xpsinh4 * zproregn(ji,jj,jk) &
- & + xpsino3 * zpronewp(ji,jj,jk) + xpsinh4 * zproregp(ji,jj,jk) &
- & + xpsino3 * zpronewd(ji,jj,jk) + xpsinh4 * zproregd(ji,jj,jk)
+ tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zpptot &
+ & + xpsino3 * zpronewn + xpsinh4 * zproregn &
+ & + xpsino3 * zpronewp + xpsinh4 * zproregp &
+ & + xpsino3 * zpronewd + xpsinh4 * zproregd
- tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpnewtot - zpregtot )
- !
+ tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpnewtot - zpregtot )
+ !
END_3D
! Production and uptake of ligands by phytoplankton. This part is activated
@@ -513,7 +545,7 @@ CONTAINS
! Shaked and Lis (2012)
! -------------------------------------------------------------------------
IF( ln_ligand ) THEN
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
zproddoc = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk)
zprodfer = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
zprodlig = plig(ji,jj,jk) / ( rtrn + plig(ji,jj,jk) + 75.0 * (1.0 - plig(ji,jj,jk) ) ) * lthet
@@ -522,47 +554,141 @@ CONTAINS
END_3D
ENDIF
+ ! Output of the diagnostics
! Total primary production per year
- IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) &
- & tpp = glob_sum( 'p5zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) )
+ IF( l_dia_ppphy .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) THEN
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
+ zw3d(ji,jj,jk) = ( zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk) + zprorcap(ji,jj,jk) ) * cvol(ji,jj,jk)
+ END_3D
+ tpp = glob_sum( 'p5zprod', zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
IF( lk_iomput .AND. knt == nrdttrc ) THEN
- zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
!
- CALL iom_put( "PPPHYP" , zprorcap(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by picophyto
- CALL iom_put( "PPPHYN" , zprorcan(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by nanophyto
- CALL iom_put( "PPPHYD" , zprorcad(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by diatomes
- CALL iom_put( "PPNEWN" , zpronewp(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by picophyto
- CALL iom_put( "PPNEWN" , zpronewn(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by nanophyto
- CALL iom_put( "PPNEWD" , zpronewd(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by diatomes
- CALL iom_put( "PBSi" , zprmaxd (:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production
- CALL iom_put( "PFeP" , zprofep (:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by picophyto
- CALL iom_put( "PFeN" , zprofen(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by nanophyto
- CALL iom_put( "PFeD" , zprofed(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by diatomes
- IF( ln_ligand .AND. ( iom_use( "LPRODP" ) .OR. iom_use( "LDETP" ) ) ) THEN
- ALLOCATE( zpligprod(jpi,jpj,jpk) )
- zpligprod(:,:,:) = excretd * zprorcad(:,:,:) + excretn * zprorcan(:,:,:) + excretp * zprorcap(:,:,:)
- CALL iom_put( "LPRODP" , zpligprod(:,:,:) * ldocp * 1e9 * zfact * tmask(:,:,:) )
- !
- zpligprod(:,:,:) = ( texcretn * zprofen(:,:,:) + texcretd * zprofed(:,:,:) + texcretp * zprofep(:,:,:) ) &
- & * plig(:,:,:) / ( rtrn + plig(:,:,:) + 75.0 * (1.0 - plig(:,:,:) ) )
- CALL iom_put( "LDETP" , zpligprod(:,:,:) * lthet * 1e9 * zfact * tmask(:,:,:) )
- DEALLOCATE( zpligprod )
+ IF( l_dia_ppphy ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! primary production by nanophyto
+ zw3d(A2D(0),1:jpkm1) = zprorcan(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPPHYN", zw3d )
+ ! primary production by diatomes
+ zw3d(A2D(0),1:jpkm1) = zprorcad(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPPHYD", zw3d )
+ ! primary production by pico
+ zw3d(A2D(0),1:jpkm1) = zprorcap(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPPHYP", zw3d )
+ ! total primary production
+ zw3d(A2D(0),1:jpkm1) = ( zprorcan(A2D(0),1:jpkm1) + zprorcad(A2D(0),1:jpkm1) + zprorcap(A2D(0),1:jpkm1) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "TPP", zw3d )
+ CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ IF( l_dia_ppnew ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! new primary production by nano
+ zw3d(A2D(0),1:jpkm1) = zpronmaxn(A2D(0),1:jpkm1) * xnanono3(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPNEWN", zw3d )
+ ! new primary production by diatomes
+ zw3d(A2D(0),1:jpkm1) = zpronmaxd(A2D(0),1:jpkm1) * xdiatno3(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPNEWD", zw3d )
+ ! new primary production by pico
+ zw3d(A2D(0),1:jpkm1) = zpronmaxp(A2D(0),1:jpkm1) * xpicono3(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PPNEWP", zw3d )
+ ! total new production
+ zw3d(A2D(0),1:jpkm1) = ( zpronmaxn(A2D(0),1:jpkm1) * xnanono3(A2D(0),1:jpkm1) + &
+ & zpronmaxd(A2D(0),1:jpkm1) * xdiatno3(A2D(0),1:jpkm1) + &
+ & zpronmaxp(A2D(0),1:jpkm1) * xpicono3(A2D(0),1:jpkm1) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "TPNEW", zw3d )
+ DEALLOCATE ( zw3d )
ENDIF
- CALL iom_put( "Mumax" , zprmaxn(:,:,:) * tmask(:,:,:) ) ! Maximum growth rate
- CALL iom_put( "MuP" , zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto
- CALL iom_put( "MuN" , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
- CALL iom_put( "MuD" , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
- CALL iom_put( "LPlight" , zprpic(:,:,:) / (zprmaxp(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term
- CALL iom_put( "LNlight" , zprbio(:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term
- CALL iom_put( "LDlight" , zprdia(:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:) )
- CALL iom_put( "MunetP" , ( tr(:,:,:,jppic,Krhs)/rfact2/(tr(:,:,:,jppic,Kbb)+ rtrn ) * tmask(:,:,:)) ) ! Realized growth rate for picophyto
- CALL iom_put( "MunetN" , ( tr(:,:,:,jpphy,Krhs)/rfact2/(tr(:,:,:,jpphy,Kbb)+ rtrn ) * tmask(:,:,:)) ) ! Realized growth rate for picophyto
- CALL iom_put( "MunetD" , ( tr(:,:,:,jpdia,Krhs)/rfact2/(tr(:,:,:,jpdia,Kbb)+ rtrn ) * tmask(:,:,:)) ) ! Realized growth rate for picophyto
- CALL iom_put( "TPP" , ( zprorcap(:,:,:) + zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ) ! total primary production
- CALL iom_put( "TPNEW" , ( zpronewp(:,:,:) + zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ) ! total new production
- CALL iom_put( "TPBFE" , ( zprofep (:,:,:) + zprofen (:,:,:) + zprofed (:,:,:) ) * zfact * tmask(:,:,:) ) ! total biogenic iron production
- CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s
+ !
+ IF( l_dia_ppbsi ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! biogenic silica production
+ zw3d(A2D(0),1:jpkm1) = zprmaxd(A2D(0),1:jpkm1) * zysopt(A2D(0),1:jpkm1) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PBSi", zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ !
+ IF( l_dia_ppbfe ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! biogenic iron production by nanophyto
+ zw3d(A2D(0),1:jpkm1) = zprofen(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PFeN", zw3d )
+ ! biogenic iron production by diatomes
+ zw3d(A2D(0),1:jpkm1) = zprofed(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PFeD", zw3d )
+ ! biogenic iron production by pico
+ zw3d(A2D(0),1:jpkm1) = zprofep(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "PFeP", zw3d )
+ ! total biogenic iron production
+ zw3d(A2D(0),1:jpkm1) = ( zprofen(A2D(0),1:jpkm1) + zprofed(A2D(0),1:jpkm1) + zprofep(A2D(0),1:jpkm1) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "TPBFE", zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ IF( l_dia_mu ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = zprmaxn(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "Mumax", zw3d )
+ ! Realized growth rate for nanophyto
+ zw3d(A2D(0),1:jpkm1) = zprbio(A2D(0),1:jpkm1) * xlimphy(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "MuN", zw3d )
+ ! Realized growth rate for diatoms
+ zw3d(A2D(0),1:jpkm1) = zprdia(A2D(0),1:jpkm1) * xlimdia(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "MuD", zw3d )
+ ! Realized growth rate for pico
+ zw3d(A2D(0),1:jpkm1) = zprpic(A2D(0),1:jpkm1) * xlimpic(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "MuP", zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ !
+ IF( l_dia_light ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ ! light limitation term for nano
+ zw3d(A2D(0),1:jpkm1) = zprbio(A2D(0),1:jpkm1) / (zprmaxn(A2D(0),1:jpkm1)+rtrn) &
+ & * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LNlight", zw3d )
+ ! light limitation term for diatomes
+ zw3d(A2D(0),1:jpkm1) = zprdia(A2D(0),1:jpkm1) / (zprmaxd(A2D(0),1:jpkm1)+rtrn) &
+ & * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LDlight", zw3d )
+ ! light limitation term for pico
+ zw3d(A2D(0),1:jpkm1) = zprpic(A2D(0),1:jpkm1) / (zprmaxp(A2D(0),1:jpkm1)+rtrn) &
+ & * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LPlight", zw3d )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
+ IF( l_dia_lprod ) THEN
+ zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
+ ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = ( excretd * zprorcad(A2D(0),1:jpkm1) + excretn * zprorcan(A2D(0),1:jpkm1) + &
+ & excretp * zprorcap(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LPRODP" , zw3d * ldocp * 1e9 )
+ !
+ zw3d(A2D(0),1:jpkm1) = ( texcretn * zprofen(A2D(0),1:jpkm1) + texcretd * zprofed(A2D(0),1:jpkm1) + &
+ & texcretp * zprofep(A2D(0),1:jpkm1) ) * plig(A2D(0),1:jpkm1) &
+ & / ( rtrn + plig(A2D(0),1:jpkm1) + 75.0 * (1.0 - plig(A2D(0),1:jpkm1) ) ) &
+ & * zfact * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "LDETP" , zw3d * lthet * 1e9 )
+ DEALLOCATE ( zw3d )
+ ENDIF
+ !
ENDIF
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
@@ -625,17 +751,11 @@ CONTAINS
texcretd = 1._wp - excretd
tpp = 0._wp
!
+ xq10_n = 1. + xpsino3 * qnnmax
+ xq10_d = 1. + xpsino3 * qndmax
+ xq10_p = 1. + xpsino3 * qnpmax
+ !
END SUBROUTINE p5z_prod_init
-
- INTEGER FUNCTION p5z_prod_alloc()
- !!----------------------------------------------------------------------
- !! *** ROUTINE p5z_prod_alloc ***
- !!----------------------------------------------------------------------
- ALLOCATE( zdaylen(jpi,jpj), STAT = p5z_prod_alloc )
- !
- IF( p5z_prod_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_prod_alloc : failed to allocate arrays.' )
- !
- END FUNCTION p5z_prod_alloc
!!======================================================================
END MODULE p5zprod
diff --git a/src/TOP/PISCES/SED/sedchem.F90 b/src/TOP/PISCES/SED/sedchem.F90
index afdc80a1c67aab714f5fa287713a32a89e0d549b..8c5d9e50f5489955f9c67460925dc769507c1c58 100644
--- a/src/TOP/PISCES/SED/sedchem.F90
+++ b/src/TOP/PISCES/SED/sedchem.F90
@@ -138,7 +138,7 @@ CONTAINS
IF (ln_sediment_offline) THEN
CALL sed_chem_cst
ELSE
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
IF ( tmask(ji,jj,ikt) == 1 ) THEN
zchem_data(ji,jj,1) = ak13 (ji,jj,ikt)
diff --git a/src/TOP/PISCES/SED/sedsfc.F90 b/src/TOP/PISCES/SED/sedsfc.F90
index 460d760d94900d1ae159b9ec11b90db666977c74..9e36c0727122b19e610eb26dd9429fe8a4c0391e 100644
--- a/src/TOP/PISCES/SED/sedsfc.F90
+++ b/src/TOP/PISCES/SED/sedsfc.F90
@@ -49,7 +49,7 @@ CONTAINS
CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,8), iarroce(1:jpoce), pwcp(1:jpoce,1,jwfe2) )
CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,9), iarroce(1:jpoce), pwcp(1:jpoce,1,jwlgw) )
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
IF ( tmask(ji,jj,ikt) == 1 ) THEN
tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1)
diff --git a/src/TOP/PISCES/SED/trcdmp_sed.F90 b/src/TOP/PISCES/SED/trcdmp_sed.F90
index 190206e5482ee8c689af5e05cc59dba609a27c6b..b17ee20af3b24bf6bd9470d3d90afaf16df726e9 100644
--- a/src/TOP/PISCES/SED/trcdmp_sed.F90
+++ b/src/TOP/PISCES/SED/trcdmp_sed.F90
@@ -92,7 +92,7 @@ CONTAINS
jl = n_trc_index(jn)
CALL trc_dta( kt, jl, ztrcdta ) ! read tracer data at nit000
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) - ztrcdta(ji,jj,ikt) ) &
& * exp( -restosed(ji,jj,ikt) * dtsed )
diff --git a/src/TOP/PISCES/sms_pisces.F90 b/src/TOP/PISCES/sms_pisces.F90
index ba890a006293caee267e405e6f29a9ed15445d83..e4862e94983ae2c3e7157d98e0bf86a5fc69529b 100644
--- a/src/TOP/PISCES/sms_pisces.F90
+++ b/src/TOP/PISCES/sms_pisces.F90
@@ -124,6 +124,8 @@ MODULE sms_pisces
LOGICAL, SAVE :: lk_sed
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: sms_pisces.F90 15459 2021-10-29 08:19:18Z cetlod $
@@ -140,52 +142,52 @@ CONTAINS
!!----------------------------------------------------------------------
ierr(:) = 0
!* Biological fluxes for light : shared variables for pisces & lobster
- ALLOCATE( xksi(jpi,jpj), strn(jpi,jpj), STAT=ierr(1) )
+ ALLOCATE( xksi(A2D(0)), strn(A2D(0)), STAT=ierr(1) )
IF( ln_p4z .OR. ln_p5z ) THEN
!* Optics
- ALLOCATE( enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk) , &
- & enanom(jpi,jpj,jpk), ediatm(jpi,jpj,jpk), &
- & emoy(jpi,jpj,jpk) , etotm(jpi,jpj,jpk), STAT=ierr(2) )
+ ALLOCATE( enano(A2D(0),jpk) , ediat(A2D(0),jpk) , &
+ & enanom(A2D(0),jpk), ediatm(A2D(0),jpk), &
+ & emoy(A2D(0),jpk) , etotm(A2D(0),jpk), STAT=ierr(2) )
!* Biological SMS
- ALLOCATE( xksimax(jpi,jpj) , biron(jpi,jpj,jpk) , STAT=ierr(3) )
+ ALLOCATE( xksimax(A2D(0)) , biron(A2D(0),jpk) , STAT=ierr(3) )
! Biological SMS
- ALLOCATE( xfracal (jpi,jpj,jpk), orem (jpi,jpj,jpk), &
- & nitrfac (jpi,jpj,jpk), nitrfac2(jpi,jpj,jpk), &
- & prodcal (jpi,jpj,jpk), xdiss (jpi,jpj,jpk), &
- & prodpoc (jpi,jpj,jpk), conspoc (jpi,jpj,jpk), &
- & prodgoc (jpi,jpj,jpk), consgoc (jpi,jpj,jpk), &
- & blim (jpi,jpj,jpk), consfe3 (jpi,jpj,jpk), &
- & xfecolagg(jpi,jpj,jpk), xcoagfe (jpi,jpj,jpk), STAT=ierr(4) )
+ ALLOCATE( xfracal (A2D(0),jpk), orem (A2D(0),jpk), &
+ & nitrfac (A2D(0),jpk), nitrfac2(A2D(0),jpk), &
+ & prodcal (A2D(0),jpk), xdiss (A2D(0),jpk), &
+ & prodpoc (A2D(0),jpk), conspoc (A2D(0),jpk), &
+ & prodgoc (A2D(0),jpk), consgoc (A2D(0),jpk), &
+ & blim (A2D(0),jpk), consfe3 (A2D(0),jpk), &
+ & xfecolagg(A2D(0),jpk), xcoagfe (A2D(0),jpk), STAT=ierr(4) )
!* Carbonate chemistry
- ALLOCATE( ak13 (jpi,jpj,jpk) , &
- & ak23(jpi,jpj,jpk) , aksp (jpi,jpj,jpk) , &
- & hi (jpi,jpj,jpk) , excess(jpi,jpj,jpk) , &
- & aphscale(jpi,jpj,jpk), STAT=ierr(5) )
+ ALLOCATE( ak13(A2D(0),jpk), &
+ & ak23(A2D(0),jpk), aksp (A2D(0),jpk) , &
+ & hi (A2D(0),jpk), excess(A2D(0),jpk) , &
+ & aphscale(A2D(0),jpk), STAT=ierr(5) )
!
!* Temperature dependency of SMS terms
- ALLOCATE( tgfunc (jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk), STAT=ierr(6) )
+ ALLOCATE( tgfunc (A2D(0),jpk) , tgfunc2(A2D(0),jpk), STAT=ierr(6) )
!
!* Sinking speed
- ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk), STAT=ierr(7) )
+ ALLOCATE( wsbio3 (A2D(0),jpk) , wsbio4 (A2D(0),jpk), STAT=ierr(7) )
!* Size of phytoplankton cells
- ALLOCATE( sizen (jpi,jpj,jpk), sized (jpi,jpj,jpk), &
- & sizena(jpi,jpj,jpk), sizeda(jpi,jpj,jpk), STAT=ierr(8) )
+ ALLOCATE( sizen (A2D(0),jpk), sized (A2D(0),jpk), &
+ & sizena(A2D(0),jpk), sizeda(A2D(0),jpk), STAT=ierr(8) )
!
- ALLOCATE( plig(jpi,jpj,jpk) , STAT=ierr(9) )
+ ALLOCATE( plig(A2D(0),jpk) , STAT=ierr(9) )
ENDIF
!
IF( ln_p5z ) THEN
! PISCES-QUOTA specific part
- ALLOCATE( epico(jpi,jpj,jpk) , epicom(jpi,jpj,jpk) , STAT=ierr(10) )
+ ALLOCATE( epico(A2D(0),jpk) , epicom(A2D(0),jpk) , STAT=ierr(10) )
!* Size of phytoplankton cells
- ALLOCATE( sizep(jpi,jpj,jpk), sizepa(jpi,jpj,jpk), STAT=ierr(11) )
+ ALLOCATE( sizep(A2D(0),jpk), sizepa(A2D(0),jpk), STAT=ierr(11) )
ENDIF
!
sms_pisces_alloc = MAXVAL( ierr )
diff --git a/src/TOP/PISCES/trcice_pisces.F90 b/src/TOP/PISCES/trcice_pisces.F90
index 8ce76bc76b9740e84bcd3bac29fea74ad22daae7..06e458a54852ae81a83dc6da4f26c0d7d9c97b60 100644
--- a/src/TOP/PISCES/trcice_pisces.F90
+++ b/src/TOP/PISCES/trcice_pisces.F90
@@ -19,6 +19,8 @@ MODULE trcice_pisces
PUBLIC trc_ice_ini_pisces ! called by trcini.F90 module
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: trcice_pisces.F90 10794 2019-03-22 09:25:28Z cetlod $
@@ -283,15 +285,15 @@ CONTAINS
ENDIF
!
DO jn = jp_pcs0, jp_pcs1
- IF( cn_trc_o(jn) == 'GL ' ) trc_o(:,:,jn) = zpisc(jn,1) ! Global case
+ IF( cn_trc_o(jn) == 'GL ' ) trc_o(A2D(0),jn) = zpisc(jn,1) ! Global case
IF( cn_trc_o(jn) == 'AA ' ) THEN
- WHERE( gphit(:,:) >= 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,2) ; END WHERE ! Arctic
- WHERE( gphit(:,:) < 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic
+ WHERE( gphit(A2D(0)) >= 0._wp ) ; trc_o(A2D(0),jn) = zpisc(jn,2) ; END WHERE ! Arctic
+ WHERE( gphit(A2D(0)) < 0._wp ) ; trc_o(A2D(0),jn) = zpisc(jn,3) ; END WHERE ! Antarctic
ENDIF
IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN ! Baltic Sea particular case for ORCA configurations
- WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. &
- 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
- trc_o(:,:,jn) = zpisc(jn,4)
+ WHERE( 14._wp <= glamt(A2D(0)) .AND. glamt(A2D(0)) <= 32._wp .AND. &
+ 54._wp <= gphit(A2D(0)) .AND. gphit(A2D(0)) <= 66._wp )
+ trc_o(A2D(0),jn) = zpisc(jn,4)
END WHERE
ENDIF
ENDDO
@@ -321,16 +323,16 @@ CONTAINS
DO jn = jp_pcs0, jp_pcs1
!-- Everywhere but in the Baltic
IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; typically everything but iron)
- trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn)
+ trc_i(A2D(0),jn) = zratio(jn,1) * trc_o(A2D(0),jn)
ELSE ! prescribed concentration
- trc_i(:,:,jn) = trc_ice_prescr(jn)
+ trc_i(A2D(0),jn) = trc_ice_prescr(jn)
ENDIF
!-- Baltic
IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN
IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron)
- WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. &
- 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
- trc_i(:,:,jn) = zratio(jn,2) * trc_o(:,:,jn)
+ WHERE( 14._wp <= glamt(A2D(0)) .AND. glamt(A2D(0)) <= 32._wp .AND. &
+ 54._wp <= gphit(A2D(0)) .AND. gphit(A2D(0)) <= 66._wp )
+ trc_i(A2D(0),jn) = zratio(jn,2) * trc_o(A2D(0),jn)
END WHERE
ENDIF
ENDIF
diff --git a/src/TOP/PISCES/trcini_pisces.F90 b/src/TOP/PISCES/trcini_pisces.F90
index f47975faa06b9538176c67fb49955384f18f274d..eaaac7e2cd486fab3aad2498f24796ce0256ae64 100644
--- a/src/TOP/PISCES/trcini_pisces.F90
+++ b/src/TOP/PISCES/trcini_pisces.F90
@@ -123,7 +123,6 @@ CONTAINS
ELSE
! PISCES-QUOTA part
ierr = ierr + p5z_lim_alloc()
- ierr = ierr + p5z_prod_alloc()
ierr = ierr + p5z_meso_alloc()
ENDIF
ierr = ierr + p4z_rem_alloc()
diff --git a/src/TOP/PISCES/trcwri_pisces.F90 b/src/TOP/PISCES/trcwri_pisces.F90
index e5cce04d5a93d31375531ac4d92fb9e5e00a2520..d44b7b11eaa800b2cb374084b3cd80f5dae4fb93 100644
--- a/src/TOP/PISCES/trcwri_pisces.F90
+++ b/src/TOP/PISCES/trcwri_pisces.F90
@@ -38,7 +38,7 @@ CONTAINS
CHARACTER (len=20) :: cltra
REAL(wp) :: zfact
INTEGER :: ji, jj, jk, jn
- REAL(wp), DIMENSION(jpi,jpj) :: zdic, zo2min, zdepo2min
+ REAL(wp), DIMENSION(A2D(0)) :: zdic, zo2min, zdepo2min
!!---------------------------------------------------------------------
! write the tracer concentrations in the file
@@ -60,15 +60,19 @@ CONTAINS
IF( iom_use( "INTDIC" ) ) THEN ! DIC content in kg/m2
zdic(:,:) = 0.
DO jk = 1, jpkm1
- zdic(:,:) = zdic(:,:) + tr(:,:,jk,jpdic,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * 12.
+ DO_2D( 0, 0, 0, 0 )
+ zdic(ji,jj) = zdic(ji,jj) + tr(ji,jj,jk,jpdic,Kmm) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * 12.
+ END_2D
ENDDO
- CALL iom_put( 'INTDIC', zdic )
+ CALL iom_put( 'INTDIC', zdic )
ENDIF
!
- IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth
- zo2min (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1)
- zdepo2min(:,:) = gdepw(:,:,1,Kmm) * tmask(:,:,1)
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
+ IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth
+ DO_2D( 0, 0, 0, 0 )
+ zo2min (ji,jj) = tr(ji,jj,1,jpoxy,Kmm) * tmask(ji,jj,1)
+ zdepo2min(ji,jj) = gdepw(ji,jj,1,Kmm) * tmask(ji,jj,1)
+ END_2D
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
IF( tmask(ji,jj,jk) == 1 ) then
IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then
zo2min (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm)
diff --git a/src/TOP/TRP/trcadv.F90 b/src/TOP/TRP/trcadv.F90
index 86776d8784ecf5cd192ec8e6917b8d0642f096ad..e98590e1693612ef16395d623624c477273d89d9 100644
--- a/src/TOP/TRP/trcadv.F90
+++ b/src/TOP/TRP/trcadv.F90
@@ -123,19 +123,19 @@ CONTAINS
!
IF( ln_wave .AND. ln_sdw ) THEN
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) ! eulerian transport + Stokes Drift
- zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( zptu(ji,jj,jk) + usd(ji,jj,jk) )
- zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( zptv(ji,jj,jk) + vsd(ji,jj,jk) )
+ zuu(ji,jj,jk) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * ( zptu(ji,jj,jk) + usd(ji,jj,jk) )
+ zvv(ji,jj,jk) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * ( zptv(ji,jj,jk) + vsd(ji,jj,jk) )
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
- zww(ji,jj,jk) = e1e2t(ji,jj) * ( zptw(ji,jj,jk) + wsd(ji,jj,jk) )
+ zww(ji,jj,jk) = e1e2t(ji,jj) * ( zptw(ji,jj,jk) + wsd(ji,jj,jk) )
END_3D
ELSE
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
- zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * zptu(ji,jj,jk) ! eulerian transport
- zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * zptv(ji,jj,jk)
+ zuu(ji,jj,jk) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * zptu(ji,jj,jk) ! eulerian transport
+ zvv(ji,jj,jk) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * zptv(ji,jj,jk)
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
- zww(ji,jj,jk) = e1e2t(ji,jj) * zptw(ji,jj,jk)
+ zww(ji,jj,jk) = e1e2t(ji,jj) * zptw(ji,jj,jk)
END_3D
ENDIF
!
diff --git a/src/TOP/TRP/trcdmp.F90 b/src/TOP/TRP/trcdmp.F90
index 2b11fd629e62c75f718e780fba50a6c486ba12dc..03535a63c1c18465e26e74e732db305253e7a7dc 100644
--- a/src/TOP/TRP/trcdmp.F90
+++ b/src/TOP/TRP/trcdmp.F90
@@ -57,7 +57,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE trc_dmp_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc )
+ ALLOCATE( restotr(A2D(0),jpk) , STAT=trc_dmp_alloc )
!
IF( trc_dmp_alloc /= 0 ) CALL ctl_warn('trc_dmp_alloc: failed to allocate array')
!
diff --git a/src/TOP/TRP/trcsbc.F90 b/src/TOP/TRP/trcsbc.F90
index f817b677b011d92edd8a7515e009f0f22f2a0272..88fd617f1efbeeb03ff099a56348c5dd3f6c1c30 100644
--- a/src/TOP/TRP/trcsbc.F90
+++ b/src/TOP/TRP/trcsbc.F90
@@ -115,14 +115,14 @@ CONTAINS
CASE ( -1 ) ! ! No tracers in sea ice ( trc_i = 0 )
!
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = 0._wp
END_2D
END DO
!
IF( ln_linssh ) THEN !* linear free surface
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = sbc_trc(ji,jj,jn) + r1_rho0 * emp(ji,jj) * ptr(ji,jj,1,jn,Kmm) !==>> add concentration/dilution effect due to constant volume cell
END_2D
END DO
@@ -131,14 +131,14 @@ CONTAINS
CASE ( 0 ) ! Same concentration in sea ice and in the ocean ( trc_i = ptr(...,Kmm) )
!
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = - fmmflx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
END_2D
END DO
!
IF( ln_linssh ) THEN !* linear free surface
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = sbc_trc(ji,jj,jn) + r1_rho0 * emp(ji,jj) * ptr(ji,jj,1,jn,Kmm) !==>> add concentration/dilution effect due to constant volume cell
END_2D
END DO
@@ -147,21 +147,21 @@ CONTAINS
CASE ( 1 ) ! Specific treatment of sea ice fluxes with an imposed concentration in sea ice
!
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = - fmmflx(ji,jj) * r1_rho0 * trc_i(ji,jj,jn)
END_2D
END DO
!
IF( ln_linssh ) THEN !* linear free surface
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = sbc_trc(ji,jj,jn) + r1_rho0 * emp(ji,jj) * ptr(ji,jj,1,jn,Kmm) !==>> add concentration/dilution effect due to constant volume cell
END_2D
END DO
ENDIF
!
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
zse3t = rDt_trc / e3t(ji,jj,1,Kmm)
zdtra = ptr(ji,jj,1,jn,Kmm) + sbc_trc(ji,jj,jn) * zse3t
IF( zdtra < 0. ) sbc_trc(ji,jj,jn) = MAX( zdtra, -ptr(ji,jj,1,jn,Kmm) / zse3t ) ! avoid negative concentration that can occurs if trc_i > ptr
@@ -176,7 +176,7 @@ CONTAINS
!
IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends
!
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
zse3t = zfact / e3t(ji,jj,1,Kmm)
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
END_2D
@@ -295,7 +295,7 @@ CONTAINS
CASE ( 0 ) ! Same concentration in sea ice and in the ocean fmm contribution to concentration/dilution effect has to be removed
!
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( emp(ji,jj) - fmmflx(ji,jj) ) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
END_2D
@@ -331,7 +331,7 @@ CONTAINS
CASE ( 0 ) ! Same concentration in sea ice and in the ocean : correct concentration/dilution effect due to "freezing - melting"
!
DO jn = 1, jptra
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) - fmmflx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
END_2D
diff --git a/src/TOP/TRP/trcsink.F90 b/src/TOP/TRP/trcsink.F90
index 5cee9b0ba920b1b15b43de995caa6d163d883685..572f501b7b620a40622ec95b8a190469fe0a1dc7 100644
--- a/src/TOP/TRP/trcsink.F90
+++ b/src/TOP/TRP/trcsink.F90
@@ -50,12 +50,12 @@ CONTAINS
INTEGER , INTENT(in) :: Kbb, Kmm
INTEGER , INTENT(in) :: jp_tra ! tracer index index
REAL(wp), INTENT(in) :: rsfact ! time step duration
- REAL(wp), INTENT(in) , DIMENSION(jpi,jpj,jpk) :: pwsink
- REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: psinkflx
+ REAL(wp), INTENT(in) , DIMENSION(A2D(0),jpk) :: pwsink
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0),jpk) :: psinkflx
INTEGER :: ji, jj, jk
- INTEGER, DIMENSION(jpi, jpj) :: iiter
+ INTEGER, DIMENSION(A2D(0)) :: iiter
REAL(wp) :: zfact, zwsmax, zmax
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwsink
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zwsink
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_sink')
@@ -73,7 +73,7 @@ CONTAINS
IF( nitermax == 1 ) THEN
iiter(:,:) = 1
ELSE
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
iiter(ji,jj) = 1
DO jk = 1, jpkm1
IF( tmask(ji,jj,jk) == 1.0 ) THEN
@@ -85,7 +85,7 @@ CONTAINS
iiter(:,:) = MIN( iiter(:,:), nitermax )
ENDIF
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
IF( tmask(ji,jj,jk) == 1.0 ) THEN
zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact
zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) )
@@ -121,23 +121,25 @@ CONTAINS
INTEGER, INTENT(in ) :: Kbb, Kmm ! time level indices
INTEGER, INTENT(in ) :: jp_tra ! tracer index index
REAL(wp), INTENT(in ) :: rsfact ! duration of time step
- INTEGER, INTENT(in ), DIMENSION(jpi,jpj) :: kiter ! number of iterations for time-splitting
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pwsink ! sinking speed
- REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: psinkflx ! sinking fluxe
+ INTEGER, INTENT(in ), DIMENSION(A2D(0)) :: kiter ! number of iterations for time-splitting
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0),jpk) :: pwsink ! sinking speed
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0),jpk) :: psinkflx ! sinking fluxe
!
INTEGER :: ji, jj, jk, jn, jt
REAL(wp) :: zigma,zew,zign, zflx, zstep
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztraz, zakz, zwsink2, ztrb, psinking
+ REAL(wp), DIMENSION(A2D(0),jpk) :: ztraz, zakz, zwsink2, ztrb, psinking
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_sink2')
!
- DO jk = 1, jpkm1
- zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1)
- END DO
- zwsink2(:,:,1) = 0.e0
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ zwsink2(ji,jj,jk+1) = -pwsink(ji,jj,jk) / rday * tmask(ji,jj,jk+1)
+ END_3D
+ DO_2D( 0, 0, 0, 0 )
+ zwsink2(ji,jj,1) = 0.e0
+ END_2D
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
! Vertical advective flux
zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2.
DO jt = 1, kiter(ji,jj)
diff --git a/src/TOP/trc.F90 b/src/TOP/trc.F90
index d5b85e041f9f4a1a60f4dfe167cb6bba7b329b68..4836efb7e2ff7ac1923e05e1bee94743ce36aa42 100644
--- a/src/TOP/trc.F90
+++ b/src/TOP/trc.F90
@@ -158,19 +158,19 @@ CONTAINS
!!-------------------------------------------------------------------
ierr(:) = 0
!
- ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt) , &
- & trc_i(jpi,jpj,jptra) , trc_o(jpi,jpj,jptra) , &
- & gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , &
- & gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , &
- & trc_ice_ratio(jptra) , trc_ice_prescr(jptra) , cn_trc_o(jptra) , &
- & neln(jpi,jpj) , heup(jpi,jpj) , heup_01(jpi,jpj) , &
- & etot(jpi,jpj,jpk) , etot_ndcy(jpi,jpj,jpk) , &
- & sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra) , &
- & cvol(jpi,jpj,jpk) , trai(jptra) , &
- & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , &
- & ln_trc_ini(jptra) , &
- & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , &
- & ln_trc_ais(jptra) , &
+ ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt) , &
+ & gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , &
+ & gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , &
+ & trc_i(A2D(0),jptra) , trc_o(A2D(0),jptra) , &
+ & trc_ice_ratio(jptra) , trc_ice_prescr(jptra) , cn_trc_o(jptra) , &
+ & neln(A2D(0)) , heup(A2D(0)) , heup_01(A2D(0)) , &
+ & etot(A2D(0),jpk) , etot_ndcy(A2D(0),jpk) , &
+ & sbc_trc_b(A2D(0),jptra), sbc_trc(A2D(0),jptra) , &
+ & cvol(jpi,jpj,jpk) , trai(jptra) , &
+ & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , &
+ & ln_trc_ini(jptra) , &
+ & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , &
+ & ln_trc_ais(jptra) , &
& STAT = ierr(1) )
!
IF( ln_bdy ) ALLOCATE( trcdta_bdy(jptra, jp_bdy) , STAT = ierr(2) )
diff --git a/src/TOP/trcais.F90 b/src/TOP/trcais.F90
index 5bd051387df35ca4faedfea9a07b47dc5b06be27..010e9fce1e2f7550977e3d2dce6abcfec2fc2b4e 100644
--- a/src/TOP/trcais.F90
+++ b/src/TOP/trcais.F90
@@ -169,7 +169,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zfact = 1. / e3t(ji,jj,1,Kmm)
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + fwficb(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) * zfact
END_2D
@@ -181,7 +181,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( ln_isfpar_mlt ) THEN
zcalv = fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj)
ikt = misfkt_par(ji,jj)
@@ -213,7 +213,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
DO jk = 1, icblev
zcalv = fwficb(ji,jj) * r1_rho0
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trafac(jl) * zcalv / gdepw(ji,jj,icblev+1,Kmm)
@@ -228,7 +228,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( ln_isfpar_mlt ) THEN
zcalv = - fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj)
ikt = misfkt_par(ji,jj)
diff --git a/src/TOP/trcbc.F90 b/src/TOP/trcbc.F90
index fc829d8db5b806c8ad2e6edffc680a788ae91800..141ecf03c6db857d1a90b0e03d7def0c8745592b 100644
--- a/src/TOP/trcbc.F90
+++ b/src/TOP/trcbc.F90
@@ -414,7 +414,7 @@ CONTAINS
!
! Remove river dilution for tracers with absent river load
IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
DO jk = 1, nk_rnf(ji,jj)
#if defined key_RK3
zrnf = rnf(ji,jj) * r1_rho0 / h_rnf(ji,jj)
@@ -432,7 +432,7 @@ CONTAINS
IF( ln_trc_sbc(jn) ) THEN
jl = n_trc_indsbc(jn)
sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time )
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact
END_2D
@@ -443,7 +443,7 @@ CONTAINS
IF( l_offline ) rn_rfact = 1._wp
jl = n_trc_indcbc(jn)
sf_trccbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trccbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation
- DO_2D( 0, 0, 0, 1 )
+ DO_2D( 0, 0, 0, 0 )
DO jk = 1, nk_rnf(ji,jj)
zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time )
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact
diff --git a/src/TOP/trcini.F90 b/src/TOP/trcini.F90
index 394f1cd16b77cf421edafa76afb8f4bc25316cb7..f5275ead3833d971aec8e6e656e2d0609e362bb5 100644
--- a/src/TOP/trcini.F90
+++ b/src/TOP/trcini.F90
@@ -32,6 +32,8 @@ MODULE trcini
PUBLIC trc_init ! called by opa
+ !! * Substitutions
+# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -93,9 +95,8 @@ CONTAINS
!! ** Purpose : passive tracers inventories at initialsation phase
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: Kmm ! time level index
- INTEGER :: jk, jn ! dummy loop indices
+ INTEGER :: ji, jj, jk, jn ! dummy loop indices
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: zzmsk
!!----------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
diff --git a/src/TOP/trcnam.F90 b/src/TOP/trcnam.F90
index cacbe617105a4851b262e05392c3fdea4b542782..80a181e055938ffbb7c1649e105369158c6def10 100644
--- a/src/TOP/trcnam.F90
+++ b/src/TOP/trcnam.F90
@@ -254,7 +254,12 @@ CONTAINS
WRITE(numout,*) ' Namelist : namtrc_dcy '
WRITE(numout,*) ' Diurnal cycle for TOP ln_trcdc2dm = ', ln_trcdc2dm
ENDIF
-
+ ! ! Define logical parameter ton control dirunal cycle in TOP
+ l_trcdm2dc = ( ln_trcdc2dm .AND. .NOT. ln_dm2dc )
+ !
+ IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
+ & 'Computation of a daily mean shortwave for some biogeochemical models ' )
+ !
END SUBROUTINE trc_nam_dcy
SUBROUTINE trc_nam_trd
diff --git a/src/TOP/trcopt.F90 b/src/TOP/trcopt.F90
index 7620a4c0017f2abfc7dc8e86b3be9f6a0aa5b0cd..c7a013167fff63a3f4f5e71ee078d1197a2acf14 100644
--- a/src/TOP/trcopt.F90
+++ b/src/TOP/trcopt.F90
@@ -58,12 +58,14 @@ CONTAINS
INTEGER, INTENT(in) :: kt, knt ! ocean time step
INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: zchl ! chlorophyll field
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(out) :: ze1, ze2, ze3 ! PAR for individual wavelength
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(out) :: ze1, ze2, ze3 ! PAR for individual wavelength
!
INTEGER :: ji, jj, jk, irgb
REAL(wp) :: ztmp
- REAL(wp), DIMENSION(jpi,jpj ) :: parsw, zqsr100, zqsr_corr
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze0
+ REAL(wp), DIMENSION(A2D(0) ) :: parsw, zqsr100, zqsr_corr
+ REAL(wp), DIMENSION(A2D(0),jpk) :: ze0
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
+ REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_opt')
@@ -85,7 +87,7 @@ CONTAINS
! Attenuation coef. function of Chlorophyll and wavelength (RGB)
! --------------------------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1)
ztmp = ( zchl(ji,jj,jk) + rtrn ) * 1.e6
ztmp = MIN( 10. , MAX( 0.05, ztmp ) )
irgb = NINT( 41 + 20.* LOG10( ztmp ) + rtrn )
@@ -99,54 +101,63 @@ CONTAINS
! -----------------------------------------------
IF( ln_qsr_bio ) THEN
!
- zqsr_corr(:,:) = parsw(:,:) * qsr(:,:)
+ DO_2D( 0, 0, 0, 0 )
+ zqsr_corr(ji,jj) = parsw(ji,jj) * qsr(ji,jj)
+ END_2D
!
- ze0(:,:,1) = (1._wp - 3._wp * parsw(:,:)) * qsr(:,:) ! ( 1 - 3 * alpha ) * q
+ DO_2D( 0, 0, 0, 0 )
+ ze0(ji,jj,1) = (1._wp - 3._wp * parsw(ji,jj)) * qsr(ji,jj) ! ( 1 - 3 * alpha ) * q
+ END_2D
ze1(:,:,1) = zqsr_corr(:,:)
ze2(:,:,1) = zqsr_corr(:,:)
ze3(:,:,1) = zqsr_corr(:,:)
!
- DO jk = 2, nksrp + 1
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- ze0(ji,jj,jk) = ze0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * (1. / rn_si0) )
- ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) )
- ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) )
- ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) )
- END_2D
- END DO
+ DO_3D( 0, 0, 0, 0, 2, nksrp + 1 )
+ ze0(ji,jj,jk) = ze0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * (1. / rn_si0) )
+ ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) )
+ ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) )
+ ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) )
+ END_3D
!
- etot3(:,:,1) = qsr(:,:) * tmask(:,:,1)
- DO jk = 2, nksrp + 1
- etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
- END DO
+ DO_2D( 0, 0, 0, 0 )
+ etot3(ji,jj,1) = qsr(ji,jj) * tmask(ji,jj,1)
+ END_2D
+ DO_3D( 0, 0, 0, 0, 2, nksrp+1 )
+ etot3(ji,jj,jk) = ( ze0(ji,jj,jk) + ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) ) * tmask(ji,jj,jk)
+ END_3D
! ! ------------------------
ENDIF
! Photosynthetically Available Radiation (PAR)
! --------------------------------------------
- zqsr_corr(:,:) = parsw(:,:) * qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
+ DO_2D( 0, 0, 0, 0 )
+ zqsr_corr(ji,jj) = parsw(ji,jj) * qsr(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
+ END_2D
!
CALL trc_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )
!
- DO jk = 1, nksrp
- etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
- ENDDO
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ etot(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
+ END_3D
! No Diurnal cycle PAR
IF( l_trcdm2dc ) THEN
- zqsr_corr(:,:) = parsw(:,:) * qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn )
+ DO_2D( 0, 0, 0, 0 )
+ zqsr_corr(ji,jj) = parsw(ji,jj) * qsr_mean(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
+ END_2D
!
CALL trc_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )
- DO jk = 1, nksrp
- etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
- END DO
+ !
+ DO_3D( 0, 0, 0, 0, 1, nksr )
+ etot_ndcy(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
+ END_3D
ELSE
etot_ndcy(:,:,:) = etot(:,:,:)
ENDIF
! Weighted broadband attenuation coefficient
! ------------------------------------------
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ztmp = ze1(ji,jj,jk)* ekb(ji,jj,jk) + ze2(ji,jj,jk) * ekg(ji,jj,jk) + ze3(ji,jj,jk) * ekr(ji,jj,jk)
zeps(ji,jj,jk) = ztmp / e3t(ji,jj,jk,Kmm) / (etot(ji,jj,jk) + rtrn)
END_3D
@@ -154,26 +165,24 @@ CONTAINS
! Light at the euphotic depth
! ---------------------------
- zqsr100 = 0.01 * 3. * zqsr_corr(:,:)
+ zqsr100(:,:) = 0.01 * 3. * zqsr_corr(:,:)
! Euphotic depth and level
! ------------------------
- neln (:,:) = 1
- heup (:,:) = gdepw(:,:,2,Kmm)
- heup_01(:,:) = gdepw(:,:,2,Kmm)
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksrp )
+ DO_2D( 0, 0, 0, 0 )
+ neln (ji,jj) = 1
+ heup (ji,jj) = gdepw(ji,jj,2,Kmm)
+ heup_01(ji,jj) = gdepw(ji,jj,2,Kmm)
+ END_2D
+
+ DO_3D( 0, 0, 0, 0, 2, nksr)
IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN
- ! Euphotic level (1st T-level strictly below Euphotic layer)
- ! NOTE: ensure compatibility with nmld_trc definition in trdmxl_trc
- neln(ji,jj) = jk+1
- !
- ! Euphotic layer depth
- heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)
+ neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer
+ ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
+ heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth
ENDIF
- ! Euphotic layer depth (light level definition)
- IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN
- heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)
+ IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.10 ) THEN
+ heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth (light level definition)
ENDIF
END_3D
!
@@ -181,8 +190,18 @@ CONTAINS
heup_01(:,:) = MIN( 300., heup_01(:,:) )
!
IF( lk_iomput ) THEN
- CALL iom_put( "xbla" , zeps(:,:,:) * tmask(:,:,:) )
- CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) )
+ IF( iom_use( "Heup" ) ) THEN
+ ALLOCATE( zw2d(A2D(0)) )
+ zw2d(A2D(0)) = heup(A2D(0)) * tmask(A2D(0),1)
+ CALL iom_put( "Heup", zw2d ) ! Euphotic layer depth
+ DEALLOCATE( zw2d )
+ ENDIF
+ IF( iom_use( "xbla" ) ) THEN
+ ALLOCATE( zw3d(A2D(0),jpk)) ; zw3d(A2D(0),jpk) = 0._wp
+ zw3d(A2D(0),1:jpkm1) = zeps(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
+ CALL iom_put( "xbla", zw3d ) ! Euphotic layer depth
+ DEALLOCATE( zw3d )
+ ENDIF
ENDIF
!
IF( ln_timing ) CALL timing_stop('trc_opt')
@@ -199,11 +218,11 @@ CONTAINS
!!
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! ocean time-step
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: zqsr ! real shortwave
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(out) :: pe1 , pe2 , pe3 ! PAR (R-G-B)
+ REAL(wp), DIMENSION(A2D(0)) , INTENT(in) :: zqsr ! real shortwave
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(out) :: pe1 , pe2 , pe3 ! PAR (R-G-B)
!
INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp), DIMENSION(jpi,jpj) :: we1, we2, we3 ! PAR (R-G-B) at w-level
+ REAL(wp), DIMENSION(A2D(0)) :: we1, we2, we3 ! PAR (R-G-B) at w-level
!!----------------------------------------------------------------------
pe1(:,:,:) = 0. ; pe2(:,:,:) = 0. ; pe3(:,:,:) = 0.
!
@@ -213,7 +232,7 @@ CONTAINS
pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksrp )
+ DO_3D( 0, 0, 0, 0, 2, nksrp )
pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
@@ -225,7 +244,7 @@ CONTAINS
we2(:,:) = zqsr(:,:)
we3(:,:) = zqsr(:,:)
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksrp )
+ DO_3D( 0, 0, 0, 0, 1, nksrp )
! integrate PAR over current t-level
pe1(ji,jj,jk) = we1(ji,jj) / (ekb(ji,jj,jk) + rtrn) * (1. - EXP( -ekb(ji,jj,jk) ))
pe2(ji,jj,jk) = we2(ji,jj) / (ekg(ji,jj,jk) + rtrn) * (1. - EXP( -ekg(ji,jj,jk) ))
@@ -266,7 +285,9 @@ CONTAINS
IF( ln_varpar ) THEN
IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_par > 1 ) ) THEN
CALL fld_read( kt, 1, sf_par )
- par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
+ DO_2D( 0, 0, 0, 0 )
+ par_varsw(ji,jj) = ( sf_par(1)%fnow(ji,jj,1) ) / 3.0
+ END_2D
ENDIF
ENDIF
!
@@ -348,8 +369,8 @@ CONTAINS
!! *** ROUTINE trc_opt_alloc ***
!!----------------------------------------------------------------------
!
- ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), &
- ekg(jpi,jpj,jpk),zeps(jpi,jpj,jpk), STAT= trc_opt_alloc )
+ ALLOCATE( ekb(A2D(0),jpk),ekr(A2D(0),jpk), &
+ ekg(A2D(0),jpk),zeps(A2D(0),jpk), STAT= trc_opt_alloc )
!
IF( trc_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_opt_alloc : failed to allocate arrays.' )
!
diff --git a/src/TOP/trcstp.F90 b/src/TOP/trcstp.F90
index 9d7e7574b1874c87bcd76144cbfd7bb97c7e6bff..065d7f73df585f4420ee07e919d80db3e2caa3b4 100644
--- a/src/TOP/trcstp.F90
+++ b/src/TOP/trcstp.F90
@@ -37,6 +37,8 @@ MODULE trcstp
REAL(wp) :: rsecfst, rseclast ! ???
REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
+ !! * Substitutions
+# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -74,17 +76,13 @@ CONTAINS
ll_trcstat = ( sn_cfctl%l_trcstat ) .AND. &
& ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
- IF( kt == nittrc000 ) CALL trc_stp_ctl ! control
IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer
!
IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution
DO jk = 1, jpk
cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
- IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) &
- & .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" ) &
- & .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) ) &
- & areatot = glob_sum( 'trcstp', cvol(:,:,:) )
+ IF ( ll_trcstat .OR. kt == nitrst ) areatot = glob_sum( 'trcstp', cvol(:,:,:) )
ENDIF
!
IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
@@ -141,20 +139,6 @@ CONTAINS
END SUBROUTINE trc_stp
- SUBROUTINE trc_stp_ctl
- !!----------------------------------------------------------------------
- !! *** ROUTINE trc_stp_ctl ***
- !!----------------------------------------------------------------------
- !
- ! Define logical parameter ton control dirunal cycle in TOP
- l_trcdm2dc = ( ln_trcdc2dm .AND. .NOT. ln_dm2dc )
- !
- IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
- & 'Computation of a daily mean shortwave for some biogeochemical models ' )
- !
- END SUBROUTINE trc_stp_ctl
-
-
SUBROUTINE trc_mean_qsr( kt )
!!----------------------------------------------------------------------
!! *** ROUTINE trc_mean_qsr ***
@@ -188,7 +172,7 @@ CONTAINS
WRITE(numout,*)
ENDIF
!
- ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
+ ALLOCATE( qsr_arr(A2D(0),nb_rec_per_day ) )
!
! !* Restart: read in restart file
IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
@@ -239,7 +223,7 @@ CONTAINS
qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
ENDDO
qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
- qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
+ qsr_mean(:,:) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
ENDIF
!
IF( lrst_trc ) THEN !* Write the mean of qsr in restart file
diff --git a/src/TOP/trcstp_rk3.F90 b/src/TOP/trcstp_rk3.F90
index 450d4b5ed1adbb667939f233d34bf36796931c35..cdf89df573fbfe5c939a8dd3c2ac1dd872ef0f02 100644
--- a/src/TOP/trcstp_rk3.F90
+++ b/src/TOP/trcstp_rk3.F90
@@ -41,6 +41,8 @@ MODULE trcstp_rk3
REAL(wp) :: rsecfst, rseclast ! ???
REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
+ !! * Substitutions
+# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
@@ -71,15 +73,14 @@ CONTAINS
l_trcstat = ( sn_cfctl%l_trcstat ) .AND. &
& ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
!
- IF( kt == nittrc000 ) CALL trc_stp_ctl ! control
+ IF( kt == nittrc000 ) CALL trc_stpsctl ! control
IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer
!
IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution
DO jk = 1, jpk
cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
- IF( l_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) ) &
- & areatot = glob_sum( 'trcstp', cvol(:,:,:) )
+ IF( l_trcstat .OR. kt == nitrst ) areatot = glob_sum( 'trcstp', cvol(:,:,:) )
ENDIF
!
IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
@@ -146,22 +147,6 @@ CONTAINS
END SUBROUTINE trc_stp_end
- SUBROUTINE trc_stp_ctl
- !!----------------------------------------------------------------------
- !! *** ROUTINE trc_stp_ctl ***
- !! ** Purpose : Control + ocean volume
- !!----------------------------------------------------------------------
- !
- ! Define logical parameter ton control dirunal cycle in TOP
- l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 )
- l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline
- !
- IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
- & 'Computation of a daily mean shortwave for some biogeochemical models ' )
- !
- END SUBROUTINE trc_stp_ctl
-
-
SUBROUTINE trc_mean_qsr( kt )
!!----------------------------------------------------------------------
!! *** ROUTINE trc_mean_qsr ***
@@ -185,13 +170,9 @@ CONTAINS
IF( ln_timing ) CALL timing_start('trc_mean_qsr')
!
IF( kt == nittrc000 ) THEN
- IF( ln_cpl ) THEN
- rdt_sampl = rday / ncpl_qsr_freq
- nb_rec_per_day = ncpl_qsr_freq
- ELSE
- rdt_sampl = MAX( 3600., rn_Dt )
- nb_rec_per_day = INT( rday / rdt_sampl )
- ENDIF
+ !
+ rdt_sampl = REAL( ncpl_qsr_freq )
+ nb_rec_per_day = INT( rday / ncpl_qsr_freq )
!
IF(lwp) THEN
WRITE(numout,*)
@@ -199,7 +180,7 @@ CONTAINS
WRITE(numout,*)
ENDIF
!
- ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
+ ALLOCATE( qsr_arr(A2D(0),nb_rec_per_day ) )
!
! !* Restart: read in restart file
IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
@@ -250,7 +231,7 @@ CONTAINS
qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
END DO
qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
- qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
+ qsr_mean(:,:) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
ENDIF
!
IF( lrst_trc ) THEN !* Write the mean of qsr in restart file
diff --git a/src/TOP/trcwri.F90 b/src/TOP/trcwri.F90
index 39e3123fecd095832a58f8a49d793f0590b88467..abd64e4b3319cf1060a588ee2a8ac303443ccd5a 100644
--- a/src/TOP/trcwri.F90
+++ b/src/TOP/trcwri.F90
@@ -42,12 +42,12 @@ CONTAINS
INTEGER, INTENT( in ) :: kt
INTEGER, INTENT( in ) :: Kmm ! time level indices
!
- INTEGER :: jk, jn
+ INTEGER :: ji,jj,jk,jn
CHARACTER (len=20) :: cltra
CHARACTER (len=40) :: clhstnam
INTEGER :: inum = 11 ! temporary logical unit
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace
- !!---------------------------------------------------------------------
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d ! 3D workspace
+ !!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_wri')
!
@@ -59,6 +59,8 @@ CONTAINS
CLOSE(inum)
ENDIF
+ ALLOCATE( z3d(jpi,jpj,jpk) ) ; z3d(:,:,:) = 0._wp
+
! Output of initial vertical scale factor
CALL iom_put( "e3t_0", e3t_0(:,:,:) )
CALL iom_put( "e3u_0", e3u_0(:,:,:) )
@@ -66,25 +68,27 @@ CONTAINS
!
IF( .NOT.ln_linssh ) CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height
!
- IF ( iom_use("e3t") ) THEN ! time-varying e3t
- DO jk = 1, jpk
- z3d(:,:,jk) = e3t(:,:,jk,Kmm)
- END DO
- CALL iom_put( "e3t", z3d(:,:,:) )
+ ! --- vertical scale factors --- !
+ IF( iom_use("e3t") ) THEN ! time-varying e3t
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ z3d(ji,jj,jk) = e3t(ji,jj,jk,Kmm)
+ END_3D
+ CALL iom_put( "e3t", z3d )
ENDIF
IF ( iom_use("e3u") ) THEN ! time-varying e3u
- DO jk = 1, jpk
- z3d(:,:,jk) = e3u(:,:,jk,Kmm)
- END DO
- CALL iom_put( "e3u", z3d(:,:,:) )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ z3d(ji,jj,jk) = e3u(ji,jj,jk,Kmm)
+ END_3D
+ CALL iom_put( "e3u" , z3d )
ENDIF
IF ( iom_use("e3v") ) THEN ! time-varying e3v
- DO jk = 1, jpk
- z3d(:,:,jk) = e3v(:,:,jk,Kmm)
- END DO
- CALL iom_put( "e3v", z3d(:,:,:) )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ z3d(ji,jj,jk) = e3v(ji,jj,jk,Kmm)
+ END_3D
+ CALL iom_put( "e3v" , z3d )
ENDIF
!
+ DEALLOCATE( z3d )
ENDIF
!
! write the tracer concentrations in the file